Peter N Lewis wrote:
At 9:07 +0200 6/7/05, Marco van de Voort wrote:
marcov@stack.nl wrote:
Delphi supports this: (remember its object model is similar)
Type MyObjectB = class; MyObjectA = class;
This seems to be what `class .. end' is in OOE.
Must be in one typeblock though, IOW, the same system as pointers.
Yes, same in OOE.
Does CW work like OOE in this regard?
No, CW does not accept either syntax:
MyObject = object; nor MyObject = object .. end;
CW takes the approach that any unknown type identifier it sees in a type definition is pointer sized (a pointer or object) and must be defined by the end of the type block.
type rec = record a: UndefinedA; b: UndefinedB; end; UndefinedA = ^Integer; UndefinedB = object end;
Note that UndefinedA = UInt32 is not legal, it must be a pointer or object.
It's actually not a bad methodology and makes it easy to write data structures that is self or mutually referential, but it does not add anything over pre defining pointers or object names as EP/Delphi.
Does it allow the same in nested scopes? AFAIU objects are not allowed in nested scopes, but pointers still make sense. Also, what happens if the name is a predefined type (or a name declared in outer scope)? Normal Pascal rules are that the new definition should be used (even if the definition follows use), are they obeyed?
Note that afaik there is no solution for BP style objects, and actually you don't really need it, since in practice you always work with references (explicit pointers).
There is still this case:
type proc = procedure ( var o: MyObject ); MyObject = object f: proc; end;
But I agree, in practice with non-reference objects, the issue is a lot less prevalent.
Actually, once we have procedural types in the language forward type declarations could be usefull also for records, functions and procedures:
type automaton = function (input) : automaton;
would be a reasonable declaration for a function implementing a single step transition of a finite state machine (returning a new transition function, for the next step).
ATM I have implemented OOP forward declaration:
type o = class .. end; ...
It requires the `class' keyword. There is a problem, that `class' keyword is (ATM) not accepted in Mac Pascal mode. It would be easy to implement syntax with `object' as an alternate keword, but than we would have to decide what to do if `object' is used in a forward declaration in one mode, but the proper declaration uses different mode.
Adding some other explicit forward declaration does not look very hard. OTOH allowing use befor definition for "pointer contexts" looks much harder.
The patch follows:
diff -u p.nn/declarations.c p/declarations.c --- p.nn/declarations.c Sun Jul 3 02:30:53 2005 +++ p/declarations.c Wed Jul 6 20:03:09 2005 @@ -3084,6 +3084,27 @@ return decl; }
+void +patch_type (tree type, tree otype) +{ + tree fwdtype = TYPE_MAIN_VARIANT (otype); + for (; fwdtype; fwdtype = TYPE_NEXT_VARIANT (fwdtype)) + { + tree t, new_variant = p_build_type_variant (type, TYPE_READONLY (fwdtype), + TYPE_VOLATILE (fwdtype)); + if (new_variant == type && fwdtype != otype) + new_variant = build_type_copy (new_variant); + if (TYPE_POINTER_TO (fwdtype)) + for (t = TYPE_MAIN_VARIANT (TYPE_POINTER_TO (fwdtype)); t; t = TYPE_NEXT_VARIANT (t)) + TREE_TYPE (t) = new_variant; + if (TYPE_REFERENCE_TO (fwdtype)) + for (t = TYPE_MAIN_VARIANT (TYPE_REFERENCE_TO (fwdtype)); t; t = TYPE_NEXT_VARIANT (t)) + TREE_TYPE (t) = new_variant; + TYPE_POINTER_TO (new_variant) = TYPE_POINTER_TO (fwdtype); + TYPE_REFERENCE_TO (new_variant) = TYPE_REFERENCE_TO (fwdtype); + } +} + /* Actually declare the types at the end of a type definition part. Resolve any forward types using existing types. */ void @@ -3093,22 +3114,51 @@
/* Resolve forward types */ for (scan = current_type_list; scan; scan = TREE_CHAIN (scan)) - if (TREE_PURPOSE (scan) && TREE_CODE (TREE_TYPE (TREE_PURPOSE (scan))) == LANG_TYPE) + if (TREE_PURPOSE (scan) && (TREE_CODE (TREE_TYPE (TREE_PURPOSE (scan))) == LANG_TYPE + || TREE_CODE (TREE_TYPE (TREE_PURPOSE (scan))) == POINTER_TYPE + && PASCAL_TYPE_CLASS (TREE_TYPE (TREE_PURPOSE (scan))) + && TREE_CODE (TREE_TYPE (TREE_TYPE (TREE_PURPOSE (scan)))) == LANG_TYPE)) { - tree decl = lookup_name (TREE_VALUE (scan)), fwdtype, type; + tree otype = TREE_TYPE (TREE_PURPOSE (scan)); + tree decl = lookup_name (TREE_VALUE (scan)), type; + int is_class = TREE_CODE (otype) == POINTER_TYPE; if (decl && TREE_CODE (decl) == TYPE_DECL) - type = TREE_TYPE (decl); - else + { + type = TREE_TYPE (decl); + if (is_class) + if (TREE_CODE (type) == POINTER_TYPE && PASCAL_TYPE_CLASS (type)) + { + type = TREE_TYPE (type); + error ("useless forward class declaration for `%s'", + IDENTIFIER_NAME (TREE_VALUE (scan))); + } + else + { + error ("forward class %s' redefined as non-class", + IDENTIFIER_NAME (TREE_VALUE (scan))); + type = void_type_node; + } + } + else if (is_class) + { + error ("unresolved forward class `%s'", + IDENTIFIER_NAME (TREE_VALUE (scan))); + type = void_type_node; + } + else { error ("forward referenced type `%s' undefined", IDENTIFIER_NAME (TREE_VALUE (scan))); type = void_type_node; /* dwarf2out.c doesn't like error_mark_node */ } /* Patch all variants. */ - for (fwdtype = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_PURPOSE (scan))); + if (is_class) + otype = TREE_TYPE (otype); +#if 0 + for (fwdtype = TYPE_MAIN_VARIANT (otype); fwdtype; fwdtype = TYPE_NEXT_VARIANT (fwdtype)) { tree t, new_variant = p_build_type_variant (type, TYPE_READONLY (fwdtype), TYPE_VOLATILE (fwdtype)); - if (new_variant == type && fwdtype != TREE_TYPE (TREE_PURPOSE (scan))) + if (new_variant == type && fwdtype != otype) new_variant = build_type_copy (new_variant); if (TYPE_POINTER_TO (fwdtype)) for (t = TYPE_MAIN_VARIANT (TYPE_POINTER_TO (fwdtype)); t; t = TYPE_NEXT_VARIANT (t)) @@ -3119,6 +3169,9 @@ TYPE_POINTER_TO (new_variant) = TYPE_POINTER_TO (fwdtype); TYPE_REFERENCE_TO (new_variant) = TYPE_REFERENCE_TO (fwdtype); } +#else + patch_type (type, otype); +#endif }
/* Declare the types */ diff -u p.nn/gpc.h p/gpc.h --- p.nn/gpc.h Sun Jul 3 02:30:53 2005 +++ p/gpc.h Wed Jul 6 17:33:22 2005 @@ -1182,6 +1182,7 @@ extern void pascal_expand_goto (tree); extern void do_setjmp (void); extern tree build_type_decl (tree, tree, tree); +extern void patch_type (tree type, tree otype); extern void declare_types (void); extern tree pascal_shadow_record_fields (tree, tree); extern void restore_identifiers (tree); diff -u p.nn/objects.c p/objects.c --- p.nn/objects.c Sun Jul 3 02:30:53 2005 +++ p/objects.c Wed Jul 6 17:58:17 2005 @@ -240,8 +240,23 @@ is_class = 1; if (is_class) { - res = build_pointer_type (t); - PASCAL_TYPE_CLASS (res) = 1; + tree s, *pscan; + pscan = ¤t_type_list; + for (s = current_type_list; s && TREE_VALUE (s) != name; + pscan = &TREE_CHAIN (s), s = TREE_CHAIN (s)) ; + if (s && TREE_CODE (TREE_TYPE (TREE_PURPOSE (s))) == POINTER_TYPE + && PASCAL_TYPE_CLASS (TREE_TYPE (TREE_PURPOSE (s))) + && TREE_CODE (TREE_TYPE (TREE_TYPE (TREE_PURPOSE (s)))) == LANG_TYPE) + { + res = TREE_TYPE (TREE_PURPOSE (s)); + patch_type (t, TREE_TYPE (res)); + *pscan = TREE_CHAIN (s); + } + else + { + res = build_pointer_type (t); + PASCAL_TYPE_CLASS (res) = 1; + } } else res = t; diff -u p.nn/parse.y p/parse.y --- p.nn/parse.y Sun Jul 3 02:30:53 2005 +++ p/parse.y Wed Jul 6 14:27:55 2005 @@ -747,6 +747,12 @@ finish_object_type ($<ttype>4, $7, $8, $5 != NULL_TREE); yyerrok; } + | new_identifier enable_lce equals p_class LEX_RANGE p_end + { + tree t = build_pascal_pointer_type (make_node (LANG_TYPE)); + PASCAL_TYPE_CLASS (t) = 1; + build_type_decl ($1, t, NULL_TREE); + }
;