/[eiffelstudio]/branches/CAT_mono/Src/Eiffel/eiffel/interface/pointer_b.e
ViewVC logotype

Contents of /branches/CAT_mono/Src/Eiffel/eiffel/interface/pointer_b.e

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69868 - (show annotations)
Fri Aug 3 22:28:26 2007 UTC (12 years, 4 months ago) by martins
File size: 4946 byte(s)
enabled more types to store monomorph information
1 indexing
2 description: "Internal representation of class POINTER and TYPED_POINTER"
3 legal: "See notice at end of class."
4 status: "See notice at end of class."
5 date: "$Date$"
6 revision: "$Revision$"
7
8 class POINTER_B
9
10 inherit
11 CLASS_B
12 rename
13 make as basic_make
14 redefine
15 actual_type, partial_actual_type,
16 is_typed_pointer, check_validity
17 end
18
19 create
20 make
21
22 feature {NONE} -- Initialization
23
24 make (l: CLASS_I; a_is_typed_pointer: like is_typed_pointer) is
25 -- Creation of POINTER_B instance where `is_typed_pointer' is initialized
26 -- with `a_is_typed_pointer'.
27 do
28 basic_make (l)
29 is_typed_pointer := a_is_typed_pointer
30 ensure
31 is_typed_pointer_set: is_typed_pointer = a_is_typed_pointer
32 end
33
34 feature -- Access
35
36 actual_type: BASIC_A is
37 -- Actual double type
38 local
39 l_formal: FORMAL_A
40 do
41 if is_typed_pointer then
42 -- TODO: is polymorph ok? (3rd False)
43 create l_formal.make (False, False, False, 1)
44 create {TYPED_POINTER_A} Result.make_typed (l_formal)
45 else
46 Result := Pointer_type
47 end
48 end
49
50 is_typed_pointer: BOOLEAN
51 -- Is current representing TYPED_POINTER?
52
53 feature {CLASS_TYPE_AS} -- Actual class type
54
55 partial_actual_type (gen: ARRAY [TYPE_A]; is_exp, is_sep, is_mono: BOOLEAN): CL_TYPE_A is
56 -- Actual type of `current depending on the context in which it is declared
57 -- in CLASS_TYPE_AS. That is to say, it could have generics `gen' but not
58 -- be a generic class. It simplifies creation of `CL_TYPE_A' instances in
59 -- CLASS_TYPE_AS when trying to resolve types, by using dynamic binding
60 -- rather than if statements.
61 do
62 if is_typed_pointer then
63 if gen /= Void then
64 create {TYPED_POINTER_A} Result.make (class_id, gen)
65 else
66 create Result.make (class_id)
67 end
68 else
69 Result := Precursor {CLASS_B} (gen, is_exp, is_sep, is_mono)
70 end
71 end
72
73 feature -- Validity
74
75 check_validity is
76 -- Check validity of a simple type reference class.
77 local
78 skelet: SKELETON
79 special_error: SPECIAL_ERROR
80 l_feat: FEATURE_I
81 l_proc: PROCEDURE_I
82 l_attr: ATTRIBUTE_I
83 do
84 if not is_typed_pointer then
85 Precursor {CLASS_B}
86 else
87 -- First check there is only one generic.
88 if generics = Void or else generics.count > 1 then
89 create special_error.make (typed_pointer_case_1, Current)
90 Error_handler.insert_error (special_error)
91 end
92
93 -- Check for `to_pointer' query.
94 l_feat := feature_table.item_id ({PREDEFINED_NAMES}.to_pointer_name_id)
95 if l_feat = Void or else not l_feat.has_return_value then
96 create special_error.make (typed_pointer_case_3, Current)
97 Error_handler.insert_error (special_error)
98 else
99 l_attr ?= l_feat
100 if l_attr /= Void then
101 -- We are compiling for Eiffel Software implementation
102 skelet := types.first.skeleton
103 if
104 skelet.count /= 1 or else
105 not skelet.first.type_i.same_as (pointer_type.type_i)
106 then
107 create special_error.make (typed_pointer_case_2, Current)
108 Error_handler.insert_error (special_error)
109 else
110 end
111 else
112 create special_error.make (typed_pointer_case_3, Current)
113 Error_handler.insert_error (special_error)
114 end
115 end
116
117 -- Check for a procedure `set_item'.
118 l_proc ?= feature_table.item_id ({PREDEFINED_NAMES}.set_item_name_id)
119 if
120 l_proc = Void or else
121 l_proc.argument_count /= 1 or else
122 not l_proc.arguments.i_th (1).actual_type.same_as (pointer_type)
123 then
124 create special_error.make (typed_pointer_case_4, Current)
125 Error_handler.insert_error (special_error)
126 end
127 end
128 end
129
130 indexing
131 copyright: "Copyright (c) 1984-2006, Eiffel Software"
132 license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)"
133 licensing_options: "http://www.eiffel.com/licensing"
134 copying: "[
135 This file is part of Eiffel Software's Eiffel Development Environment.
136
137 Eiffel Software's Eiffel Development Environment is free
138 software; you can redistribute it and/or modify it under
139 the terms of the GNU General Public License as published
140 by the Free Software Foundation, version 2 of the License
141 (available at the URL listed under "license" above).
142
143 Eiffel Software's Eiffel Development Environment is
144 distributed in the hope that it will be useful, but
145 WITHOUT ANY WARRANTY; without even the implied warranty
146 of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
147 See the GNU General Public License for more details.
148
149 You should have received a copy of the GNU General Public
150 License along with Eiffel Software's Eiffel Development
151 Environment; if not, write to the Free Software Foundation,
152 Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
153 ]"
154 source: "[
155 Eiffel Software
156 356 Storke Road, Goleta, CA 93117 USA
157 Telephone 805-685-1006, Fax 805-685-6869
158 Website http://www.eiffel.com
159 Customer support http://support.eiffel.com
160 ]"
161
162 end

Properties

Name Value
svn:eol-style native
svn:keywords Author Date Id Revision

  ViewVC Help
Powered by ViewVC 1.1.23