diff options
Diffstat (limited to 'frontend/syntax.icl')
-rw-r--r-- | frontend/syntax.icl | 62 |
1 files changed, 40 insertions, 22 deletions
diff --git a/frontend/syntax.icl b/frontend/syntax.icl index c46ffeb..f6900f9 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -831,12 +831,15 @@ cNotVarNumber :== -1 | KI_NormVar !Int -:: TypeVarInfo = TVI_Empty | TVI_Type !Type | TVI_Forward !TempVarId | TVI_TypeKind !KindInfoPtr +:: TypeVarInfo = TVI_Empty + | TVI_Type !Type + | TVI_TypeVar !TypeVarInfoPtr // Sjaak: to collect universally quantified type variables + | TVI_Forward !TempVarId | TVI_TypeKind !KindInfoPtr | TVI_SignClass !Index !SignClassification !TypeVarInfo | TVI_PropClass !Index !PropClassification !TypeVarInfo | TVI_Attribute TypeAttribute | TVI_CorrespondenceNumber !Int /* auxiliary used in module comparedefimp */ | TVI_AType !AType /* auxiliary used in module comparedefimp */ - | TVI_Used /* to adminster that this variable is encountered (in checkOpenTypes) */ + | TVI_Used /* to administer that this variable is encountered (in checkOpenTypes) */ | TVI_TypeCode !TypeCodeExpression | TVI_CPSLocalTypeVar !Int /* MdM - the index of the variable as generated by the theorem prover */ | TVI_Kinds ![TypeKind] // AA: used to collect kinds during checking @@ -847,10 +850,14 @@ cNotVarNumber :== -1 :: TypeVarInfoPtr :== Ptr TypeVarInfo :: TypeVarHeap :== Heap TypeVarInfo -:: AttrVarInfo = AVI_Empty | AVI_Attr !TypeAttribute | AVI_Forward !TempAttrId +:: AttrVarInfo = AVI_Empty + | AVI_Attr !TypeAttribute + | AVI_AttrVar !AttrVarInfoPtr // Sjaak: to collect universally quantified attribute variables + | AVI_Forward !TempAttrId | AVI_CorrespondenceNumber !Int /* auxiliary used in module comparedefimp */ | AVI_Used | AVI_Count !Int /* auxiliary used in module typesupport */ + :: AttrVarInfoPtr :== Ptr AttrVarInfo :: AttrVarHeap :== Heap AttrVarInfo @@ -1101,7 +1108,7 @@ cIsNotStrict :== False { dyn_expr :: !Expression , dyn_opt_type :: !Optional DynamicType , dyn_info_ptr :: !ExprInfoPtr - , dyn_uni_vars :: ![VarInfoPtr] /* filled after type checking */ +// , dyn_uni_vars :: ![VarInfoPtr] /* filled after type checking */ , dyn_type_code :: !TypeCodeExpression /* filled after type checking */ } @@ -1114,7 +1121,12 @@ cIsNotStrict :== False | ArraySelection !(Global DefinedSymbol) !ExprInfoPtr !Expression | DictionarySelection !BoundVar ![Selection] !ExprInfoPtr !Expression -:: TypeCodeExpression = TCE_Empty | TCE_Var !VarInfoPtr /* MV */ | TCE_TypeTerm !VarInfoPtr | TCE_Constructor !Index ![TypeCodeExpression] | TCE_Selector ![Selection] !VarInfoPtr +:: TypeCodeExpression = TCE_Empty + | TCE_Var !VarInfoPtr + | TCE_TypeTerm !VarInfoPtr + | TCE_Constructor !Index ![TypeCodeExpression] + | TCE_Selector ![Selection] !VarInfoPtr + | TCE_UniType ![VarInfoPtr] !TypeCodeExpression :: GlobalTCType = GTT_Basic !BasicType | GTT_Constructor !TypeSymbIdent !String | GTT_Function @@ -1254,11 +1266,11 @@ where instance <<< TypeVar where (<<<) file varid = file <<< varid.tv_name -// (<<<) file varid = file <<< varid.tv_name <<< "<" <<< ptrToInt (varid.tv_info_ptr) <<< ">" +// (<<<) file varid = file <<< varid.tv_name <<< "<" <<< varid.tv_info_ptr <<< ">" instance <<< AttributeVar where -// (<<<) file {av_name,av_info_ptr} = file <<< av_name <<< "[" <<< ptrToInt av_info_ptr <<< "]" +// (<<<) file {av_name,av_info_ptr} = file <<< av_name <<< "[" <<< av_info_ptr <<< "]" (<<<) file {av_name,av_info_ptr} = file <<< av_name instance toString AttributeVar @@ -1336,9 +1348,9 @@ where = file <<< type <<< " @" <<< types (<<<) file (TB tb) = file <<< tb -/* (<<<) file (TFA vars types) + (<<<) file (TFA vars types) = file <<< "A." <<< vars <<< ':' <<< types -*/ (<<<) file (TQV varid) + (<<<) file (TQV varid) = file <<< "E." <<< varid (<<<) file (TempQV tv_number) = file <<< "E." <<< tv_number <<< ' ' @@ -1388,7 +1400,7 @@ where instance <<< TypeContext where - (<<<) file co = file <<< co.tc_class <<< " " <<< co.tc_types <<< " <" <<< ptrToInt co.tc_var <<< '>' + (<<<) file co = file <<< co.tc_class <<< " " <<< co.tc_types <<< " <" <<< co.tc_var <<< '>' instance <<< SymbIdent where @@ -1414,7 +1426,7 @@ where instance <<< BoundVar where (<<<) file {var_name,var_info_ptr,var_expr_ptr} - = file <<< var_name <<< "<I" <<< ptrToInt var_info_ptr <<< ", E" <<< ptrToInt var_expr_ptr <<< '>' + = file <<< var_name <<< "<I" <<< var_info_ptr <<< ", E" <<< var_expr_ptr <<< '>' instance <<< (Bind a b) | <<< a & <<< b where @@ -1507,7 +1519,8 @@ where (<<<) file (MatchExpr _ cons expr) = file <<< cons <<< " =: " <<< expr (<<<) file EE = file <<< "** E **" (<<<) file (NoBind _) = file <<< "** NB **" - (<<<) file (DynamicExpr {dyn_expr,dyn_uni_vars,dyn_type_code}) = writeVarPtrs (file <<< "dynamic " <<< dyn_expr <<< " :: dyn_uni_vars") dyn_uni_vars <<< "dyn_type_code=" <<< dyn_type_code + (<<<) file (DynamicExpr {dyn_expr,dyn_type_code}) = file <<< "dynamic " <<< dyn_expr <<< " :: " <<< dyn_type_code +// (<<<) file (DynamicExpr {dyn_expr,dyn_uni_vars,dyn_type_code}) = writeVarPtrs (file <<< "dynamic " <<< dyn_expr <<< " :: dyn_uni_vars") dyn_uni_vars <<< "dyn_type_code=" <<< dyn_type_code // (<<<) file (TypeCase type_case) = file <<< type_case (<<<) file (TypeCodeExpression type_code) = file <<< type_code (<<<) file (Constant symb _ _ _) = file <<< "** Constant **" <<< symb @@ -1516,7 +1529,7 @@ where (<<<) file (AnyCodeExpr input output code_sequence) = file <<< "code\n" <<< input <<< "\n" <<< output <<< "\n" <<< code_sequence (<<<) file (FreeVar {fv_name}) = file <<< fv_name - (<<<) file (ClassVariable info_ptr) = file <<< "ClassVariable " <<< ptrToInt info_ptr + (<<<) file (ClassVariable info_ptr) = file <<< "ClassVariable " <<< info_ptr (<<<) file expr = abort ("<<< (Expression) [line 1290]" )//<<- expr) @@ -1542,9 +1555,9 @@ writeVarPtrs file vars = write_var_ptrs (file <<< '<') vars <<< '>' where write_var_ptrs file [var] - = file <<< ptrToInt var + = file <<< var write_var_ptrs file [var : vars] - = write_var_ptrs (file <<< ptrToInt var <<< '.') vars + = write_var_ptrs (file <<< var <<< '.') vars instance <<< TypeCodeExpression @@ -1552,15 +1565,20 @@ where (<<<) file TCE_Empty = file (<<<) file (TCE_Var info_ptr) - = file <<< "TCE_Var " <<< ptrToInt info_ptr -// MV .. + = file <<< "TCE_Var " <<< info_ptr (<<<) file (TCE_TypeTerm info_ptr) - = file <<< "TCE_TypeTerm " <<< ptrToInt info_ptr -// .. MV + = file <<< "TCE_TypeTerm " <<< info_ptr (<<<) file (TCE_Constructor index exprs) = file <<< "TCE_Constructor " <<< index <<< ' ' <<< exprs (<<<) file (TCE_Selector selectors info_ptr) - = file <<< "TCE_Selector " <<< selectors <<< "VAR " <<< ptrToInt info_ptr + = file <<< "TCE_Selector " <<< selectors <<< "VAR " <<< info_ptr + (<<<) file (TCE_UniType vars type_code) + = file <<< "TCE_UniType " <<< vars <<< " " <<< type_code + +instance <<< (Ptr a) +where + (<<<) file ptr + = file <<< ptrToInt ptr instance <<< Selection where @@ -1688,7 +1706,7 @@ where instance <<< FreeVar where - (<<<) file {fv_name,fv_info_ptr,fv_count} = file <<< fv_name <<< '.' <<< fv_count <<< '<' <<< ptrToInt fv_info_ptr <<< '>' + (<<<) file {fv_name,fv_info_ptr,fv_count} = file <<< fv_name <<< '.' <<< fv_count <<< '<' <<< fv_info_ptr <<< '>' instance <<< DynamicType where @@ -1951,7 +1969,7 @@ where instance <<< Declaration where (<<<) file (Declaration { decl_ident, decl_kind }) - = file <<< decl_ident <<< '<' <<< ptrToInt decl_ident.id_info <<< '>' <<< '(' <<< decl_kind <<< ')' + = file <<< decl_ident <<< '<' <<< decl_ident.id_info <<< '>' <<< '(' <<< decl_kind <<< ')' instance <<< STE_Kind where |