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

Properties

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

  ViewVC Help
Powered by ViewVC 1.1.23