diff options
| -rw-r--r-- | backend/backendconvert.icl | 10 | ||||
| -rw-r--r-- | frontend/check.icl | 12 | ||||
| -rw-r--r-- | frontend/checkFunctionBodies.icl | 13 | ||||
| -rw-r--r-- | frontend/comparedefimp.icl | 7 | ||||
| -rw-r--r-- | frontend/convertDynamics.icl | 4 | ||||
| -rw-r--r-- | frontend/convertcases.icl | 14 | ||||
| -rw-r--r-- | frontend/explicitimports.icl | 2 | ||||
| -rw-r--r-- | frontend/generics.icl | 6 | ||||
| -rw-r--r-- | frontend/overloading.icl | 4 | ||||
| -rw-r--r-- | frontend/predef.dcl | 10 | ||||
| -rw-r--r-- | frontend/predef.icl | 10 | ||||
| -rw-r--r-- | frontend/refmark.icl | 2 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 12 | ||||
| -rw-r--r-- | frontend/syntax.icl | 9 | ||||
| -rw-r--r-- | frontend/trans.icl | 10 | ||||
| -rw-r--r-- | frontend/transform.icl | 18 | ||||
| -rw-r--r-- | frontend/type.icl | 21 |
17 files changed, 80 insertions, 84 deletions
diff --git a/backend/backendconvert.icl b/backend/backendconvert.icl index df92ea1..23ab64d 100644 --- a/backend/backendconvert.icl +++ b/backend/backendconvert.icl @@ -1865,14 +1865,8 @@ where = [] convertExpr (TupleSelect {ds_arity} n expr) = beTupleSelectNode ds_arity n (convertExpr expr) - convertExpr (MatchExpr optionalTuple {glob_module, glob_object={ds_index}} expr) - = beMatchNode (arity optionalTuple) (beConstructorSymbol glob_module ds_index) (convertExpr expr) - where - arity :: (Optional (Global DefinedSymbol)) -> Int - arity No - = 1 - arity (Yes {glob_object={ds_arity}}) - = ds_arity + convertExpr (MatchExpr {glob_module, glob_object={ds_index,ds_arity}} expr) + = beMatchNode ds_arity (beConstructorSymbol glob_module ds_index) (convertExpr expr) convertExpr (Conditional {if_cond=cond, if_then, if_else=Yes else}) = beIfNode (convertExpr cond) (convertExpr if_then) (convertExpr else) diff --git a/frontend/check.icl b/frontend/check.icl index 45aa918..b68c38b 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -2959,7 +2959,9 @@ where | pre_mod.pds_def == mod_index = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols} <=< adjustPredefSymbolAndCheckIndex PD_StringType mod_index PD_StringTypeIndex STE_Type - <=< adjust_predef_symbols PD_ListType PD_UnboxedArrayType mod_index STE_Type + <=< adjust_predef_symbols PD_ListType PD_OverloadedListType mod_index STE_Type + <=< adjust_predef_symbols_and_check_indices PD_Arity2TupleType PD_Arity32TupleType PD_Arity2TupleTypeIndex mod_index STE_Type + <=< adjust_predef_symbols PD_LazyArrayType PD_UnboxedArrayType mod_index STE_Type <=< adjust_predef_symbols PD_ConsSymbol PD_Arity32TupleSymbol mod_index STE_Constructor <=< adjustPredefSymbol PD_TypeCodeClass mod_index STE_Class <=< adjustPredefSymbol PD_TypeCodeMember mod_index STE_Member @@ -2989,7 +2991,6 @@ where <=< adjustPredefSymbol PD_DynamicValue mod_index (STE_Field unused) <=< adjustPredefSymbol PD_TypeID mod_index STE_Type <=< adjustPredefSymbol PD_ModuleID mod_index STE_Constructor) -// AA.. # (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_StdGeneric] # type_iso_ident = predefined_idents.[PD_TypeISO] | pre_mod.pds_def == mod_index @@ -3037,6 +3038,13 @@ where <=< adjustPredefSymbol next_symb mod_index symb_kind <=< adjust_predef_symbols (inc next_symb) last_symb mod_index symb_kind + adjust_predef_symbols_and_check_indices next_symb last_symb type_index mod_index symb_kind cs + | next_symb > last_symb + = cs + = cs + <=< adjustPredefSymbolAndCheckIndex next_symb mod_index type_index symb_kind + <=< adjust_predef_symbols_and_check_indices (inc next_symb) last_symb (inc type_index) mod_index symb_kind + count_members :: !Index !{# ClassInstance} !{# ClassDef} !{# DclModule} -> Int count_members mod_index com_instance_defs com_class_defs modules # (sum, _, _) diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index 23fbc70..c46ae3e 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -1027,8 +1027,7 @@ checkExpression free_vars (PE_Selection selector_kind expr selectors) e_input e_ ParsedNormalSelector -> (Selection NormalSelector expr selectors, free_vars, e_state, e_info, cs) ParsedUniqueSelector unique_element - # (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs - -> (Selection (UniqueSelector tuple_type) expr selectors, free_vars, e_state, e_info, cs) + -> (Selection UniqueSelector expr selectors, free_vars, e_state, e_info, cs) checkExpression free_vars (PE_Update expr1 selectors expr2) e_input e_state e_info cs # (expr1, free_vars, e_state, e_info, cs) = checkExpression free_vars expr1 e_input e_state e_info cs (selectors, free_vars, e_state, e_info, cs) = checkSelectors cEndWithUpdate free_vars selectors e_input e_state e_info cs @@ -1805,13 +1804,12 @@ transfromPatternIntoBind mod_index def_level (AP_Algebraic cons_symbol=:{glob_mo _ | ds_arity == 1 # (binds, var_store, expr_heap, e_info, cs) - = transfromPatternIntoBind mod_index def_level (hd args) (MatchExpr No cons_symbol src_expr) + = transfromPatternIntoBind mod_index def_level (hd args) (MatchExpr cons_symbol src_expr) position var_store expr_heap e_info cs -> (opt_var_bind ++ binds, var_store, expr_heap, e_info, cs) - # (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex ds_arity) PD_PredefinedModule STE_Type ds_arity cs - (tuple_cons, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex ds_arity) PD_PredefinedModule STE_Constructor ds_arity cs + # (tuple_cons, cs) = getPredefinedGlobalSymbol (GetTupleConsIndex ds_arity) PD_PredefinedModule STE_Constructor ds_arity cs (match_var, match_bind, var_store, expr_heap) - = bind_match_expr (MatchExpr (Yes tuple_type) cons_symbol src_expr) opt_var_bind position var_store expr_heap + = bind_match_expr (MatchExpr cons_symbol src_expr) opt_var_bind position var_store expr_heap -> transform_sub_patterns mod_index def_level args tuple_cons.glob_object 0 match_var match_bind position var_store expr_heap e_info cs where @@ -2195,8 +2193,7 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections} 1 # (unq_select_symb, cs) = getPredefinedGlobalSymbol PD_UnqArraySelectFun PD_StdArray STE_Member 2 cs -> (unq_select_symb, NormalSelector, cs) _ # (select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 cs - (tuple_type, cs) = getPredefinedGlobalSymbol (GetTupleTypeIndex 2) PD_PredefinedModule STE_Type 2 cs - -> (select_symb, UniqueSelector tuple_type, cs) + -> (select_symb, UniqueSelector, cs) e_state = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap } (index_exprs, (free_vars, e_state, e_info, cs)) diff --git a/frontend/comparedefimp.icl b/frontend/comparedefimp.icl index 787a1d7..ecdbabc 100644 --- a/frontend/comparedefimp.icl +++ b/frontend/comparedefimp.icl @@ -946,10 +946,9 @@ instance e_corresponds Expression where e_corresponds (ABCCodeExpr dcl_lines dcl_do_inline) (ABCCodeExpr icl_lines icl_do_inline) = equal2 dcl_lines icl_lines o` equal2 dcl_do_inline icl_do_inline - e_corresponds (MatchExpr dcl_opt_tuple_type dcl_cons_symbol dcl_src_expr) - (MatchExpr icl_opt_tuple_type icl_cons_symbol icl_src_expr) - = e_corresponds dcl_opt_tuple_type icl_opt_tuple_type - o` e_corresponds dcl_cons_symbol icl_cons_symbol + e_corresponds (MatchExpr dcl_cons_symbol dcl_src_expr) + (MatchExpr icl_cons_symbol icl_src_expr) + = e_corresponds dcl_cons_symbol icl_cons_symbol o` e_corresponds dcl_src_expr icl_src_expr e_corresponds (FreeVar dcl) (FreeVar icl) = e_corresponds dcl icl diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl index 6bfef36..70363d9 100644 --- a/frontend/convertDynamics.icl +++ b/frontend/convertDynamics.icl @@ -412,9 +412,9 @@ where = (AnyCodeExpr codeBinding1 codeBinding2 strings, ci) convertDynamics _ _ _ (ABCCodeExpr strings bool) ci = (ABCCodeExpr strings bool, ci) - convertDynamics cinp bound_vars default_expr (MatchExpr opt_symb symb expression) ci + convertDynamics cinp bound_vars default_expr (MatchExpr symb expression) ci # (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci - = (MatchExpr opt_symb symb expression, ci) + = (MatchExpr symb expression, ci) /* 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 diff --git a/frontend/convertcases.icl b/frontend/convertcases.icl index 8be6420..9a06aec 100644 --- a/frontend/convertcases.icl +++ b/frontend/convertcases.icl @@ -211,7 +211,7 @@ where = weightedRefCountOfCase rci case_expr case_info { rs & rcs_expr_heap = rcs_expr_heap } weightedRefCount rci expr=:(BasicExpr _) rs = rs - weightedRefCount rci (MatchExpr _ constructor expr) rs + weightedRefCount rci (MatchExpr constructor expr) rs = weightedRefCount rci expr rs weightedRefCount rci (Selection opt_tuple expr selections) rs = weightedRefCount rci (expr, selections) rs @@ -456,9 +456,9 @@ where = (fun_expr @ exprs, ds) distributeLets depth expr=:(BasicExpr _) ds = (expr, ds) - distributeLets depth (MatchExpr opt_tuple constructor expr) ds + distributeLets depth (MatchExpr constructor expr) ds # (expr, ds) = distributeLets depth expr ds - = (MatchExpr opt_tuple constructor expr, ds) + = (MatchExpr constructor expr, ds) distributeLets depth (Selection opt_tuple expr selectors) ds # (expr, ds) = distributeLets depth expr ds # (selectors, ds) = distributeLets depth selectors ds @@ -1036,9 +1036,9 @@ where convertCases ci (Let lad) cs # (lad, cs) = convertCases ci lad cs = (Let lad, cs) - convertCases ci (MatchExpr opt_tuple constructor expr) cs + convertCases ci (MatchExpr constructor expr) cs # (expr, cs) = convertCases ci expr cs - = (MatchExpr opt_tuple constructor expr, cs) + = (MatchExpr constructor expr, cs) convertCases ci (Selection is_unique expr selectors) cs # (expr, cs) = convertCases ci expr cs (selectors, cs) = convertCases ci selectors cs @@ -1236,9 +1236,9 @@ where = (Conditional cond, cp_info) copy expr=:(BasicExpr _) cp_info = (expr, cp_info) - copy (MatchExpr opt_tuple constructor expr) cp_info + copy (MatchExpr constructor expr) cp_info # (expr, cp_info) = copy expr cp_info - = (MatchExpr opt_tuple constructor expr, cp_info) + = (MatchExpr constructor expr, cp_info) copy (Selection is_unique expr selectors) cp_info # (expr, cp_info) = copy expr cp_info (selectors, cp_info) = copy selectors cp_info diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl index 2076eab..107e5b7 100644 --- a/frontend/explicitimports.icl +++ b/frontend/explicitimports.icl @@ -660,7 +660,7 @@ instance check_completeness Expression where = ccs check_completeness (ABCCodeExpr _ _) _ ccs = ccs - check_completeness (MatchExpr _ constructor expression) cci ccs + check_completeness (MatchExpr constructor expression) cci ccs = check_completeness expression cci (check_whether_ident_is_imported constructor.glob_object.ds_ident STE_Constructor cci ccs) check_completeness (FreeVar _) _ ccs diff --git a/frontend/generics.icl b/frontend/generics.icl index d3ff9bb..4d61455 100644 --- a/frontend/generics.icl +++ b/frontend/generics.icl @@ -4038,9 +4038,9 @@ mapExprSt f (Conditional cond=:{if_cond, if_then, if_else}) st No -> (No, st) = f (Conditional {cond & if_cond = if_cond, if_then = if_then, if_else = if_else}) st -mapExprSt f (MatchExpr x y expr) st +mapExprSt f (MatchExpr y expr) st # (expr, st) = mapExprSt f expr st - = f (MatchExpr x y expr) st + = f (MatchExpr y expr) st mapExprSt f (DynamicExpr dyn=:{dyn_expr}) st # (dyn_expr, st) = mapExprSt f dyn_expr st @@ -4145,7 +4145,7 @@ where collect_expr_calls (TupleSelect ds i expr) rest = collect_expr_calls expr rest //collect_expr_calls (Lambda fvs expr) rest = collect_expr_calls expr rest collect_expr_calls (Conditional cond) rest = collect_expr_calls cond.if_cond (collect_expr_calls cond.if_then (foldOptional id collect_expr_calls cond.if_else rest)) - collect_expr_calls (MatchExpr ogds gds expr) rest = collect_expr_calls expr rest + collect_expr_calls (MatchExpr gds expr) rest = collect_expr_calls expr rest collect_expr_calls (DynamicExpr dyn) rest = collect_expr_calls dyn.dyn_expr (collect_tce_calls dyn.dyn_type_code rest) //collect_expr_calls (TypeCase tc) rest = collect_expr_calls tc.type_case_dynamic (foldr collect_dp_calls (foldOptional id collect_expr_calls rest) tc.type_case_patterns) collect_expr_calls (TypeCodeExpression tce) rest = collect_tce_calls tce rest diff --git a/frontend/overloading.icl b/frontend/overloading.icl index a0f9947..ec04b37 100644 --- a/frontend/overloading.icl +++ b/frontend/overloading.icl @@ -1408,9 +1408,9 @@ where | isEmpty uni_vars = (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = type_code }, ui) = (DynamicExpr { dyn & dyn_expr = dyn_expr, dyn_type_code = TCE_UniType uni_vars type_code }, ui) - updateExpression group_index (MatchExpr opt_tuple cons_symbol expr) ui + updateExpression group_index (MatchExpr cons_symbol expr) ui # (expr, ui) = updateExpression group_index expr ui - = (MatchExpr opt_tuple cons_symbol expr, ui) + = (MatchExpr cons_symbol expr, ui) updateExpression group_index (TupleSelect symbol argn_nr expr) ui # (expr, ui) = updateExpression group_index expr ui = (TupleSelect symbol argn_nr expr, ui) diff --git a/frontend/predef.dcl b/frontend/predef.dcl index 9b62ea0..05316d1 100644 --- a/frontend/predef.dcl +++ b/frontend/predef.dcl @@ -2,10 +2,6 @@ definition module predef import syntax, hashtable -cPredefinedModuleIndex :== 1 - -PD_StringTypeIndex :== 0 - :: PredefinedSymbols :== {# PredefinedSymbol} :: PredefinedSymbol = { @@ -13,6 +9,12 @@ PD_StringTypeIndex :== 0 pds_def :: !Index } +cPredefinedModuleIndex :== 1 + +PD_StringTypeIndex :== 0 +PD_Arity2TupleTypeIndex :== 8 +PD_Arity32TupleTypeIndex :== 38 + /* identifiers not present the hastable */ PD_PredefinedModule :== 0 diff --git a/frontend/predef.icl b/frontend/predef.icl index 2a6ba74..86effaf 100644 --- a/frontend/predef.icl +++ b/frontend/predef.icl @@ -2,10 +2,6 @@ implementation module predef import syntax, hashtable, type_io_common -cPredefinedModuleIndex :== 1 - -PD_StringTypeIndex :== 0 - :: PredefinedSymbols :== {# PredefinedSymbol} :: PredefinedSymbol = { @@ -13,6 +9,12 @@ PD_StringTypeIndex :== 0 pds_def :: !Index } +cPredefinedModuleIndex :== 1 + +PD_StringTypeIndex :== 0 +PD_Arity2TupleTypeIndex :== 8 +PD_Arity32TupleTypeIndex :== 38 + /* identifiers not present the hashtable */ PD_PredefinedModule :== 0 diff --git a/frontend/refmark.icl b/frontend/refmark.icl index dcf9f23..bf765c3 100644 --- a/frontend/refmark.icl +++ b/frontend/refmark.icl @@ -250,7 +250,7 @@ where refMark free_vars sel _ (TupleSelect _ arg_nr expr) var_heap = refMark free_vars arg_nr No expr var_heap - refMark free_vars sel _ (MatchExpr _ _ expr) var_heap + refMark free_vars sel _ (MatchExpr _ expr) var_heap = refMark free_vars sel No expr var_heap refMark free_vars sel _ EE var_heap = var_heap diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 5a1f95e..096cf63 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -115,7 +115,7 @@ instance == FunctionOrMacroIndex , def_macro_indices :: !IndexRange , def_classes :: ![ClassDef] , def_members :: ![MemberDef] - , def_generics :: ![GenericDef] // AA + , def_generics :: ![GenericDef] , def_funtypes :: ![FunType] , def_instances :: ![instance_kind] } @@ -167,7 +167,7 @@ cIsNotAFunction :== False | PD_Type ParsedTypeDef | PD_TypeSpec Position Ident Priority (Optional SymbolType) Specials | PD_Class ClassDef [ParsedDefinition] - | PD_Generic GenericDef // AA + | PD_Generic GenericDef | PD_Instance (ParsedInstance ParsedDefinition) | PD_Instances [ParsedInstance ParsedDefinition] | PD_Import [ParsedImport] @@ -1104,7 +1104,6 @@ cIsNotStrict :== False = NormalSelector | NormalSelectorUniqueElementResult | UniqueSelector // ! - (Global DefinedSymbol) // tuple type /* :: SelectorKind = SEK_Normal | SEK_First | SEK_Next | SEK_Last @@ -1128,7 +1127,7 @@ cIsNotStrict :== False | AnyCodeExpr !(CodeBinding BoundVar) !(CodeBinding FreeVar) ![String] | ABCCodeExpr ![String] !Bool - | MatchExpr !(Optional (Global DefinedSymbol)) !(Global DefinedSymbol) !Expression + | MatchExpr !(Global DefinedSymbol) !Expression | FreeVar FreeVar | Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */ | ClassVariable !VarInfoPtr /* auxiliary clause used during overloading */ @@ -1359,10 +1358,7 @@ ParsedInstanceToClassInstance pi members :== { ins_class = {glob_object = MakeDefinedSymbol pi.pi_class NoIndex (length pi.pi_types), glob_module = NoIndex}, ins_ident = pi.pi_ident, ins_type = { it_vars = [], it_types = pi.pi_types, it_attr_vars = [], it_context = pi.pi_context }, ins_members = members, ins_specials = pi.pi_specials, ins_pos = pi.pi_pos, - /*AA*/ - ins_is_generic = False, - ins_generate = pi.pi_generate, - ins_partial = False, + ins_is_generic = False, ins_generate = pi.pi_generate, ins_partial = False, ins_generic = {glob_module = NoIndex, glob_object = NoIndex}} MakeTypeDef name lhs rhs attr contexts pos :== diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 1a021ca..e4a64f4 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -1095,7 +1095,6 @@ cIsNotStrict :== False = NormalSelector | NormalSelectorUniqueElementResult | UniqueSelector // ! - (Global DefinedSymbol) // tuple type :: Expression = Var !BoundVar | App !App @@ -1113,7 +1112,7 @@ cIsNotStrict :== False | AnyCodeExpr !(CodeBinding BoundVar) !(CodeBinding FreeVar) ![String] | ABCCodeExpr ![String] !Bool - | MatchExpr !(Optional (Global DefinedSymbol)) !(Global DefinedSymbol) !Expression + | MatchExpr !(Global DefinedSymbol) !Expression | FreeVar FreeVar | Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */ | ClassVariable !VarInfoPtr /* auxiliary clause used during overloading */ @@ -1592,7 +1591,7 @@ where (<<<) file (TupleSelect field field_nr expr) = file <<< expr <<<'.' <<< field_nr // (<<<) file (Lambda vars expr) = file <<< '\\' <<< vars <<< " -> " <<< expr (<<<) file WildCard = file <<< '_' - (<<<) file (MatchExpr _ cons expr) = file <<< cons <<< " =: " <<< expr + (<<<) file (MatchExpr cons expr) = file <<< cons <<< " =: " <<< expr (<<<) file EE = file <<< "** E **" (<<<) file (NoBind _) = file <<< "** NB **" (<<<) file (DynamicExpr {dyn_expr,dyn_type_code}) = file <<< "dynamic " <<< dyn_expr <<< " :: " <<< dyn_type_code @@ -1660,7 +1659,7 @@ instance <<< SelectorKind where (<<<) file NormalSelector = file <<< "." (<<<) file NormalSelectorUniqueElementResult = file <<< "!*" - (<<<) file (UniqueSelector _) = file <<< "!" + (<<<) file UniqueSelector = file <<< "!" instance <<< Selection where @@ -2056,7 +2055,7 @@ where = file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple" show_expression file (BasicExpr bv) = file <<< bv - show_expression file (MatchExpr _ _ expr) + show_expression file (MatchExpr _ expr) = file <<< "match expression" show_expression file _ = file diff --git a/frontend/trans.icl b/frontend/trans.icl index ab787e9..c6d1a7a 100644 --- a/frontend/trans.icl +++ b/frontend/trans.icl @@ -266,7 +266,7 @@ instance consumerRequirements Expression where = consumerRequirements case_expr common_defs ai consumerRequirements (BasicExpr _) _ ai = (cPassive, False, ai) - consumerRequirements (MatchExpr _ _ expr) common_defs ai + consumerRequirements (MatchExpr _ expr) common_defs ai = consumerRequirements expr common_defs ai consumerRequirements (Selection _ expr selectors) common_defs ai # (cc, _, ai) = consumerRequirements expr common_defs ai @@ -778,9 +778,9 @@ where transform (TupleSelect a1 arg_nr expr) ro ti # (expr,ti) = transform expr ro ti = (TupleSelect a1 arg_nr expr,ti) - transform (MatchExpr a1 a2 expr) ro ti + transform (MatchExpr a1 expr) ro ti # (expr,ti) = transform expr ro ti - = (MatchExpr a1 a2 expr,ti) + = (MatchExpr a1 expr,ti) transform (DynamicExpr dynamic_expr) ro ti # (dynamic_expr, ti) = transform dynamic_expr ro ti = (DynamicExpr dynamic_expr, ti) @@ -2976,7 +2976,7 @@ where = free_variables_of_fields fields var fvi freeVariables (TupleSelect _ arg_nr expr) fvi = freeVariables expr fvi - freeVariables (MatchExpr _ _ expr) fvi + freeVariables (MatchExpr _ expr) fvi = freeVariables expr fvi freeVariables EE fvi = fvi @@ -3278,7 +3278,7 @@ instance producerRequirements Expression where = (False,prs) producerRequirements (ABCCodeExpr _ _) prs = (False,prs) - producerRequirements (MatchExpr _ _ _) prs + producerRequirements (MatchExpr _ _) prs // what's this? = (False,prs) producerRequirements (DynamicExpr _) prs diff --git a/frontend/transform.icl b/frontend/transform.icl index fb931fa..513177a 100644 --- a/frontend/transform.icl +++ b/frontend/transform.icl @@ -80,9 +80,9 @@ where lift (TupleSelect symbol argn_nr expr) ls # (expr, ls) = lift expr ls = (TupleSelect symbol argn_nr expr, ls) - lift (MatchExpr opt_tuple cons_symb expr) ls + lift (MatchExpr cons_symb expr) ls # (expr, ls) = lift expr ls - = (MatchExpr opt_tuple cons_symb expr, ls) + = (MatchExpr cons_symb expr, ls) lift (DynamicExpr expr) ls # (expr, ls) = lift expr ls = (DynamicExpr expr, ls) @@ -426,9 +426,9 @@ where unfold (TupleSelect symbol argn_nr expr) ui us # (expr, us) = unfold expr ui us = (TupleSelect symbol argn_nr expr, us) - unfold (MatchExpr opt_tuple cons_symb expr) ui us + unfold (MatchExpr cons_symb expr) ui us # (expr, us) = unfold expr ui us - = (MatchExpr opt_tuple cons_symb expr, us) + = (MatchExpr cons_symb expr, us) unfold (DynamicExpr expr) ui us # (expr, us) = unfold expr ui us = (DynamicExpr expr, us) @@ -1257,7 +1257,7 @@ where = True has_no_curried_macro_Expression (TupleSelect symbol argn_nr expr) = has_no_curried_macro_Expression expr - has_no_curried_macro_Expression (MatchExpr opt_tuple cons_symb expr) + has_no_curried_macro_Expression (MatchExpr cons_symb expr) = has_no_curried_macro_Expression expr has_no_curried_macro_Expression expr = True @@ -1648,9 +1648,9 @@ where expand (TupleSelect symbol argn_nr expr) ei # (expr, ei) = expand expr ei = (TupleSelect symbol argn_nr expr, ei) - expand (MatchExpr opt_tuple cons_symb expr) ei + expand (MatchExpr cons_symb expr) ei # (expr, ei) = expand expr ei - = (MatchExpr opt_tuple cons_symb expr, ei) + = (MatchExpr cons_symb expr, ei) expand expr ei = (expr, ei) @@ -1950,9 +1950,9 @@ where collectVariables (TupleSelect symbol argn_nr expr) free_vars cos # (expr, free_vars, cos) = collectVariables expr free_vars cos = (TupleSelect symbol argn_nr expr, free_vars, cos) - collectVariables (MatchExpr opt_tuple cons_symb expr) free_vars cos + collectVariables (MatchExpr cons_symb expr) free_vars cos # (expr, free_vars, cos) = collectVariables expr free_vars cos - = (MatchExpr opt_tuple cons_symb expr, free_vars, cos) + = (MatchExpr cons_symb expr, free_vars, cos) collectVariables (DynamicExpr dynamic_expr=:{dyn_expr /* MV ... */ , dyn_info_ptr /* ... MV */}) free_vars cos #! (dyn_expr, free_vars, cos /* MV ... */ =:{cos_symbol_heap} /* ... MV */) = collectVariables dyn_expr free_vars cos // MV ... diff --git a/frontend/type.icl b/frontend/type.icl index afc7185..e5d91ab 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -1470,16 +1470,15 @@ where requirements ti (Selection selector_kind expr selectors) reqs_ts # (expr_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts = case selector_kind of - UniqueSelector {glob_object={ds_ident,ds_index,ds_arity}, glob_module} + UniqueSelector # (var, ts) = freshAttributedVariable ts (_, result_type, (reqs, ts)) = requirementsOfSelectors ti No expr selectors False False var expr (reqs, ts) - tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity non_unique_type_var = { at_attribute = TA_Multi, at_annotation = AN_None, at_type = TempV ts.ts_var_store } req_type_coercions = [ { tc_demanded = non_unique_type_var, tc_offered = result_type, tc_position = CP_Expression expr, tc_coercible = False }, { tc_demanded = var, tc_offered = expr_type, tc_position = CP_Expression expr, tc_coercible = True } : reqs.req_type_coercions] - result_type = { at_type = TA tuple_type [non_unique_type_var,var], at_attribute = TA_Unique, at_annotation = AN_None } + result_type = { at_type = TA tuple2TypeSymbIdent [non_unique_type_var,var], at_attribute = TA_Unique, at_annotation = AN_None } -> (result_type, No, ({ reqs & req_type_coercions = req_type_coercions }, {ts & ts_var_store = inc ts.ts_var_store, ts_expr_heap = storeAttribute opt_expr_ptr TA_Multi ts.ts_expr_heap})) NormalSelectorUniqueElementResult @@ -1548,20 +1547,18 @@ where attributedBasicType {box=type} ts=:{ts_attr_store} = ({ at_annotation = AN_None, at_attribute = TA_TempVar ts_attr_store, at_type = type}, {ts & ts_attr_store = inc ts_attr_store}) - requirements ti (MatchExpr opt_tuple_type {glob_object={ds_arity, ds_index},glob_module} expr) (reqs, ts) + requirements ti (MatchExpr {glob_object={ds_arity, ds_index},glob_module} expr) (reqs, ts) # cp = CP_Expression expr ({tst_result,tst_args,tst_attr_env}, ts) = standardLhsConstructorType cp ds_index glob_module ds_arity ti ts (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr (reqs, ts) reqs = { reqs & req_attr_coercions = tst_attr_env ++ reqs.req_attr_coercions, req_type_coercions = [{ tc_demanded = tst_result, tc_offered = e_type, tc_position = cp, tc_coercible = True } : reqs.req_type_coercions ] } ts = { ts & ts_expr_heap = storeAttribute opt_expr_ptr tst_result.at_attribute ts.ts_expr_heap } - = case opt_tuple_type of - Yes {glob_object={ds_ident,ds_index,ds_arity}, glob_module} - # tuple_type = MakeTypeSymbIdent { glob_object = ds_index, glob_module = glob_module } ds_ident ds_arity - -> ({ at_type = TA tuple_type tst_args, at_attribute = TA_Unique, at_annotation = AN_None }, No, (reqs, ts)) - No - -> ( hd tst_args, No, (reqs, ts)) - + | ds_arity<>1 + # tuple_type = MakeTypeSymbIdent { glob_object = PD_Arity2TupleTypeIndex+(ds_arity-2), glob_module = cPredefinedModuleIndex } predefined_idents.[PD_Arity2TupleType+(ds_arity-2)] ds_arity + = ({ at_type = TA tuple_type tst_args, at_attribute = TA_Unique, at_annotation = AN_None }, No, (reqs, ts)) + = ( hd tst_args, No, (reqs, ts)) + requirements _ (AnyCodeExpr _ _ _) (reqs, ts) # (fresh_v, ts) = freshAttributedVariable ts = (fresh_v, No, (reqs, ts)) @@ -1580,6 +1577,8 @@ basicBoolType =: {box=TB BT_Bool} basicRealType =: {box=TB BT_Real} basicStringType =: {box=TA (MakeTypeSymbIdent { glob_object = PD_StringTypeIndex, glob_module = cPredefinedModuleIndex } predefined_idents.[PD_StringType] 0) []} +tuple2TypeSymbIdent =: MakeTypeSymbIdent { glob_object = PD_Arity2TupleTypeIndex, glob_module = cPredefinedModuleIndex } predefined_idents.[PD_Arity2TupleType] 2 + requirementsOfSelectors ti opt_expr expr [selector] tc_coercible change_uselect sel_expr_type sel_expr reqs_ts = requirementsOfSelector ti opt_expr expr selector tc_coercible change_uselect sel_expr_type sel_expr reqs_ts requirementsOfSelectors ti opt_expr expr [selector : selectors] tc_coercible change_uselect sel_expr_type sel_expr reqs_ts |