Module contains procedures for converting AST types into
Type.T's. The main procedure is Convert()
MODULE\subsection{Procedure Convert} Allocate the cache-table with already parsed types specifications, initialize it and call; IMPORT Atom, PropertyV, RefRefTbl, FRefRefTbl; IMPORT M3CId, Type, Value; IMPORT M3AST_AS, M3AST_AS_F, M3AST_SM, M3AST_SM_F, M3AST_TM_F, M3ASTNext, M3AST_TL_F, M3AST_LX, M3CConcTypeSpec, M3CStdTypes; IMPORT SeqM3AST_AS_Enum_id, SeqM3AST_AS_Fields, SeqM3AST_AS_Field_id, SeqM3AST_AS_Method, SeqM3AST_AS_Qual_used_id, M3CTypesMisc; IMPORT M3CBackEnd_C; AstToType
ProcessM3Type().
PROCEDURE\subsection{Conversion from M3AST type to Type.T} The proceduresConvert (m3type: M3AST_AS.M3TYPE): Type.T = VAR astMap:= NEW(FRefRefTbl.Default).init(); BEGIN InitAstTable(astMap); RETURN ProcessM3Type(astMap, m3type); END Convert; PROCEDUREInitAstTable (astTable: RefRefTbl.T) = BEGIN EVAL astTable.put(M3CStdTypes.Integer(), Type.integer); EVAL astTable.put(M3CStdTypes.Longint(), Type.longint); EVAL astTable.put(M3CStdTypes.Real(), Type.real); EVAL astTable.put(M3CStdTypes.LongReal(), Type.longreal); EVAL astTable.put(M3CStdTypes.Extended(), Type.extended); EVAL astTable.put(M3CStdTypes.Null(), Type.null); EVAL astTable.put(M3CStdTypes.RefAny(), Type.refany); EVAL astTable.put(M3CStdTypes.Address(), Type.address); EVAL astTable.put(M3CStdTypes.Root(), Type.root); EVAL astTable.put(M3CStdTypes.Untraced_Root(), Type.untracedRoot); EVAL astTable.put(M3CStdTypes.Char(), Type.char); EVAL astTable.put(M3CStdTypes.WideChar(), Type.widechar); EVAL astTable.put(M3CStdTypes.Text(), Type.text); EVAL astTable.put(M3CStdTypes.Cardinal(), Type.cardinal); EVAL astTable.put(M3CStdTypes.Longcard(), Type.longcard); EVAL astTable.put(M3CStdTypes.Boolean(), Type.boolean); EVAL astTable.put(M3CStdTypes.Mutex(), Type.mutex); END InitAstTable;
ProcessM3Type() and ProcessTypeSpec() recursivly
descend a M3AST-type specification node and generate a Type.T out
of it. The procedures ProcessObject(), ProcessFields(),
ProcessExp() and ProcessMethods() are auxilary procedures for
that purpose. All of these have a parameter astTable which is
used to save all already parsed types. AddToTable() is called to
add another entry to that table. This procedure also looks up the
property list of the node to gather a name for the type (see
TypeNames.Preprocess()).
PROCEDUREProcessM3Type (astMap: RefRefTbl.T; m3type: M3AST_AS.M3TYPE): Type.T = VAR ts: M3AST_AS.TYPE_SPEC; BEGIN M3CTypesMisc.GetTYPE_SPECFromM3TYPE(m3type, ts); RETURN ProcessTypeSpec(astMap, ts); END ProcessM3Type; PROCEDUREProcessTypeSpec (astMap: RefRefTbl.T; ts : M3AST_AS.TYPE_SPEC): Type.T = VAR r: REFANY; t: Type.T; BEGIN IF astMap.get(ts, r) THEN RETURN NARROW(r, Type.T); ELSE TYPECASE ts OF | M3AST_AS.Real_type => t := Type.real; | M3AST_AS.LongReal_type => t := Type.longreal; | M3AST_AS.Extended_type => t := Type.extended; | M3AST_AS.Integer_type => t := Type.integer; | M3AST_AS.Longint_type => t := Type.longint; | M3AST_AS.WideChar_type => t := Type.widechar; | M3AST_AS.Null_type => t := Type.null; | M3AST_AS.RefAny_type => t := Type.refany; | M3AST_AS.Address_type => t := Type.address; | M3AST_AS.Root_type (rt) => TYPECASE rt.as_trace_mode OF | NULL => t := Type.root ELSE t := Type.untracedRoot END; | M3AST_AS.Packed_type (pt) => t := NEW(Type.Packed, size := NARROW(pt.as_exp.sm_exp_value, M3CBackEnd_C.Integer_value).sm_value, base := ProcessM3Type(astMap, pt.as_type)); | M3AST_AS.Array_type (at) => VAR ASTindexType: M3AST_SM.TYPE_SPEC_UNSET; eltTypeSpec : M3AST_SM.TYPE_SPEC_UNSET; openArray : BOOLEAN; BEGIN EVAL M3ASTNext.Array(at, eltTypeSpec, openArray, ASTindexType); IF openArray THEN t := NEW(Type.OpenArray, index := NIL, element := ProcessTypeSpec(astMap, eltTypeSpec)); WITH openA = NARROW(t, Type.OpenArray), refArray = NEW(Type.Ref, traced := TRUE, target := t) DO openA.refArray := refArray; TYPECASE openA.element OF | Type.OpenArray (element) => openA.openDimensions := element.openDimensions + 1; ELSE openA.openDimensions := 1; END; END; ELSE t := NEW(Type.Array, index := ProcessM3Type(astMap, ASTindexType), element := ProcessTypeSpec(astMap, eltTypeSpec)); END; END; | M3AST_AS.Enumeration_type (enum) => VAR enumt := NEW( Type.UserDefined, elts := NEW(REF ARRAY OF Atom.T, enum.sm_num_elements)); iter := SeqM3AST_AS_Enum_id.NewIter(enum.as_id_s); elem: M3AST_AS.Enum_id; BEGIN FOR i := 1 TO enum.sm_num_elements DO EVAL SeqM3AST_AS_Enum_id.Next(iter, elem); enumt.elts[i - 1] := Atom.FromText(M3CId.ToText(elem.lx_symrep)); END; t := enumt; END; | M3AST_AS.Set_type (set) => t := NEW(Type.Set, range := ProcessM3Type(astMap, set.as_type)); | M3AST_AS.Subrange_type (sub) => TYPECASE sub.sm_base_type_spec OF | M3AST_AS.Longint_type => WITH baseType = ProcessTypeSpec(astMap, sub.sm_base_type_spec), e1 = NARROW(sub.as_range, M3AST_AS.Range).as_exp1, e2 = NARROW(sub.as_range, M3AST_AS.Range).as_exp2, i1 = NARROW(e1.sm_exp_value, M3CBackEnd_C.Longint_value).sm_value, i2 = NARROW(e2.sm_exp_value, M3CBackEnd_C.Longint_value).sm_value DO t := NEW(Type.Subrange, base := baseType, min := NEW(Value.Longint, val := i1), max := NEW(Value.Longint, val := i2)); END; ELSE WITH baseType = ProcessTypeSpec(astMap, sub.sm_base_type_spec), e1 = NARROW(sub.as_range, M3AST_AS.Range).as_exp1, e2 = NARROW(sub.as_range, M3AST_AS.Range).as_exp2, i1 = NARROW(e1.sm_exp_value, M3CBackEnd_C.Integer_value).sm_value, i2 = NARROW(e2.sm_exp_value, M3CBackEnd_C.Integer_value).sm_value DO t := NEW(Type.Subrange, base := baseType, min := NEW(Value.Integer, val := i1), max := NEW(Value.Integer, val := i2)); END; END; | M3AST_AS.Record_type (rec) => t := NEW(Type.Record, fields := ProcessFields(astMap, rec.as_fields_s)); | M3AST_AS.BRANDED_TYPE (bt) => VAR brandName: Atom.T := NIL; branded := FALSE; trace : BOOLEAN; BEGIN IF bt.as_brand # NIL THEN IF bt.as_brand.as_exp # NIL THEN brandName := Atom.FromText(NARROW(bt.as_brand.as_exp.sm_exp_value, M3CBackEnd_C.Text_value).sm_value); END; branded := TRUE END; TYPECASE bt OF | M3AST_AS.Ref_type (ref) => TYPECASE ref.as_trace_mode OF | NULL => trace := TRUE; ELSE trace := FALSE; END; t := NEW(Type.Ref, traced := trace, branded := branded, brand := brandName); AddToTable(astMap, ts, t); NARROW(t, Type.Ref).target := ProcessM3Type(astMap, ref.as_type); | M3AST_AS.Object_type (ob) => t := ProcessObject(astMap, ob, branded, brandName, trace); ELSE <*ASSERT FALSE*> END; END; | M3AST_AS.Opaque_type (o) => IF o.sm_concrete_type_spec = NIL THEN WITH revSuperTs = M3CConcTypeSpec.CurrentReveal(o), revSuperType = NARROW(ProcessTypeSpec(astMap, revSuperTs), Type.Reference) DO t := NEW(Type.Opaque, revealedSuperType := revSuperType); END; ELSE WITH revTs = o.sm_concrete_type_spec DO t := ProcessTypeSpec(astMap, revTs); WITH tt = NARROW(t, Type.Object) DO tt.revIntf := Atom.FromText(M3CId.ToText(revTs.tmp_unit_id.lx_symrep)); END; END; END; | M3AST_AS.Procedure_type (proc) => VAR formals : REF ARRAY OF Type.Formal; nFormals: INTEGER := 0; iter := M3ASTNext.NewIterFormal(proc.as_formal_param_s); formalParam: M3AST_AS.Formal_param; formalId : M3AST_AS.FORMAL_ID; signature : Type.Signature; BEGIN WHILE M3ASTNext.Formal(iter, formalParam, formalId) DO INC(nFormals) END; formals := NEW(REF ARRAY OF Type.Formal, nFormals); iter := M3ASTNext.NewIterFormal(proc.as_formal_param_s); FOR i := 0 TO nFormals - 1 DO EVAL M3ASTNext.Formal(iter, formalParam, formalId); formals[i] := NEW(Type.Formal); formals[i].name := Atom.FromText(M3CId.ToText(formalId.lx_symrep)); formals[i].type := ProcessM3Type(astMap, formalId.sm_type_spec); TYPECASE formalId OF M3AST_AS.F_Value_id => formals[i].mode := Type.Mode.Value; | M3AST_AS.F_Var_id => formals[i].mode := Type.Mode.Var; | M3AST_AS.F_Readonly_id => formals[i].mode := Type.Mode.Readonly; ELSE <*ASSERT FALSE*> END; formals[i].outOnly := FALSE; (* Change to depend on <*OUTPUT*> *) END; signature.formals := formals; IF proc.as_result_type # NIL THEN signature.result := ProcessM3Type(astMap, proc.as_result_type); END; IF proc.as_raises = NIL THEN signature.raises := NEW(REF ARRAY OF Type.Exception, 0) ELSE TYPECASE proc.as_raises OF M3AST_AS.Raisees_some (r) => VAR iter := SeqM3AST_AS_Qual_used_id.NewIter( r.as_raisees_s); nRaises := SeqM3AST_AS_Qual_used_id.Length( r.as_raisees_s); raisee : M3AST_AS.Qual_used_id; arg : M3AST_AS.Exc_id; argType: Type.T; BEGIN signature.raises := NEW(REF ARRAY OF Type.Exception, nRaises); FOR i := 0 TO nRaises - 1 DO EVAL SeqM3AST_AS_Qual_used_id.Next(iter, raisee); signature.raises[i] := NEW(Type.Exception); signature.raises[i].qid := NEW(Type.Qid); WITH qid = signature.raises[i].qid DO qid.intf := Atom.FromText( M3CId.ToText( raisee.as_id.sm_def.tmp_unit_id.lx_symrep)); qid.item := Atom.FromText( M3CId.ToText(raisee.as_id.lx_symrep)); END; IF raisee.as_id.sm_def = NIL THEN signature.raises[i].arg := NIL ELSE arg := NARROW(raisee.as_id.sm_def, M3AST_AS.Exc_id); IF arg.tmp_type = NIL THEN signature.raises[i].arg := NIL; ELSE argType := ProcessM3Type(astMap, arg.tmp_type); signature.raises[i].arg := argType; END; END; END; END; | M3AST_AS.Raisees_any => ELSE signature.raises := NEW(REF ARRAY OF Type.Exception, 0) END; END; t := NEW(Type.Procedure, sig := signature); END; ELSE END; END; AddToTable(astMap, ts, t); RETURN t; END ProcessTypeSpec; PROCEDUREProcessObject (astMap : RefRefTbl.T; o : M3AST_AS.Object_type; branded: BOOLEAN; brand : Atom.T; traced : BOOLEAN ): Type.T = VAR t := NEW(Type.Object); BEGIN AddToTable(astMap, o, t); t.branded := branded; t.brand := brand; t.traced := traced; IF o.as_ancestor # NIL THEN t.super := ProcessM3Type(astMap, o.as_ancestor); END; t.fields := ProcessFields(astMap, o.as_fields_s); t.methods := ProcessMethods(astMap, o.as_method_s); RETURN t; END ProcessObject; PROCEDUREProcessFields (astMap: RefRefTbl.T; f: SeqM3AST_AS_Fields.T): REF ARRAY OF Type.Field = VAR nFields : INTEGER := 0; fields : REF ARRAY OF Type.Field; iter := M3ASTNext.NewIterField(f); iterItems := SeqM3AST_AS_Fields.NewIter(f); iterIds : SeqM3AST_AS_Field_id.Iter; astFields: M3AST_AS.Fields; fieldId : M3AST_AS.Field_id; j : INTEGER := 0; BEGIN WHILE M3ASTNext.Field(iter, fieldId) DO INC(nFields) END; fields := NEW(REF ARRAY OF Type.Field, nFields); WHILE SeqM3AST_AS_Fields.Next(iterItems, astFields) DO iterIds := SeqM3AST_AS_Field_id.NewIter(astFields.as_id_s); WHILE SeqM3AST_AS_Field_id.Next(iterIds, fieldId) DO fields[j] := NEW(Type.Field); fields[j].name := Atom.FromText(M3CId.ToText(fieldId.lx_symrep)); IF astFields.as_type = NIL THEN fields[j].type := ProcessTypeSpec(astMap, fieldId.sm_type_spec) ELSE fields[j].type := ProcessM3Type(astMap, astFields.as_type); END; IF (*fieldId.vINIT_ID.sm_init_exp*) astFields.as_default # NIL THEN fields[j].default := ProcessExp(astFields.as_default); END; INC(j); END; END; RETURN fields; END ProcessFields; PROCEDUREProcessMethods (astMap: RefRefTbl.T; m: SeqM3AST_AS_Method.T): REF ARRAY OF Type.Method = VAR nMethods := SeqM3AST_AS_Method.Length(m); methods : REF ARRAY OF Type.Method; iter := SeqM3AST_AS_Method.NewIter(m); astMethod: M3AST_AS.Method; BEGIN methods := NEW(REF ARRAY OF Type.Method, nMethods); FOR i := 0 TO nMethods - 1 DO EVAL SeqM3AST_AS_Method.Next(iter, astMethod); methods[i] := NEW(Type.Method); methods[i].name := Atom.FromText(M3CId.ToText(astMethod.as_id.lx_symrep)); methods[i].sig := NARROW(ProcessTypeSpec(astMap, astMethod.as_type), Type.Procedure).sig; END; RETURN methods; END ProcessMethods; PROCEDUREProcessExp (exp: M3AST_AS.EXP): Value.T = BEGIN TYPECASE exp.sm_exp_value OF | M3CBackEnd_C.Integer_value (int) => RETURN NEW(Value.Integer, val := int.sm_value) | M3CBackEnd_C.Longint_value (int) => RETURN NEW(Value.Longint, val := int.sm_value) | M3CBackEnd_C.Text_value (txt) => RETURN NEW(Value.Txt, val := txt.sm_value) | M3CBackEnd_C.Real_value (real) => RETURN NEW(Value.Float, val := real.sm_value); | M3CBackEnd_C.LongReal_value (lreal) => RETURN NEW(Value.LongFloat, val := lreal.sm_value); | M3CBackEnd_C.Extended_value (ereal) => RETURN NEW(Value.Extended, val := ereal.sm_value); (* | M3CBackEnd_C.Set_constructor_value => | M3CBackEnd_C.Array_or_record_constructor_value => | M3CBackEnd_C.Proc_value => *) ELSE <*ASSERT FALSE*> END; END ProcessExp; PROCEDUREAddToTable (astMap: RefRefTbl.T; ts : M3AST_AS.TYPE_SPEC; t : Type.T ) = BEGIN EVAL astMap.put(ts, t); IF t.name = NIL THEN WITH symrep = NARROW(PropertyV.Get( ts.tl_pset, TYPECODE(M3AST_LX.Symbol_rep)), M3AST_LX.Symbol_rep) DO IF symrep # NIL THEN t.name := NEW(Type.Qid); t.name.intf := Atom.FromText( M3CId.ToText(ts.tmp_unit_id.lx_symrep)); t.name.item := Atom.FromText(M3CId.ToText(symrep)); END; END; END; END AddToTable; BEGIN END AstToType.