Commit 6f0c29de authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

- creation of {PV,UPV,UV}_Placeholder instead of P_laceholder. See predef

  for more information.
parent 88ccfedc
......@@ -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
......
......@@ -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,
......
......@@ -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,
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
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