diff options
Diffstat (limited to 'frontend')
| -rw-r--r-- | frontend/check.icl | 1 | ||||
| -rw-r--r-- | frontend/convertDynamics.icl | 51 | ||||
| -rw-r--r-- | frontend/overloading.icl | 10 | ||||
| -rw-r--r-- | frontend/predef.dcl | 75 | ||||
| -rw-r--r-- | frontend/predef.icl | 77 |
5 files changed, 117 insertions, 97 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index 654e261..b44311b 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -2987,6 +2987,7 @@ where <=< 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_coerce mod_index STE_DclFunction <=< adjustPredefSymbol PD_undo_indirections mod_index STE_DclFunction diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index b9d4b52..b08e577 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -536,7 +536,7 @@ where /* Sjaak ... */ convertTypecode2 cinp (TCE_UniType uni_vars type_code) replace_tc_args binds placeholders_and_tc_args ci - # (let_binds, ci) = createVariables uni_vars [] ci + # (let_binds, ci) = createUniversalVariables 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, Let { let_strict_binds = [], @@ -900,7 +900,7 @@ where /*** convert the elements of this pattern ***/ - (a_ij_binds, ci) = createVariables dp_type_patterns_vars [] ci + (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 // collect ... @@ -1111,25 +1111,36 @@ generateBinding cinp bound_vars var bind_expr result_type ci /**************************************************************************************************/ // MW0 createVariables :: [VarInfoPtr] !(Env Expression FreeVar) !*ConversionInfo -> (!Env Expression FreeVar, !*ConversionInfo) -createVariables :: [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) -createVariables var_info_ptrs binds ci +createUniversalVariables :: [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) +createUniversalVariables var_info_ptrs binds ci + = createVariables2 True 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 :: !Bool [VarInfoPtr] ![LetBind] !*ConversionInfo -> (![LetBind], !*ConversionInfo) +createVariables2 generate_universal_type_variables var_info_ptrs binds ci = mapAppendSt (create_variable a_ij_var_name) var_info_ptrs binds ci - -// 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) = getSymbol PD_variablePlaceholder SK_Constructor 3 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, - = ({ lb_src = App { app_symb = placeholder_symb, - app_args = [Var cyclic_var, Var cyclic_var], - app_info_ptr = nilPtr }, -// MW0 bind_dst = varToFreeVar cyclic_var 1 - lb_dst = varToFreeVar cyclic_var 1, - lb_position = NoPos - }, - { ci & ci_new_variables = [ cyclic_fv : ci.ci_new_variables ]}) +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 3 ci + True -> getSymbol PD_UvariablePlaceholder SK_Constructor 3 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, + = ({ lb_src = App { app_symb = placeholder_symb, + app_args = [Var cyclic_var, Var cyclic_var], + app_info_ptr = nilPtr }, + // MW0 bind_dst = varToFreeVar cyclic_var 1 + lb_dst = varToFreeVar cyclic_var 1, + lb_position = NoPos + }, + { ci & ci_new_variables = [ cyclic_fv : ci.ci_new_variables ]}) /**************************************************************************************************/ diff --git a/frontend/overloading.icl b/frontend/overloading.icl index 2061b1e..cc34472 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1605,7 +1605,7 @@ where convertTypecode (TCE_Selector selections var_info_ptr) ui = (Selection NormalSelector (Var { var_name = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr }) selections, ui) convertTypecode (TCE_UniType uni_vars type_code) ui - # (let_binds, ui) = createVariables uni_vars ui + # (let_binds, ui) = createUniversalVariables uni_vars ui (let_expr, ui) = convertTypecode type_code ui (let_info_ptr,ui) = let_ptr (length let_binds) ui = ( Let { let_strict_binds = [] @@ -1626,12 +1626,16 @@ where = (App { app_symb = cons_symb, app_args = [expr , exprs], app_info_ptr = nilPtr}, ui) + + createUniversalVariables var_info_ptrs ui + = createVariables2 True var_info_ptrs ui - createVariables var_info_ptrs ui + createVariables2 generate_universal_placeholders var_info_ptrs ui = mapSt create_variable var_info_ptrs ui where create_variable var_info_ptr ui - # (placeholder_symb, ui) = getSymbol PD_variablePlaceholder SK_Constructor ui + # (placeholder_symb, ui) + = getSymbol PD_UvariablePlaceholder 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 05316d1..85c184f 100644 --- a/frontend/predef.dcl +++ b/frontend/predef.dcl @@ -144,46 +144,47 @@ PD_TypeConsSymbol :== 167 PD_unify :== 168 PD_coerce :== 169 PD_variablePlaceholder :== 170 -PD_undo_indirections :== 171 +PD_UvariablePlaceholder :== 171 +PD_undo_indirections :== 172 -PD_TypeID :== 172 -PD_ModuleID :== 173 -PD_ModuleConsSymbol :== 174 +PD_TypeID :== 173 +PD_ModuleID :== 174 +PD_ModuleConsSymbol :== 175 /* Generics */ -PD_StdGeneric :== 175 - -PD_TypeISO :== 176 -PD_ConsISO :== 177 -PD_iso_to :== 178 -PD_iso_from :== 179 - -PD_TypeUNIT :== 180 -PD_ConsUNIT :== 181 -PD_TypeEITHER :== 182 -PD_ConsLEFT :== 183 -PD_ConsRIGHT :== 184 -PD_TypePAIR :== 185 -PD_ConsPAIR :== 186 -PD_TypeARROW :== 187 -PD_ConsARROW :== 188 - -PD_TypeConsDefInfo :== 189 -PD_ConsConsDefInfo :== 190 -PD_TypeTypeDefInfo :== 191 -PD_ConsTypeDefInfo :== 192 -PD_cons_info :== 193 -PD_TypeCONS :== 194 -PD_ConsCONS :== 195 - -PD_isomap_ARROW_ :== 196 -PD_isomap_ID :== 197 - -PD_TypeType :== 198 -PD_ConsTypeApp :== 199 -PD_ConsTypeVar :== 200 - -PD_NrOfPredefSymbols :== 201 +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 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 86effaf..7f65509 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -144,46 +144,47 @@ PD_TypeConsSymbol :== 167 PD_unify :== 168 PD_coerce :== 169 PD_variablePlaceholder :== 170 -PD_undo_indirections :== 171 +PD_UvariablePlaceholder :== 171 +PD_undo_indirections :== 172 -PD_TypeID :== 172 -PD_ModuleID :== 173 -PD_ModuleConsSymbol :== 174 +PD_TypeID :== 173 +PD_ModuleID :== 174 +PD_ModuleConsSymbol :== 175 /* Generics */ -PD_StdGeneric :== 175 - -PD_TypeISO :== 176 -PD_ConsISO :== 177 -PD_iso_to :== 178 -PD_iso_from :== 179 - -PD_TypeUNIT :== 180 -PD_ConsUNIT :== 181 -PD_TypeEITHER :== 182 -PD_ConsLEFT :== 183 -PD_ConsRIGHT :== 184 -PD_TypePAIR :== 185 -PD_ConsPAIR :== 186 -PD_TypeARROW :== 187 -PD_ConsARROW :== 188 - -PD_TypeConsDefInfo :== 189 -PD_ConsConsDefInfo :== 190 -PD_TypeTypeDefInfo :== 191 -PD_ConsTypeDefInfo :== 192 -PD_cons_info :== 193 -PD_TypeCONS :== 194 -PD_ConsCONS :== 195 - -PD_isomap_ARROW_ :== 196 -PD_isomap_ID :== 197 - -PD_TypeType :== 198 -PD_ConsTypeApp :== 199 -PD_ConsTypeVar :== 200 - -PD_NrOfPredefSymbols :== 201 +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 (<<=) infixl (<<=) symbol_table val @@ -282,6 +283,7 @@ predefined_idents [PD_TypeObjectType] = i "T_ypeObjectType", [PD_TypeConsSymbol] = i "T_ypeConsSymbol", [PD_variablePlaceholder] = i "P_laceholder", + [PD_UvariablePlaceholder] = i "UP_laceholder", [PD_unify] = i "_unify", [PD_coerce] = i "_coerce", [PD_StdDynamic] = i UnderscoreSystemDynamicModule_String, @@ -445,6 +447,7 @@ where <<- (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_unify) <<- (local_predefined_idents, IC_Expression, PD_coerce) /* MV */ <<- (local_predefined_idents, IC_Module, PD_StdDynamic) |