aboutsummaryrefslogtreecommitdiff
path: root/frontend/syntax.icl
diff options
context:
space:
mode:
Diffstat (limited to 'frontend/syntax.icl')
-rw-r--r--frontend/syntax.icl62
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