Commit 5652517e authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

er worden nu universele type variabelen in de vorm van UP_laceHolder's

genereerd voor types in dynamics.
parent 52a58c7f
......@@ -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
......
......@@ -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 ]})
/**************************************************************************************************/
......
......@@ -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,
......
......@@ -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
......
......@@ -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)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment