Commit 9b89c87e authored by John van Groningen's avatar John van Groningen
Browse files

optimisation, use _unify_tcs instead of _unify_ to match dynamic patterns of...

optimisation, use _unify_tcs instead of _unify_ to match dynamic patterns of type type_var^, if there are no other dynamic pattern matches before and no dynamic pattern matches and expressions after this match
parent e540d310
......@@ -43,6 +43,7 @@ import type_io;
:: ConversionInput =
{ cinp_dynamic_representation :: !DynamicRepresentation
, cinp_subst_var :: BoundVar // lazy, may be on a cycle
, cinp_subst_var_used :: !Bool
}
write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} directly_imported_dcl_modules common_defs icl_common
......@@ -134,7 +135,7 @@ where
ci_new_variables = [], ci_type_pattern_var_count = 0, ci_type_var_count = 0, ci_subst_var_used = False}
# (unify_subst_var, ci) = newVariable "unify_subst" ci
# (fun_body, ci) = convertDynamics {cinp_dynamic_representation = dynamic_representation,
cinp_subst_var = unify_subst_var} fun_body ci
cinp_subst_var = unify_subst_var, cinp_subst_var_used = False} fun_body ci
# cds_fun_defs & [fun] = {fun_def & fun_body = fun_body, fun_info = {fun_info & fi_local_vars = ci.ci_new_variables ++ fun_info.fi_local_vars }}
= {cds_fun_defs=cds_fun_defs,cds_predef_symb=ci.ci_predef_symb,cds_var_heap=ci.ci_var_heap,cds_expr_heap=ci.ci_expr_heap}
......@@ -414,6 +415,44 @@ convertDynamicCase cinp=:{cinp_dynamic_representation={dr_dynamic_symbol, dr_dyn
convertDynamicAlts _ _ _ _ _ defoult [] ci
= (defoult, ci)
convertDynamicAlts cinp=:{cinp_subst_var,cinp_subst_var_used=False} kees type_var value_var result_type defoult
[{dp_type_code=dp_type_code=:TCE_TypeTerm var_info_ptr,dp_var,dp_rhs, dp_position}:alts] ci=:{ci_var_heap}
# (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
(old_subst_var_used,ci) = ci!ci_subst_var_used
ci & ci_subst_var_used = False
(dp_rhs, ci=:{ci_subst_var_used}) = convertDynamics {cinp & cinp_subst_var=unify_subst_var, cinp_subst_var_used=True} dp_rhs ci
case_guards = BasicPatterns BT_Bool [{bp_value = BVB True, bp_expr = dp_rhs, bp_position = dp_position}]
| not ci_subst_var_used
# ci & ci_subst_var_used = old_subst_var_used
type_code = Var {var_ident = a_ij_var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}
(unify_tcs_symb, ci) = getSymbol PD_Dyn_unify_tcs SK_Function 2 ci
unify_call = App {app_symb = unify_tcs_symb, app_args = [Var type_var,type_code], app_info_ptr = nilPtr}
(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)
# ci & ci_subst_var_used = True
(type_code, binds, ci) = convertPatternTypeCode cinp dp_type_code 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)
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
......@@ -422,7 +461,7 @@ convertDynamicAlts cinp=:{cinp_subst_var} kees type_var value_var result_type de
ci & ci_var_heap = writePtr dp_var.fv_info_ptr (VI_DynamicValueAlias value_var) ci.ci_var_heap
ci & ci_subst_var_used = False
(dp_rhs, ci=:{ci_subst_var_used}) = convertDynamics {cinp & cinp_subst_var=unify_subst_var} dp_rhs ci
(dp_rhs, ci=:{ci_subst_var_used}) = convertDynamics {cinp & cinp_subst_var=unify_subst_var, cinp_subst_var_used=True} 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}]
......@@ -700,15 +739,15 @@ convertTypeCode pattern cinp (TCE_Selector selections var_info_ptr) st
(var_info, ci_var_heap) = readPtr var_info_ptr ci.ci_var_heap
ci = {ci & ci_var_heap = ci_var_heap}
= case var_info of
VI_TypeCodeVariable (TCI_TypeVar tv)
-> abort "convertTypeCode TCE_Selector"
VI_TypeCodeVariable (TCI_TypePatternVar _ _)
-> abort "convertTypeCode TCE_Selector"
VI_TypeCodeVariable (TCI_SelectionsTypePatternVar 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))
VI_TypeCodeVariable (TCI_TypeVar tv)
-> abort "convertTypeCode TCE_Selector"
VI_TypeCodeVariable (TCI_TypePatternVar _ _)
-> abort "convertTypeCode TCE_Selector"
_
# (var_n, var, ci) = createTypePatternVariable ci
tc_selections = [(var_n,selections)]
......
......@@ -221,120 +221,121 @@ PD_Dyn_initial_unification_environment :== 196
PD_Dyn_bind_global_type_pattern_var_n :== 197
PD_Dyn_unify :== 198
PD_Dyn_unify_ :== 199
PD_Dyn_normalise :== 200
PD_Dyn_unify_tcs :== 200
PD_Dyn_normalise :== 201
/* Generics */
PD_StdGeneric :== 201
PD_StdGeneric :== 202
// Generics types
PD_TypeUNIT :== 202
PD_TypeEITHER :== 203
PD_TypePAIR :== 204
PD_TypeUNIT :== 203
PD_TypeEITHER :== 204
PD_TypePAIR :== 205
// for constructor info
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
PD_TypeCONS :== 206
PD_TypeRECORD :== 207
PD_TypeFIELD :== 208
PD_TypeOBJECT :== 209
PD_TGenericConsDescriptor :== 210
PD_TGenericRecordDescriptor :== 211
PD_TGenericFieldDescriptor :== 212
PD_TGenericTypeDefDescriptor :== 213
PD_TGenConsPrio :== 214
PD_TGenConsAssoc :== 215
PD_TGenType :== 216
PD_TypeGenericDict :== 217
PD_TypeGenericDict0 :== 218
// Generics expression
PD_ConsUNIT :== 218
PD_ConsLEFT :== 219
PD_ConsRIGHT :== 220
PD_ConsPAIR :== 221
PD_ConsUNIT :== 219
PD_ConsLEFT :== 220
PD_ConsRIGHT :== 221
PD_ConsPAIR :== 222
// for constructor info
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
PD_ConsCONS :== 223
PD_ConsRECORD :== 224
PD_ConsFIELD :== 225
PD_ConsOBJECT :== 226
PD_CGenericConsDescriptor :== 227
PD_CGenericRecordDescriptor :== 228
PD_CGenericFieldDescriptor :== 229
PD_CGenericTypeDefDescriptor :== 230
PD_CGenConsNoPrio :== 231
PD_CGenConsPrio :== 232
PD_CGenConsAssocNone :== 233
PD_CGenConsAssocLeft :== 234
PD_CGenConsAssocRight :== 235
PD_CGenTypeCons :== 236
PD_CGenTypeVar :== 237
PD_CGenTypeArrow :== 238
PD_CGenTypeApp :== 239
PD_GenericBimap :== 240
PD__SystemEnumStrict:==241
PD_FromS :== 242
PD_FromTS :== 243
PD_FromSTS :== 244
PD_FromU :== 245
PD_FromUTS :== 246
PD_FromO :== 247
PD_FromThenS :== 248
PD_FromThenTS :== 249
PD_FromThenSTS :== 250
PD_FromThenU :== 251
PD_FromThenUTS :== 252
PD_FromThenO :== 253
PD_FromToS :== 254
PD_FromToTS :== 255
PD_FromToSTS :== 256
PD_FromToU :== 257
PD_FromToUTS :== 258
PD_FromToO :== 259
PD_FromThenToS :== 260
PD_FromThenToTS :== 261
PD_FromThenToSTS :== 262
PD_FromThenToU :== 263
PD_FromThenToUTS :== 264
PD_FromThenToO :== 265
PD_Dyn__to_TypeCodeConstructor :== 266
PD_TypeCodeConstructor :== 267
PD_TC_Int :== 268
PD_TC_Char :== 269
PD_TC_Real :== 270
PD_TC_Bool :== 271
PD_TC_Dynamic :== 272
PD_TC_File :== 273
PD_TC_World :== 274
PD_TC__Arrow :== 275
PD_TC__List :== 276
PD_TC__StrictList :== 277
PD_TC__UnboxedList :== 278
PD_TC__TailStrictList :== 279
PD_TC__StrictTailStrictList :== 280
PD_TC__UnboxedTailStrictList :== 281
PD_TC__Tuple2 :== 282
PD_TC__Tuple32 :== 312
PD_TC__LazyArray :== 313
PD_TC__StrictArray :== 314
PD_TC__UnboxedArray :== 315
PD_TC__PackedArray :== 316
PD_TC__Maybe :== 317
PD_TC__StrictMaybe :== 318
PD_TC__UnboxedMaybe :== 319
PD_TC__Unit :== 320
PD_NrOfPredefSymbols :== 321
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
......
......@@ -139,6 +139,7 @@ predefined_idents
[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_unify_tcs] = i "_unify_tcs",
[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