Skip to content

GitLab

Commit e540d310 authored by johnvg@science.ru.nl's avatar johnvg@science.ru.nl
Browse files

small optimisations in generated code for dynamic types, call _unify_ instead... 

small optimisations in generated code for dynamic types, call _unify_ instead of _unify if only the boolean result is used, use _bind_global_type_pattern_var_n with int type_var_n instead of_bind_global_type_pattern_var with (TypeVar type_var_n)
parent eef4663b
Hide whitespace changes
Inline Side-by-side
frontend/convertDynamics.icl
View file @ e540d310
......@@ -12,7 +12,7 @@ import type_io;
:: TypeCodeVariableInfo
= TCI_TypeVar !Expression
| TCI_TypePatternVar !Expression
| TCI_TypePatternVar !Expression !Expression
| TCI_SelectionsTypePatternVar ![(Expression,[Selection])]
:: *ConvertDynamicsState =
......@@ -183,7 +183,7 @@ instance convertDynamics TransformedBody where
global_type_pattern_in_free_vars :: [FreeVar] VarHeap -> Bool
global_type_pattern_in_free_vars [{fv_info_ptr}:free_vars] var_heap
= case sreadPtr fv_info_ptr var_heap of
VI_TypeCodeVariable (TCI_TypePatternVar _)
VI_TypeCodeVariable (TCI_TypePatternVar _ _)
-> True
VI_TypeCodeVariable (TCI_SelectionsTypePatternVar [_:_])
-> True
......@@ -200,28 +200,28 @@ where
# (var_info, ci_var_heap) = readPtr fv_info_ptr ci.ci_var_heap
ci & ci_var_heap = ci_var_heap
= case var_info of
VI_TypeCodeVariable (TCI_TypePatternVar tpv)
VI_TypeCodeVariable (TCI_TypePatternVar tpv_i _)
# type_code = Var {var_ident = a_ij_var_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr}
-> bind_global_type_pattern_var tpv type_code unification_environment_expr ci
-> bind_global_type_pattern_var tpv_i type_code unification_environment_expr ci
VI_TypeCodeVariable (TCI_SelectionsTypePatternVar tc_selections)
-> bind_global_type_pattern_var_selections tc_selections fv_info_ptr unification_environment_expr ci
_
-> (unification_environment_expr, ci)
where
bind_global_type_pattern_var_selections [(tpv,selections):tc_selections] fv_info_ptr unification_environment_expr ci
bind_global_type_pattern_var_selections [(tpv_i,selections):tc_selections] fv_info_ptr unification_environment_expr ci
# dictionary = Var {var_ident = a_ij_var_name, var_info_ptr = fv_info_ptr, var_expr_ptr = nilPtr}
type_code = Selection NormalSelector dictionary selections
(unification_environment_expr,ci) = bind_global_type_pattern_var tpv type_code unification_environment_expr ci
(unification_environment_expr,ci) = bind_global_type_pattern_var tpv_i type_code unification_environment_expr ci
= bind_global_type_pattern_var_selections tc_selections fv_info_ptr unification_environment_expr ci
bind_global_type_pattern_var_selections [] fv_info_ptr unification_environment_expr ci
= (unification_environment_expr,ci)
bind_global_type_pattern_var tpv type_code unification_environment_expr ci
bind_global_type_pattern_var tpv_i type_code unification_environment_expr ci
# (bind_global_tpv_symb, ci)
= getSymbol PD_Dyn_bind_global_type_pattern_var SK_Function 3 ci
= getSymbol PD_Dyn_bind_global_type_pattern_var_n SK_Function 3 ci
unification_environment_expr
= App { app_symb = bind_global_tpv_symb,
app_args = [tpv, type_code, unification_environment_expr],
app_args = [tpv_i, type_code, unification_environment_expr],
app_info_ptr = nilPtr }
= (unification_environment_expr, ci)
......@@ -414,24 +414,38 @@ convertDynamicCase cinp=:{cinp_dynamic_representation={dr_dynamic_symbol, dr_dyn
convertDynamicAlts _ _ _ _ _ defoult [] ci
= (defoult, ci)
convertDynamicAlts cinp=:{cinp_subst_var} kees type_var value_var result_type defoult [{dp_rhs, dp_position, dp_type_code, dp_var}:alts] ci
convertDynamicAlts cinp=:{cinp_subst_var} kees type_var value_var result_type defoult [{dp_type_code,dp_var,dp_rhs,dp_position}:alts] ci
# (type_code, binds, ci) = convertPatternTypeCode cinp dp_type_code ci
(unify_subst_var, ci) = newVariable "unify_subst" ci
ci & ci_var_heap = writePtr dp_var.fv_info_ptr (VI_DynamicValueAlias value_var) ci.ci_var_heap
(dp_rhs, ci) = convertDynamics {cinp & cinp_subst_var=unify_subst_var} dp_rhs ci
ci & ci_subst_var_used = False
(dp_rhs, ci=:{ci_subst_var_used}) = convertDynamics {cinp & cinp_subst_var=unify_subst_var} dp_rhs ci
ci & ci_subst_var_used = True
case_guards = BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs, bp_position = dp_position}]
(case_default, ci)
= convertDynamicAlts cinp kees type_var value_var result_type defoult alts ci
| not ci_subst_var_used
# (unify_symb, ci) = getSymbol PD_Dyn_unify_ SK_Function 3 ci
unify_call = App {app_symb = unify_symb, app_args = [Var cinp_subst_var,Var type_var,type_code], app_info_ptr = nilPtr}
(case_unify_expr,ci)
= case_unify type_code binds type_var case_default case_guards result_type unify_subst_var kees cinp_subst_var ci
= (Yes case_unify_expr, ci)
(case_info_ptr, ci) = bool_case_ptr result_type ci
(case_default, ci)
= convertDynamicAlts cinp kees type_var value_var result_type defoult alts ci
kees & case_info_ptr=case_info_ptr, case_guards=case_guards,
case_default=case_default, case_explicit=False, case_expr=unify_call
= (Yes (Case kees), ci)
# (case_default, ci)
= convertDynamicAlts cinp kees type_var value_var result_type defoult alts ci
(case_unify_expr,ci)
= case_unify type_code binds type_var case_default case_guards result_type unify_subst_var kees cinp_subst_var ci
= (Yes case_unify_expr, ci)
case_unify :: Expression [LetBind] BoundVar (Optional Expression) CasePatterns AType BoundVar Case BoundVar *ConversionState -> *(!Expression,!*ConversionState)
case_unify type_code binds type_var case_default case_guards result_type unify_subst_var kees cinp_subst_var ci
......@@ -533,11 +547,11 @@ convertTypeCode pattern _ (TCE_Var var_info_ptr) (has_var, binds, ci=:{ci_var_he
= case var_info of
VI_TypeCodeVariable (TCI_TypeVar tv)
-> (tv, (has_var, binds, ci))
VI_TypeCodeVariable (TCI_TypePatternVar tpv)
VI_TypeCodeVariable (TCI_TypePatternVar _ tpv)
-> (tpv, (True, binds, ci))
_
# (expr, ci) = createTypePatternVariable ci
# ci = {ci & ci_var_heap = writePtr var_info_ptr (VI_TypeCodeVariable (TCI_TypePatternVar expr)) ci.ci_var_heap}
# (var_n, expr, ci) = createTypePatternVariable ci
# ci & ci_var_heap = writePtr var_info_ptr (VI_TypeCodeVariable (TCI_TypePatternVar var_n expr)) ci.ci_var_heap
-> (expr, (True, binds, ci))
convertTypeCode pattern _ (TCE_TypeTerm var_info_ptr) (has_var, binds, ci=:{ci_var_heap})
# (var_info, ci_var_heap) = readPtr var_info_ptr ci_var_heap
......@@ -545,11 +559,11 @@ convertTypeCode pattern _ (TCE_TypeTerm var_info_ptr) (has_var, binds, ci=:{ci_v
= case var_info of
VI_TypeCodeVariable (TCI_TypeVar tv)
-> (tv, (has_var, binds, ci))
VI_TypeCodeVariable (TCI_TypePatternVar tpv)
VI_TypeCodeVariable (TCI_TypePatternVar _ tpv)
-> (tpv, (True, binds, ci))
_
# (expr, ci) = createTypePatternVariable ci
# ci = {ci & ci_var_heap = writePtr var_info_ptr (VI_TypeCodeVariable (TCI_TypePatternVar expr)) ci.ci_var_heap}
# (var_n, expr, ci) = createTypePatternVariable ci
# ci & ci_var_heap = writePtr var_info_ptr (VI_TypeCodeVariable (TCI_TypePatternVar var_n expr)) ci.ci_var_heap
-> (expr, (True, binds, ci))
convertTypeCode pattern cinp (TCE_App t arg) (has_var, binds, ci)
# (typeapp_symb, ci)
......@@ -688,27 +702,27 @@ convertTypeCode pattern cinp (TCE_Selector selections var_info_ptr) st
= case var_info of
VI_TypeCodeVariable (TCI_TypeVar tv)
-> abort "convertTypeCode TCE_Selector"
VI_TypeCodeVariable (TCI_TypePatternVar tpv)
VI_TypeCodeVariable (TCI_TypePatternVar _ _)
-> abort "convertTypeCode TCE_Selector"
VI_TypeCodeVariable (TCI_SelectionsTypePatternVar tc_selections)
# (var, ci) = createTypePatternVariable ci
tc_selections = [(var,selections):tc_selections]
# (var_n, var, ci) = createTypePatternVariable ci
tc_selections = [(var_n,selections):tc_selections]
ci = {ci & ci_var_heap = writePtr var_info_ptr (VI_TypeCodeVariable (TCI_SelectionsTypePatternVar tc_selections)) ci.ci_var_heap}
-> (var, (True, binds, ci))
_
# (var, ci) = createTypePatternVariable ci
tc_selections = [(var,selections)]
ci = {ci & ci_var_heap = writePtr var_info_ptr (VI_TypeCodeVariable (TCI_SelectionsTypePatternVar tc_selections)) ci.ci_var_heap}
# (var_n, var, ci) = createTypePatternVariable ci
tc_selections = [(var_n,selections)]
ci & ci_var_heap = writePtr var_info_ptr (VI_TypeCodeVariable (TCI_SelectionsTypePatternVar tc_selections)) ci.ci_var_heap
-> (var, (True, binds, ci))
createTypePatternVariable :: !*ConversionState -> (!Expression, !*ConversionState)
createTypePatternVariable ci
createTypePatternVariable :: !*ConversionState -> (!Expression, !Expression, !*ConversionState)
createTypePatternVariable ci=:{ci_type_pattern_var_count}
# (tpv_symb, ci)
= getSymbol PD_Dyn_TypeVar SK_Constructor 1 ci
= (App { app_symb = tpv_symb,
app_args = [BasicExpr (BVInt ci.ci_type_pattern_var_count)],
app_info_ptr = nilPtr },
{ci & ci_type_pattern_var_count = ci.ci_type_pattern_var_count + 1})
var_n_expr = BasicExpr (BVInt ci_type_pattern_var_count)
= ( var_n_expr,
App {app_symb = tpv_symb, app_args = [var_n_expr], app_info_ptr = nilPtr},
{ci & ci_type_pattern_var_count = ci_type_pattern_var_count + 1})
/**************************************************************************************************/
......
frontend/predef.dcl
View file @ e540d310
......@@ -218,122 +218,123 @@ PD_Dyn_TypeUnique :== 194
PD_Dyn__TypeFixedVar :== 195
// unification (expressions)
PD_Dyn_initial_unification_environment :== 196
PD_Dyn_bind_global_type_pattern_var :== 197
PD_Dyn_bind_global_type_pattern_var_n :== 197
PD_Dyn_unify :== 198
PD_Dyn_normalise :== 199
PD_Dyn_unify_ :== 199
PD_Dyn_normalise :== 200
/* Generics */
PD_StdGeneric :== 200
PD_StdGeneric :== 201
// Generics types
PD_TypeUNIT :== 201
PD_TypeEITHER :== 202
PD_TypePAIR :== 203
PD_TypeUNIT :== 202
PD_TypeEITHER :== 203
PD_TypePAIR :== 204
// for constructor info
PD_TypeCONS :== 204
PD_TypeRECORD :== 205
PD_TypeFIELD :== 206
PD_TypeOBJECT :== 207
PD_TGenericConsDescriptor :== 208
PD_TGenericRecordDescriptor :== 209
PD_TGenericFieldDescriptor :== 210
PD_TGenericTypeDefDescriptor :== 211
PD_TGenConsPrio :== 212
PD_TGenConsAssoc :== 213
PD_TGenType :== 214
PD_TypeGenericDict :== 215
PD_TypeGenericDict0 :== 216
PD_TypeCONS :== 205
PD_TypeRECORD :== 206
PD_TypeFIELD :== 207
PD_TypeOBJECT :== 208
PD_TGenericConsDescriptor :== 209
PD_TGenericRecordDescriptor :== 210
PD_TGenericFieldDescriptor :== 211
PD_TGenericTypeDefDescriptor :== 212
PD_TGenConsPrio :== 213
PD_TGenConsAssoc :== 214
PD_TGenType :== 215
PD_TypeGenericDict :== 216
PD_TypeGenericDict0 :== 217
// Generics expression
PD_ConsUNIT :== 217
PD_ConsLEFT :== 218
PD_ConsRIGHT :== 219
PD_ConsPAIR :== 220
PD_ConsUNIT :== 218
PD_ConsLEFT :== 219
PD_ConsRIGHT :== 220
PD_ConsPAIR :== 221
// for constructor info
PD_ConsCONS :== 221
PD_ConsRECORD :== 222
PD_ConsFIELD :== 223
PD_ConsOBJECT :== 224
PD_CGenericConsDescriptor :== 225
PD_CGenericRecordDescriptor :== 226
PD_CGenericFieldDescriptor :== 227
PD_CGenericTypeDefDescriptor :== 228
PD_CGenConsNoPrio :== 229
PD_CGenConsPrio :== 230
PD_CGenConsAssocNone :== 231
PD_CGenConsAssocLeft :== 232
PD_CGenConsAssocRight :== 233
PD_CGenTypeCons :== 234
PD_CGenTypeVar :== 235
PD_CGenTypeArrow :== 236
PD_CGenTypeApp :== 237
PD_GenericBimap :== 238
PD__SystemEnumStrict:==239
PD_FromS :== 240
PD_FromTS :== 241
PD_FromSTS :== 242
PD_FromU :== 243
PD_FromUTS :== 244
PD_FromO :== 245
PD_FromThenS :== 246
PD_FromThenTS :== 247
PD_FromThenSTS :== 248
PD_FromThenU :== 249
PD_FromThenUTS :== 250
PD_FromThenO :== 251
PD_FromToS :== 252
PD_FromToTS :== 253
PD_FromToSTS :== 254
PD_FromToU :== 255
PD_FromToUTS :== 256
PD_FromToO :== 257
PD_FromThenToS :== 258
PD_FromThenToTS :== 259
PD_FromThenToSTS :== 260
PD_FromThenToU :== 261
PD_FromThenToUTS :== 262
PD_FromThenToO :== 263
PD_Dyn__to_TypeCodeConstructor :== 264
PD_TypeCodeConstructor :== 265
PD_TC_Int :== 266
PD_TC_Char :== 267
PD_TC_Real :== 268
PD_TC_Bool :== 269
PD_TC_Dynamic :== 270
PD_TC_File :== 271
PD_TC_World :== 272
PD_TC__Arrow :== 273
PD_TC__List :== 274
PD_TC__StrictList :== 275
PD_TC__UnboxedList :== 276
PD_TC__TailStrictList :== 277
PD_TC__StrictTailStrictList :== 278
PD_TC__UnboxedTailStrictList :== 279
PD_TC__Tuple2 :== 280
PD_TC__Tuple32 :== 310
PD_TC__LazyArray :== 311
PD_TC__StrictArray :== 312
PD_TC__UnboxedArray :== 313
PD_TC__PackedArray :== 314
PD_TC__Maybe :== 315
PD_TC__StrictMaybe :== 316
PD_TC__UnboxedMaybe :== 317
PD_TC__Unit :== 318
PD_NrOfPredefSymbols :== 319
PD_ConsCONS :== 222
PD_ConsRECORD :== 223
PD_ConsFIELD :== 224
PD_ConsOBJECT :== 225
PD_CGenericConsDescriptor :== 226
PD_CGenericRecordDescriptor :== 227
PD_CGenericFieldDescriptor :== 228
PD_CGenericTypeDefDescriptor :== 229
PD_CGenConsNoPrio :== 230
PD_CGenConsPrio :== 231
PD_CGenConsAssocNone :== 232
PD_CGenConsAssocLeft :== 233
PD_CGenConsAssocRight :== 234
PD_CGenTypeCons :== 235
PD_CGenTypeVar :== 236
PD_CGenTypeArrow :== 237
PD_CGenTypeApp :== 238
PD_GenericBimap :== 239
PD__SystemEnumStrict:==240
PD_FromS :== 241
PD_FromTS :== 242
PD_FromSTS :== 243
PD_FromU :== 244
PD_FromUTS :== 245
PD_FromO :== 246
PD_FromThenS :== 247
PD_FromThenTS :== 248
PD_FromThenSTS :== 249
PD_FromThenU :== 250
PD_FromThenUTS :== 251
PD_FromThenO :== 252
PD_FromToS :== 253
PD_FromToTS :== 254
PD_FromToSTS :== 255
PD_FromToU :== 256
PD_FromToUTS :== 257
PD_FromToO :== 258
PD_FromThenToS :== 259
PD_FromThenToTS :== 260
PD_FromThenToSTS :== 261
PD_FromThenToU :== 262
PD_FromThenToUTS :== 263
PD_FromThenToO :== 264
PD_Dyn__to_TypeCodeConstructor :== 265
PD_TypeCodeConstructor :== 266
PD_TC_Int :== 267
PD_TC_Char :== 268
PD_TC_Real :== 269
PD_TC_Bool :== 270
PD_TC_Dynamic :== 271
PD_TC_File :== 272
PD_TC_World :== 273
PD_TC__Arrow :== 274
PD_TC__List :== 275
PD_TC__StrictList :== 276
PD_TC__UnboxedList :== 277
PD_TC__TailStrictList :== 278
PD_TC__StrictTailStrictList :== 279
PD_TC__UnboxedTailStrictList :== 280
PD_TC__Tuple2 :== 281
PD_TC__Tuple32 :== 311
PD_TC__LazyArray :== 312
PD_TC__StrictArray :== 313
PD_TC__UnboxedArray :== 314
PD_TC__PackedArray :== 315
PD_TC__Maybe :== 316
PD_TC__StrictMaybe :== 317
PD_TC__UnboxedMaybe :== 318
PD_TC__Unit :== 319
PD_NrOfPredefSymbols :== 320
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
......
frontend/predef.icl
View file @ e540d310
......@@ -136,8 +136,9 @@ predefined_idents
[PD_Dyn_TypeUnique] = i "TypeUnique",
[PD_Dyn__TypeFixedVar] = i "_TypeFixedVar",
[PD_Dyn_initial_unification_environment] = i "_initial_unification_environment",
[PD_Dyn_bind_global_type_pattern_var] = i "_bind_global_type_pattern_var",
[PD_Dyn_bind_global_type_pattern_var_n] = i "_bind_global_type_pattern_var_n",
[PD_Dyn_unify] = i "_unify",
[PD_Dyn_unify_] = i "_unify_",
[PD_Dyn_normalise] = i "_normalise",
[PD_Dyn__to_TypeCodeConstructor] = i "_to_TypeCodeConstructor",
......
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