diff options
| -rw-r--r-- | frontend/check.icl | 13 | ||||
| -rw-r--r-- | frontend/convertDynamics.icl | 38 | ||||
| -rw-r--r-- | frontend/overloading.icl | 2 | ||||
| -rw-r--r-- | frontend/predef.dcl | 79 | ||||
| -rw-r--r-- | frontend/predef.icl | 89 |
5 files changed, 111 insertions, 110 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index a206af6..6ab0078 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -3001,16 +3001,17 @@ where = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} <=< adjustPredefSymbol PD_TypeObjectType mod_index STE_Type <=< adjustPredefSymbol PD_TypeConsSymbol mod_index STE_Constructor - <=< adjustPredefSymbol PD_variablePlaceholder mod_index STE_Constructor - <=< adjustPredefSymbol PD_UvariablePlaceholder mod_index STE_Constructor - <=< adjustPredefSymbol PD_unify mod_index STE_DclFunction + <=< adjustPredefSymbol PD_PV_Placeholder mod_index STE_Constructor + <=< adjustPredefSymbol PD_UPV_Placeholder mod_index STE_Constructor + <=< adjustPredefSymbol PD_UV_Placeholder mod_index STE_Constructor + <=< adjustPredefSymbol PD_unify mod_index STE_DclFunction <=< adjustPredefSymbol PD_coerce mod_index STE_DclFunction - <=< adjustPredefSymbol PD_undo_indirections mod_index STE_DclFunction + <=< adjustPredefSymbol PD_undo_indirections mod_index STE_DclFunction <=< adjustPredefSymbol PD_DynamicTemp mod_index STE_Type <=< adjustPredefSymbol PD_DynamicType mod_index (STE_Field unused) - <=< adjustPredefSymbol PD_DynamicValue mod_index (STE_Field unused) + <=< adjustPredefSymbol PD_DynamicValue mod_index (STE_Field unused) <=< adjustPredefSymbol PD_TypeID mod_index STE_Type - <=< adjustPredefSymbol PD_ModuleID mod_index STE_Constructor) + <=< adjustPredefSymbol PD_ModuleID mod_index STE_Constructor) # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric] # type_iso_ident = predefined_idents.[PD_TypeISO] | pre_mod.pds_def == mod_index diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index 6744d11..5a7ba18 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -13,7 +13,6 @@ extended_unify_and_coerce no yes :== no; // change also _unify and _coerce in St import type_io; //import pp; -//import RWSDebug; /*2.0 from type_io_common import class toString (..),instance toString GlobalTCType; @@ -493,7 +492,7 @@ where /* Sjaak ... */ convertDynamics cinp bound_vars default_expr (DynamicExpr {dyn_expr, dyn_info_ptr, dyn_type_code}) ci=:{ci_symb_ident} # (dyn_expr, ci) = convertDynamics cinp bound_vars default_expr dyn_expr ci - (_,dyn_type_code, _, _, ci) = convertTypecode2 cinp dyn_type_code False [] [] ci + (_,dyn_type_code, _, _, ci) = convertTypecode2 cinp dyn_type_code False PD_UV_Placeholder [] [] ci = (App { app_symb = ci_symb_ident, app_args = [dyn_expr, dyn_type_code], app_info_ptr = nilPtr }, ci) @@ -525,7 +524,6 @@ where convertDynamics cinp bound_vars default_expr expression ci = abort "unexpected value in convertDynamics: 'convertDynamics.Expression'" -//convertTypecode :: !ConversionInput TypeCodeExpression !*ConversionInfo -> (Expression,!*ConversionInfo) /* replace all references in a type code expression which refer to an argument i.e. the argument contains a type to their placeholders. Return is a list of (placeholder,argument) list. Each tuple is used later as @@ -535,10 +533,10 @@ where */ /* Sjaak ... */ -convertTypecode2 cinp (TCE_UniType uni_vars type_code) replace_tc_args binds placeholders_and_tc_args ci - # (let_binds, ci) = createUniversalVariables uni_vars [] ci +convertTypecode2 cinp (TCE_UniType uni_vars type_code) replace_tc_args uni_placeholder binds placeholders_and_tc_args ci + # (let_binds, ci) = createUniversalVariables uni_placeholder uni_vars [] ci (let_info_ptr, ci) = let_ptr (length let_binds) ci - (e, type_code_expr, binds, placeholders_and_tc_args, ci) = convertTypecode2 cinp type_code False [] [] ci + (e, type_code_expr, binds, placeholders_and_tc_args, ci) = convertTypecode2 cinp type_code False uni_placeholder [] [] ci = (e, Let { let_strict_binds = [], let_lazy_binds = let_binds, let_expr = type_code_expr, @@ -547,7 +545,7 @@ convertTypecode2 cinp (TCE_UniType uni_vars type_code) replace_tc_args binds pla /* ... Sjaak */ // ci_placeholders_and_tc_args -convertTypecode2 cinp=:{cinp_st_args} t=:(TCE_Var var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci +convertTypecode2 cinp=:{cinp_st_args} t=:(TCE_Var var_info_ptr) replace_tc_args uni_placeholder binds placeholders_and_tc_args ci #! cinp_st_args = filter (\{fv_info_ptr} -> fv_info_ptr == var_info_ptr) cinp_st_args | isEmpty cinp_st_args @@ -562,7 +560,7 @@ convertTypecode2 cinp=:{cinp_st_args} t=:(TCE_Var var_info_ptr) replace_tc_args */ = (True,Var {var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr},binds,placeholders_and_tc_args,ci) -convertTypecode2 cinp=:{cinp_st_args} t=:(TCE_TypeTerm var_info_ptr) replace_tc_args binds placeholders_and_tc_args ci +convertTypecode2 cinp=:{cinp_st_args} t=:(TCE_TypeTerm var_info_ptr) replace_tc_args uni_placeholder binds placeholders_and_tc_args ci #! cinp_st_args = filter (\{fv_info_ptr} -> fv_info_ptr == var_info_ptr) cinp_st_args | isEmpty cinp_st_args @@ -579,7 +577,7 @@ convertTypecode2 cinp=:{cinp_st_args} t=:(TCE_TypeTerm var_info_ptr) replace_tc_ // = convertTypecode2 cinp t replace_tc_args binds placeholders_and_tc_args ci -convertTypecode2 cinp t replace_tc_args binds placeholders_and_tc_args ci +convertTypecode2 cinp t replace_tc_args uni_placeholder binds placeholders_and_tc_args ci #! (e,binds,placeholders_and_tc_args,ci) = convertTypecode cinp t replace_tc_args binds placeholders_and_tc_args ci = (False,e,binds,placeholders_and_tc_args,ci) @@ -792,7 +790,7 @@ where // MW0 create_variable :: !Ident VarInfoPtr !*ConversionInfo -> (Bind Expression FreeVar, !*ConversionInfo) create_variable :: !Ident VarInfoPtr !*ConversionInfo -> (LetBind, !*ConversionInfo) create_variable var_name var_info_ptr ci - # (placeholder_symb, ci) = getSymbol PD_variablePlaceholder SK_Constructor 2 ci + # (placeholder_symb, ci) = getSymbol PD_PV_Placeholder SK_Constructor 2 ci cyclic_var = {var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} cyclic_fv = varToFreeVar cyclic_var 1 // MW0 = ({ bind_src = App { app_symb = placeholder_symb, @@ -891,7 +889,6 @@ where -> ([LetBind], Expression, *ConversionInfo) convert_dynamic_pattern cinp bound_vars this_default pattern_number opened_dynamic result_type last_default [{ dp_var, dp_type_patterns_vars, dp_type_code, dp_rhs } : patterns] ci=:{ci_module_id_symbol} - # /*** The last case may not have a default ***/ ind_var = getIndirectionVar this_default @@ -901,7 +898,7 @@ where /*** convert the elements of this pattern ***/ (a_ij_binds, ci) = createTypePatternVariables dp_type_patterns_vars [] ci - (generate_coerce,type_code,_,martijn, ci) = convertTypecode2 cinp dp_type_code True /* should be changed to True for type dependent functions */ /* WAS: a_ij_binds*/ [] [] ci //{ci & ci_module_id = No} // ci + (generate_coerce,type_code,_,martijn, ci) = convertTypecode2 cinp dp_type_code True /* should be changed to True for type dependent functions */ /* WAS: a_ij_binds*/ PD_UPV_Placeholder [] [] ci //{ci & ci_module_id = No} // ci // collect ... # (is_last_dynamic_pattern,dp_rhs) @@ -1111,25 +1108,24 @@ generateBinding cinp bound_vars var bind_expr result_type ci /**************************************************************************************************/ // MW0 createVariables :: [VarInfoPtr] !(Env Expression FreeVar) !*ConversionInfo -> (!Env Expression FreeVar, !*ConversionInfo) -createUniversalVariables :: [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) -createUniversalVariables var_info_ptrs binds ci - = createVariables2 True var_info_ptrs binds ci; +createUniversalVariables :: !Int [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) +createUniversalVariables kind var_info_ptrs binds ci + | kind == PD_UPV_Placeholder || kind == PD_UV_Placeholder + = createVariables2 /*PD_UPV_Placeholder*/ kind var_info_ptrs binds ci; createTypePatternVariables :: [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) createTypePatternVariables var_info_ptrs binds ci - = createVariables2 False var_info_ptrs binds ci; + = createVariables2 PD_PV_Placeholder var_info_ptrs binds ci; -createVariables2 :: !Bool [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) -createVariables2 generate_universal_type_variables var_info_ptrs binds ci +createVariables2 :: !Int [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) +createVariables2 universal_type_variable_kind var_info_ptrs binds ci = mapAppendSt (create_variable a_ij_var_name) var_info_ptrs binds ci where // MW0create_variable :: !Ident VarInfoPtr !*ConversionInfo -> (Bind Expression FreeVar, !*ConversionInfo) create_variable :: !Ident VarInfoPtr !*ConversionInfo -> (LetBind, !*ConversionInfo) create_variable var_name var_info_ptr ci # (placeholder_symb, ci) - = case generate_universal_type_variables of - False -> getSymbol PD_variablePlaceholder SK_Constructor 2 ci - True -> getSymbol PD_UvariablePlaceholder SK_Constructor 2 ci + = getSymbol universal_type_variable_kind SK_Constructor 2 ci cyclic_var = {var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} cyclic_fv = varToFreeVar cyclic_var 1 // MW0 = ({ bind_src = App { app_symb = placeholder_symb, diff --git a/frontend/overloading.icl b/frontend/overloading.icl index 2113023..3acdf79 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1702,7 +1702,7 @@ where where create_variable var_info_ptr ui # (placeholder_symb, ui) - = getSymbol PD_UvariablePlaceholder SK_Constructor ui + = getSymbol PD_UPV_Placeholder SK_Constructor ui cyclic_var = {var_name = v_tc_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr} cyclic_fv = varToFreeVar cyclic_var 1 = ({ lb_src = App { app_symb = placeholder_symb, diff --git a/frontend/predef.dcl b/frontend/predef.dcl index 5704f58..39b5fe1 100644 --- a/frontend/predef.dcl +++ b/frontend/predef.dcl @@ -143,48 +143,49 @@ PD_TypeObjectType :== 166 PD_TypeConsSymbol :== 167 PD_unify :== 168 PD_coerce :== 169 -PD_variablePlaceholder :== 170 -PD_UvariablePlaceholder :== 171 -PD_undo_indirections :== 172 +PD_PV_Placeholder :== 170 // Pattern variable (occurs only in pattern) +PD_UPV_Placeholder :== 171 // Universal Pattern Variable (occurs only in pattern; universally quantified variable) +PD_UV_Placeholder :== 172 // Universal Variable (occurs only in dynamic; universally quantified variable) +PD_undo_indirections :== 173 -PD_TypeID :== 173 -PD_ModuleID :== 174 -PD_ModuleConsSymbol :== 175 +PD_TypeID :== 174 +PD_ModuleID :== 175 +PD_ModuleConsSymbol :== 176 /* Generics */ -PD_StdGeneric :== 176 - -PD_TypeISO :== 177 -PD_ConsISO :== 178 -PD_iso_to :== 179 -PD_iso_from :== 180 - -PD_TypeUNIT :== 181 -PD_ConsUNIT :== 182 -PD_TypeEITHER :== 183 -PD_ConsLEFT :== 184 -PD_ConsRIGHT :== 185 -PD_TypePAIR :== 186 -PD_ConsPAIR :== 187 -PD_TypeARROW :== 188 -PD_ConsARROW :== 189 - -PD_TypeConsDefInfo :== 190 -PD_ConsConsDefInfo :== 191 -PD_TypeTypeDefInfo :== 192 -PD_ConsTypeDefInfo :== 193 -PD_cons_info :== 194 -PD_TypeCONS :== 195 -PD_ConsCONS :== 196 - -PD_isomap_ARROW_ :== 197 -PD_isomap_ID :== 198 - -PD_TypeType :== 199 -PD_ConsTypeApp :== 200 -PD_ConsTypeVar :== 201 - -PD_NrOfPredefSymbols :== 202 +PD_StdGeneric :== 177 + +PD_TypeISO :== 178 +PD_ConsISO :== 179 +PD_iso_to :== 180 +PD_iso_from :== 181 + +PD_TypeUNIT :== 182 +PD_ConsUNIT :== 183 +PD_TypeEITHER :== 184 +PD_ConsLEFT :== 185 +PD_ConsRIGHT :== 186 +PD_TypePAIR :== 187 +PD_ConsPAIR :== 188 +PD_TypeARROW :== 189 +PD_ConsARROW :== 190 + +PD_TypeConsDefInfo :== 191 +PD_ConsConsDefInfo :== 192 +PD_TypeTypeDefInfo :== 193 +PD_ConsTypeDefInfo :== 194 +PD_cons_info :== 195 +PD_TypeCONS :== 196 +PD_ConsCONS :== 197 + +PD_isomap_ARROW_ :== 198 +PD_isomap_ID :== 199 + +PD_TypeType :== 200 +PD_ConsTypeApp :== 201 +PD_ConsTypeVar :== 202 + +PD_NrOfPredefSymbols :== 203 GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2 GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2 diff --git a/frontend/predef.icl b/frontend/predef.icl index 7699085..0d0d706 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -143,48 +143,49 @@ PD_TypeObjectType :== 166 PD_TypeConsSymbol :== 167 PD_unify :== 168 PD_coerce :== 169 -PD_variablePlaceholder :== 170 -PD_UvariablePlaceholder :== 171 -PD_undo_indirections :== 172 +PD_PV_Placeholder :== 170 // Pattern variable (occurs only in pattern) +PD_UPV_Placeholder :== 171 // Universal Pattern Variable (occurs only in pattern; universally quantified variable) +PD_UV_Placeholder :== 172 // Universal Variable (occurs only in dynamic; universally quantified variable) +PD_undo_indirections :== 173 -PD_TypeID :== 173 -PD_ModuleID :== 174 -PD_ModuleConsSymbol :== 175 +PD_TypeID :== 174 +PD_ModuleID :== 175 +PD_ModuleConsSymbol :== 176 /* Generics */ -PD_StdGeneric :== 176 - -PD_TypeISO :== 177 -PD_ConsISO :== 178 -PD_iso_to :== 179 -PD_iso_from :== 180 - -PD_TypeUNIT :== 181 -PD_ConsUNIT :== 182 -PD_TypeEITHER :== 183 -PD_ConsLEFT :== 184 -PD_ConsRIGHT :== 185 -PD_TypePAIR :== 186 -PD_ConsPAIR :== 187 -PD_TypeARROW :== 188 -PD_ConsARROW :== 189 - -PD_TypeConsDefInfo :== 190 -PD_ConsConsDefInfo :== 191 -PD_TypeTypeDefInfo :== 192 -PD_ConsTypeDefInfo :== 193 -PD_cons_info :== 194 -PD_TypeCONS :== 195 -PD_ConsCONS :== 196 - -PD_isomap_ARROW_ :== 197 -PD_isomap_ID :== 198 - -PD_TypeType :== 199 -PD_ConsTypeApp :== 200 -PD_ConsTypeVar :== 201 - -PD_NrOfPredefSymbols :== 202 +PD_StdGeneric :== 177 + +PD_TypeISO :== 178 +PD_ConsISO :== 179 +PD_iso_to :== 180 +PD_iso_from :== 181 + +PD_TypeUNIT :== 182 +PD_ConsUNIT :== 183 +PD_TypeEITHER :== 184 +PD_ConsLEFT :== 185 +PD_ConsRIGHT :== 186 +PD_TypePAIR :== 187 +PD_ConsPAIR :== 188 +PD_TypeARROW :== 189 +PD_ConsARROW :== 190 + +PD_TypeConsDefInfo :== 191 +PD_ConsConsDefInfo :== 192 +PD_TypeTypeDefInfo :== 193 +PD_ConsTypeDefInfo :== 194 +PD_cons_info :== 195 +PD_TypeCONS :== 196 +PD_ConsCONS :== 197 + +PD_isomap_ARROW_ :== 198 +PD_isomap_ID :== 199 + +PD_TypeType :== 200 +PD_ConsTypeApp :== 201 +PD_ConsTypeVar :== 202 + +PD_NrOfPredefSymbols :== 203 (<<=) infixl (<<=) symbol_table val @@ -282,8 +283,9 @@ predefined_idents [PD_TypeCodeClass] = i "TC", [PD_TypeObjectType] = i T_ypeObjectTypeRepresentation_String, [PD_TypeConsSymbol] = i "T_ypeConsSymbol", - [PD_variablePlaceholder] = i "P_laceholder", - [PD_UvariablePlaceholder] = i "UP_laceholder", + [PD_PV_Placeholder] = i "PV_Placeholder", + [PD_UPV_Placeholder] = i "UPV_Placeholder", + [PD_UV_Placeholder] = i "UV_Placeholder", [PD_unify] = i "_unify", [PD_coerce] = i "_coerce", [PD_StdDynamic] = i UnderscoreSystemDynamicModule_String, @@ -446,8 +448,9 @@ where <<- (local_predefined_idents, IC_Class, PD_TypeCodeClass) <<- (local_predefined_idents, IC_Type, PD_TypeObjectType) <<- (local_predefined_idents, IC_Expression, PD_TypeConsSymbol) - <<- (local_predefined_idents, IC_Expression, PD_variablePlaceholder) - <<- (local_predefined_idents, IC_Expression, PD_UvariablePlaceholder) + <<- (local_predefined_idents, IC_Expression, PD_PV_Placeholder) + <<- (local_predefined_idents, IC_Expression, PD_UPV_Placeholder) + <<- (local_predefined_idents, IC_Expression, PD_UV_Placeholder) <<- (local_predefined_idents, IC_Expression, PD_unify) <<- (local_predefined_idents, IC_Expression, PD_coerce) /* MV */ <<- (local_predefined_idents, IC_Module, PD_StdDynamic) |