Skip to content

GitLab

C
compiler
Commit 7ae1e52d authored by John van Groningen's avatar John van Groningen
Browse files
Options

removed type from BasicExpr 

added BVInt
removed symb_arity from SymbIdent
parent a2eee0c0
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 405 additions and 368 deletions
backend/backendconvert.icl
View file @ 7ae1e52d
......@@ -374,7 +374,7 @@ beDynamicTempTypeSymbol
notYetImplementedExpr :: Expression
notYetImplementedExpr
= (BasicExpr (BVS "\"error in compiler (something was not implemented by lazy Ronny)\"") BT_Int)
= (BasicExpr (BVS "\"error in compiler (something was not implemented by lazy Ronny)\""))
backEndConvertModules :: PredefinedSymbols FrontEndSyntaxTree !Int *VarHeap *AttrVarHeap *BackEnd -> (!*VarHeap, *AttrVarHeap, !*BackEnd)
/*
......@@ -1751,6 +1751,8 @@ convertRhsStrictNodeIds expression
convertLiteralSymbol :: BasicValue -> BEMonad BESymbolP
convertLiteralSymbol (BVI intString)
= beLiteralSymbol BEIntDenot intString
convertLiteralSymbol (BVInt int)
= beLiteralSymbol BEIntDenot (toString int)
convertLiteralSymbol (BVB bool)
= beBoolSymbol bool
convertLiteralSymbol (BVC charString)
......@@ -1769,7 +1771,7 @@ convertExpr expr main_dcl_module_n
= convertExpr expr
where
convertExpr :: Expression -> BEMonad BENodeP
convertExpr (BasicExpr value _)
convertExpr (BasicExpr value)
= beNormalNode (convertLiteralSymbol value) beNoArgs
convertExpr (App {app_symb, app_args})
= beNormalNode (convertSymbol app_symb) (convertArgs app_args)
......
frontend/StdCompare.icl
View file @ 7ae1e52d
......@@ -54,7 +54,10 @@ where
instance == BasicValue
where
(==) (BVI int1) (BVI int2) = int1 == int2
(==) (BVI int1) (BVI int2) = int1 == int2
(==) (BVI int1) (BVInt int2) = int1 == toString int2
(==) (BVInt int1) (BVI int2) = toString int1 == int2
(==) (BVInt int1) (BVInt int2) = int1 == int2
(==) (BVC char1) (BVC char2) = char1 == char2
(==) (BVB bool1) (BVB bool2) = bool1 == bool2
(==) (BVR real1) (BVR real2) = real1 == real2
......
frontend/check.icl
View file @ 7ae1e52d
......@@ -2158,12 +2158,12 @@ check_module2 mod_name mod_modification_time mod_imported_objects mod_imports mo
= (icl_functions, heaps)
= (icl_functions, heaps)
build_function new_fun_index fun_def=:{fun_symb, fun_arity, fun_body = CheckedBody {cb_args}, fun_info} fun_index fun_type
build_function new_fun_index fun_def=:{fun_symb, fun_body = CheckedBody {cb_args}, fun_info} fun_index fun_type
(var_heap, type_var_heap, expr_heap)
# (tb_args, var_heap) = mapSt new_free_var cb_args var_heap
(app_args, expr_heap) = mapSt new_bound_var tb_args expr_heap
(app_info_ptr, expr_heap) = newPtr EI_Empty expr_heap
tb_rhs = App { app_symb = { symb_name = fun_symb, symb_arity = fun_arity,
tb_rhs = App { app_symb = { symb_name = fun_symb,
symb_kind = SK_Function { glob_module = main_dcl_module_n, glob_object = fun_index }},
app_args = app_args,
app_info_ptr = app_info_ptr }
......@@ -2849,7 +2849,7 @@ where
# (pre_mod, cs_predef_symbols) = cs_predef_symbols![PD_PredefinedModule]
| pre_mod.pds_def == mod_index
= (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}
<=< adjustPredefSymbol PD_StringType mod_index STE_Type
<=< adjustPredefSymbolAndCheckIndex PD_StringType mod_index PD_StringTypeIndex STE_Type
<=< adjust_predef_symbols PD_ListType PD_UnboxedArrayType mod_index STE_Type
<=< adjust_predef_symbols PD_ConsSymbol PD_Arity32TupleSymbol mod_index STE_Constructor
<=< adjustPredefSymbol PD_TypeCodeClass mod_index STE_Class
......@@ -2953,6 +2953,18 @@ where
= ste_index
= NoIndex
adjustPredefSymbolAndCheckIndex predef_index mod_index symbol_index symb_kind cs=:{cs_symbol_table,cs_error}
# pre_id = predefined_idents.[predef_index]
#! pre_index = determine_index_of_symbol (sreadPtr pre_id.id_info cs_symbol_table) symb_kind
| pre_index == symbol_index
= { cs & cs_predef_symbols.[predef_index] = { pds_def = pre_index, pds_module = mod_index }}
= { cs & cs_error = checkError pre_id " function not defined or wrong index in predef" cs_error }
where
determine_index_of_symbol {ste_kind, ste_index} symb_kind
| ste_kind == symb_kind
= ste_index
= NoIndex
NewEntry symbol_table symb_ptr def_kind def_index level previous :==
symbol_table <:= (symb_ptr,{ ste_kind = def_kind, ste_index = def_index, ste_def_level = level, ste_previous = previous })
......
frontend/checkFunctionBodies.icl
View file @ 7ae1e52d
......@@ -68,7 +68,7 @@ make_unboxed_list type_symbol expr_heap cs
# (stdStrictLists_index,cons_u_index,decons_u_index,nil_u_index,decons_u_ident,cs) = get_unboxed_list_indices_and_decons_u_ident cs
# unboxed_list=UnboxedList type_symbol stdStrictLists_index decons_u_index nil_u_index
# (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap
# decons_expr = App {app_symb={symb_name=decons_u_ident,symb_arity=0,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr}
# decons_expr = App {app_symb={symb_name=decons_u_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_u_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr}
= (unboxed_list,decons_expr,expr_heap,cs)
get_unboxed_tail_strict_list_indices_and_decons_u_ident :: *CheckState -> (!Index,!Index,!Index,!Index,!Ident,!*CheckState);
......@@ -85,7 +85,7 @@ make_unboxed_tail_strict_list type_symbol expr_heap cs
# (stdStrictLists_index,cons_uts_index,decons_uts_index,nil_uts_index,decons_uts_ident,cs) = get_unboxed_tail_strict_list_indices_and_decons_u_ident cs
# unboxed_list=UnboxedTailStrictList type_symbol stdStrictLists_index decons_uts_index nil_uts_index
# (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap
# decons_expr = App {app_symb={symb_name=decons_uts_ident,symb_arity=0,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr}
# decons_expr = App {app_symb={symb_name=decons_uts_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_uts_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr}
= (unboxed_list,decons_expr,expr_heap,cs)
get_overloaded_list_indices_and_decons_ident :: *CheckState -> (!Index,!Index,!Index,!Index,!Ident,!*CheckState);
......@@ -102,7 +102,7 @@ make_overloaded_list type_symbol expr_heap cs
# (stdStrictLists_index,cons_index,decons_index,nil_index,decons_ident,cs) = get_overloaded_list_indices_and_decons_ident cs
# overloaded_list=OverloadedList type_symbol stdStrictLists_index decons_index nil_index
# (new_info_ptr,expr_heap) = newPtr EI_Empty expr_heap
# decons_expr = App {app_symb={symb_name=decons_ident,symb_arity=0,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr}
# decons_expr = App {app_symb={symb_name=decons_ident,symb_kind=SK_OverloadedFunction {glob_object=decons_index,glob_module=stdStrictLists_index}},app_args=[],app_info_ptr=new_info_ptr}
= (overloaded_list,decons_expr,expr_heap,cs)
make_case_guards cons_symbol type_symbol alg_patterns expr_heap cs
......@@ -1036,10 +1036,9 @@ checkExpression free_vars (PE_Update expr1 selectors expr2) e_input e_state e_in
= (Update expr1 selectors expr2, free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_Tuple exprs) e_input e_state e_info cs
# (exprs, arity, free_vars, e_state, e_info, cs) = check_expression_list free_vars exprs e_input e_state e_info cs
({glob_object={ds_ident,ds_index, ds_arity},glob_module}, cs)
({glob_object={ds_ident,ds_index},glob_module}, cs)
= getPredefinedGlobalSymbol (GetTupleConsIndex arity) PD_PredefinedModule STE_Constructor arity cs
= (App { app_symb = { symb_name = ds_ident, symb_arity = ds_arity,
symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }},
= (App { app_symb = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }},
app_args = exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs)
where
check_expression_list free_vars [] e_input e_state e_info cs
......@@ -1053,8 +1052,8 @@ checkExpression free_vars rec=:(PE_Record record opt_type fields) e_input=:{ei_e
# (opt_record_and_fields, e_info, cs) = checkFields ei_mod_index fields opt_type e_info cs
= case opt_record_and_fields of
Yes (cons=:{glob_module, glob_object}, _, new_fields)
# {ds_ident,ds_index,ds_arity} = glob_object
rec_cons = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module }, symb_arity = ds_arity }
# {ds_ident,ds_index} = glob_object
rec_cons = { symb_name = ds_ident, symb_kind = SK_Constructor { glob_object = ds_index, glob_module = glob_module } }
-> case record of
PE_Empty
# (exprs, free_vars, e_state, e_info, cs) = check_field_exprs free_vars new_fields 0 RK_Constructor e_input e_state e_info cs
......@@ -1135,8 +1134,7 @@ checkExpression free_vars (PE_Dynamic expr opt_type) e_input e_state=:{es_expr_h
// ... MV
checkExpression free_vars (PE_Basic basic_value) e_input e_state e_info cs
# (basic_type, cs) = typeOfBasicValue basic_value cs
= (BasicExpr basic_value basic_type, free_vars, e_state, e_info, cs)
= (BasicExpr basic_value, free_vars, e_state, e_info, cs)
checkExpression free_vars (PE_ABC_Code code_sequence do_inline) e_input e_state e_info cs
= (ABCCodeExpr code_sequence do_inline, free_vars, e_state, e_info, cs)
......@@ -1216,7 +1214,7 @@ checkExpression free_vars (PE_Generic id=:{id_name,id_info} kind) e_input e_stat
check_it free_vars mod_index gen_index id kind e_input e_state=:{es_expr_heap} e_info cs
#! symb_kind = SK_Generic { glob_object = gen_index, glob_module = mod_index} kind
#! symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 }
#! symbol = { symb_name = id, symb_kind = symb_kind }
#! (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
#! app = { app_symb = symbol, app_args = [], app_info_ptr = new_info_ptr }
#! e_state = { e_state & es_expr_heap = es_expr_heap }
......@@ -1286,7 +1284,7 @@ where
{ cs & cs_error = checkError id "generic: missing kind argument" cs_error})
check_id_expression entry is_expr_list free_vars id=:{id_info} e_input e_state e_info cs
# (symb_kind, arity, priority, is_a_function, e_state, e_info, cs) = determine_info_of_symbol entry id_info e_input e_state e_info cs
symbol = { symb_name = id, symb_kind = symb_kind, symb_arity = 0 }
symbol = { symb_name = id, symb_kind = symb_kind }
| is_expr_list
= (Constant symbol arity priority is_a_function, free_vars, e_state, e_info, cs)
# (app_expr, e_state, cs_error) = buildApplication symbol arity 0 is_a_function [] e_state cs.cs_error
......@@ -1592,6 +1590,8 @@ checkPattern (PE_ArrayPattern selections) opt_var p_input (var_env, array_patter
// further with next alternative
check_index_expr (PE_Basic (BVI _)) states
= states
check_index_expr (PE_Basic (BVInt _)) states
= states
check_index_expr _ (var_env, ap_selections, var_heap, cs)
= (var_env, ap_selections, var_heap, { cs & cs_error = checkError "variable or integer constant expected as index expression" "" cs.cs_error })
......@@ -1907,10 +1907,10 @@ where
unfold_pattern_macro mod_index macro_ident opt_var extra_args (App {app_symb,app_args}) ums
= unfold_application mod_index macro_ident opt_var extra_args app_symb app_args ums
where
unfold_application mod_index macro_ident opt_var extra_args {symb_kind=SK_Constructor {glob_module,glob_object},symb_name,symb_arity} app_args
unfold_application mod_index macro_ident opt_var extra_args {symb_kind=SK_Constructor {glob_module,glob_object},symb_name} app_args
ums=:{ums_cons_defs, ums_modules,ums_error}
# (cons_def, cons_index, ums_cons_defs, ums_modules) = get_cons_def mod_index glob_module glob_object ums_cons_defs ums_modules
| cons_def.cons_type.st_arity == symb_arity+length extra_args
| cons_def.cons_type.st_arity == length app_args+length extra_args
# (patterns, ums) = mapSt (unfold_pattern_macro mod_index macro_ident No []) app_args { ums & ums_cons_defs = ums_cons_defs, ums_modules = ums_modules }
cons_symbol = { glob_object = MakeDefinedSymbol symb_name cons_index cons_def.cons_type.st_arity, glob_module = glob_module }
= (AP_Algebraic cons_symbol cons_def.cons_type_index (patterns++extra_args) opt_var, ums)
......@@ -1925,7 +1925,7 @@ where
cons_def = dcl_common.com_cons_defs.[cons_index]
= (cons_def, cons_index, cons_defs, modules)
unfold_pattern_macro mod_index macro_ident opt_var extra_args (BasicExpr bv bt) ums=:{ums_error}
unfold_pattern_macro mod_index macro_ident opt_var extra_args (BasicExpr bv) ums=:{ums_error}
| not (isEmpty extra_args)
= (AP_Empty macro_ident, { ums & ums_error = checkError macro_ident "too much arguments for pattern macro" ums_error })
= (AP_Basic bv opt_var, ums)
......@@ -2233,11 +2233,11 @@ buildApplication symbol form_arity act_arity is_fun args e_state=:{es_expr_heap}
| is_fun
# (new_info_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
| form_arity < act_arity
# app = { app_symb = { symbol & symb_arity = form_arity }, app_args = take form_arity args, app_info_ptr = new_info_ptr }
# app = { app_symb = symbol , app_args = take form_arity args, app_info_ptr = new_info_ptr }
= (App app @ drop form_arity args, { e_state & es_expr_heap = es_expr_heap }, error)
# app = { app_symb = { symbol & symb_arity = act_arity }, app_args = take form_arity args, app_info_ptr = new_info_ptr }
# app = { app_symb = symbol , app_args = take form_arity args, app_info_ptr = new_info_ptr }
= (App app, { e_state & es_expr_heap = es_expr_heap }, error)
# app = App { app_symb = { symbol & symb_arity = act_arity }, app_args = args, app_info_ptr = nilPtr }
# app = App { app_symb = symbol , app_args = args, app_info_ptr = nilPtr }
| form_arity < act_arity
= (app, e_state, checkError symbol.symb_name "used with too many arguments" error)
= (app, e_state, error)
......@@ -2284,6 +2284,7 @@ where
typeOfBasicValue :: !BasicValue !*CheckState -> (!BasicType, !*CheckState)
typeOfBasicValue (BVI _) cs = (BT_Int, cs)
typeOfBasicValue (BVInt _) cs = (BT_Int, cs)
typeOfBasicValue (BVC _) cs = (BT_Char, cs)
typeOfBasicValue (BVB _) cs = (BT_Bool, cs)
typeOfBasicValue (BVR _) cs = (BT_Real, cs)
......
frontend/comparedefimp.icl
View file @ 7ae1e52d
......@@ -677,7 +677,6 @@ instance t_corresponds (TypeDef TypeRhs) where
tc_state = init_atype_vars iclDef.td_args tc_state
= t_corresponds (dclDef.td_args, (dclDef.td_rhs, (dclDef.td_context, dclDef.td_attribute)))
(iclDef.td_args, (iclDef.td_rhs, (iclDef.td_context, iclDef.td_attribute))) tc_state
instance t_corresponds TypeContext where
t_corresponds dclDef iclDef
= t_corresponds dclDef.tc_class iclDef.tc_class
......@@ -938,9 +937,8 @@ instance e_corresponds Expression where
= e_corresponds dcl_ds icl_ds
o` equal2 dcl_field_nr icl_field_nr
o` e_corresponds dcl_expr icl_expr
e_corresponds (BasicExpr dcl_value dcl_type) (BasicExpr icl_value icl_type)
e_corresponds (BasicExpr dcl_value) (BasicExpr icl_value)
= equal2 dcl_value icl_value
o` equal2 dcl_type icl_type
e_corresponds (AnyCodeExpr dcl_ins dcl_outs dcl_code_sequence) (AnyCodeExpr icl_ins icl_outs icl_code_sequence)
= e_corresponds dcl_ins icl_ins
o` e_corresponds dcl_outs icl_outs
......@@ -1075,7 +1073,7 @@ instance e_corresponds {#Char} where
instance e_corresponds BoundVar where
e_corresponds dcl icl
= e_corresponds_VarInfoPtr icl.var_name dcl.var_info_ptr icl.var_info_ptr
instance e_corresponds FieldSymbol where
e_corresponds dclField iclField
= equal2 dclField.fs_name iclField.fs_name
......
frontend/convertDynamics.icl
View file @ 7ae1e52d
......@@ -140,7 +140,7 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
// get tuple arity 2 constructor
# ({pds_module, pds_def}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity]
# pds_ident = predefined_idents.[GetTupleConsIndex arity]
# twoTuple_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity }
# twoTuple_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} }
// get tuple, type and value selectors
# ({pds_def}, predefined_symbols) = predefined_symbols![GetTupleConsIndex arity]
......@@ -159,7 +159,6 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
= { SymbIdent |
symb_name = rt_constructor.ds_ident
, symb_kind = SK_Constructor {glob_module = pds_module1, glob_object = rt_constructor.ds_index}
, symb_arity = rt_constructor.ds_arity
}
// type field
......@@ -407,8 +406,8 @@ where
convertDynamics cinp bound_vars default_expr (TupleSelect definedSymbol int expression) ci
# (expression,ci) = convertDynamics cinp bound_vars default_expr expression ci
= (TupleSelect definedSymbol int expression, ci)
convertDynamics _ _ _ (BasicExpr basicValue basicType) ci
= (BasicExpr basicValue basicType, ci)
convertDynamics _ _ _ be=:(BasicExpr basicValue) ci
= (be, ci)
convertDynamics _ _ _ (AnyCodeExpr codeBinding1 codeBinding2 strings) ci
= (AnyCodeExpr codeBinding1 codeBinding2 strings, ci)
convertDynamics _ _ _ (ABCCodeExpr strings bool) ci
......@@ -937,7 +936,7 @@ where
= ci;
# ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![PD_ModuleConsSymbol]
# pds_ident = predefined_idents.[PD_ModuleConsSymbol]
# module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 0 }
# module_symb1 = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} }
# ci
= { ci & ci_predef_symb = ci_predef_symb };
......@@ -1181,7 +1180,7 @@ addToBoundVars var type bound_vars
get_constructor :: !{!GlobalTCType} Index -> Expression
get_constructor glob_type_inst index
= BasicExpr (BVS ("\"" +++ toString glob_type_inst.[index] +++ "\"")) (BT_String TE)
= BasicExpr (BVS ("\"" +++ toString glob_type_inst.[index] +++ "\""))
getResultType :: ExprInfoPtr !*ConversionInfo -> (!AType, !*ConversionInfo)
getResultType case_info_ptr ci=:{ci_expr_heap}
......@@ -1193,7 +1192,7 @@ getSymbol index symb_kind arity ci=:{ci_predef_symb}
# ({pds_module, pds_def}, ci_predef_symb) = ci_predef_symb![index]
# pds_ident = predefined_idents.[index]
ci = {ci & ci_predef_symb = ci_predef_symb}
symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def}, symb_arity = arity }
symbol = { symb_name = pds_ident, symb_kind = symb_kind { glob_module = pds_module, glob_object = pds_def} }
= (symbol, ci)
getTupleSymbol arity ci=:{ci_predef_symb}
......@@ -1283,7 +1282,7 @@ get_module_id_app predef_symbols
# ({pds_module, pds_def}, predef_symbols) = predef_symbols![PD_ModuleConsSymbol]
# pds_ident = predefined_idents.[PD_ModuleConsSymbol]
# module_symb =
{ app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 0 }
{ app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} }
, app_args = []
, app_info_ptr = nilPtr
}
......@@ -1291,7 +1290,7 @@ get_module_id_app predef_symbols
# ({pds_module, pds_def}, predef_symbols) = predef_symbols![PD_ModuleID]
# pds_ident = predefined_idents.[PD_ModuleID]
# module_id_symb =
{ app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def}, symb_arity = 1 }
{ app_symb = { symb_name = pds_ident, symb_kind = SK_Constructor { glob_module = pds_module, glob_object = pds_def} }
, app_args = [App module_symb]
, app_info_ptr = nilPtr
}
......
frontend/convertcases.icl
View file @ 7ae1e52d
......@@ -209,7 +209,7 @@ where
weightedRefCount rci (Case case_expr) rs=:{rcs_expr_heap}
# (case_info, rcs_expr_heap) = readPtr case_expr.case_info_ptr rcs_expr_heap
= weightedRefCountOfCase rci case_expr case_info { rs & rcs_expr_heap = rcs_expr_heap }
weightedRefCount rci expr=:(BasicExpr _ _) rs
weightedRefCount rci expr=:(BasicExpr _) rs
= rs
weightedRefCount rci (MatchExpr _ constructor expr) rs
= weightedRefCount rci expr rs
......@@ -454,7 +454,7 @@ where
# (fun_expr, ds) = distributeLets depth fun_expr ds
(exprs, ds) = distributeLets depth exprs ds
= (fun_expr @ exprs, ds)
distributeLets depth expr=:(BasicExpr _ _) ds
distributeLets depth expr=:(BasicExpr _) ds
= (expr, ds)
distributeLets depth (MatchExpr opt_tuple constructor expr) ds
# (expr, ds) = distributeLets depth expr ds
......@@ -734,7 +734,7 @@ newFunctionWithType opt_id fun_bodies local_vars fun_type group_index (cs_next_f
, fun_lifted = 0
, fun_info = { EmptyFunInfo & fi_group_index = group_index, fi_local_vars = local_vars }
}
= ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr cs_next_fun_nr, symb_arity = arity },
= ({ symb_name = fun_id, symb_kind = SK_GeneratedFunction fun_def_ptr cs_next_fun_nr },
(inc cs_next_fun_nr, [fun_def_ptr : cs_new_functions],
cs_fun_heap <:= (fun_def_ptr, FI_Function { gf_fun_def = fun_def, gf_instance_info = II_Empty,
gf_fun_index = cs_next_fun_nr, gf_cons_args = {cc_size=0, cc_args = [], cc_linear_bits = [], cc_producer = False} })))
......@@ -910,7 +910,7 @@ instance convertRootCases Expression where
build_conditional false guard then_expr (Yes else_expr)
= Conditional { if_cond = guard, if_then = else_expr, if_else = Yes then_expr }
build_conditional false guard then_expr No
= Conditional { if_cond = Conditional { if_cond = guard, if_then = BasicExpr (BVB False) BT_Bool, if_else = Yes (BasicExpr (BVB True) BT_Bool) },
= Conditional { if_cond = Conditional { if_cond = guard, if_then = BasicExpr (BVB False), if_else = Yes (BasicExpr (BVB True)) },
if_then = then_expr, if_else = No }
convert_to_else_part ci sign_of_then_part [ alt=:{bp_value=BVB sign_of_else_part,bp_expr} : alts ] case_default cs
......@@ -1234,7 +1234,7 @@ where
copy (Conditional cond) cp_info
# (cond, cp_info) = copy cond cp_info
= (Conditional cond, cp_info)
copy expr=:(BasicExpr _ _) cp_info
copy expr=:(BasicExpr _) cp_info
= (expr, cp_info)
copy (MatchExpr opt_tuple constructor expr) cp_info
# (expr, cp_info) = copy expr cp_info
......
frontend/explicitimports.icl
View file @ 7ae1e52d
......@@ -654,7 +654,7 @@ instance check_completeness Expression where
(check_completeness selections cci ccs)
check_completeness (TupleSelect _ _ expression) cci ccs
= check_completeness expression cci ccs
check_completeness (BasicExpr _ _) _ ccs
check_completeness (BasicExpr _) _ ccs
= ccs
check_completeness (AnyCodeExpr _ _ _) _ ccs
= ccs
......
frontend/generics.icl
View file @ 7ae1e52d
......@@ -3749,8 +3749,8 @@ buildConsApp cons_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expres
# expr = App {
app_symb = {
symb_name = ds_ident,
symb_kind = SK_Constructor cons_glob,
symb_arity = ds_arity },
symb_kind = SK_Constructor cons_glob
},
app_args = arg_exprs,
app_info_ptr = expr_info_ptr}
# heaps = { heaps & hp_expression_heap = hp_expression_heap }
......@@ -3764,8 +3764,8 @@ buildFunApp fun_mod {ds_ident, ds_index, ds_arity} arg_exprs heaps=:{hp_expressi
# expr = App {
app_symb = {
symb_name = ds_ident,
symb_kind = SK_Function fun_glob,
symb_arity = length arg_exprs },
symb_kind = SK_Function fun_glob
},
app_args = arg_exprs,
app_info_ptr = expr_info_ptr}
# heaps = { heaps & hp_expression_heap = hp_expression_heap }
......@@ -3779,8 +3779,8 @@ buildGenericApp module_index {ds_ident, ds_index} kind arg_exprs heaps=:{hp_expr
# expr = App {
app_symb = {
symb_name = ds_ident,
symb_kind = SK_Generic glob_index kind,
symb_arity = length arg_exprs },
symb_kind = SK_Generic glob_index kind
},
app_args = arg_exprs,
app_info_ptr = expr_info_ptr}
# heaps = { heaps & hp_expression_heap = hp_expression_heap }
......@@ -3847,8 +3847,7 @@ buildPredefConsApp predef_index args predefs heaps=:{hp_expression_heap}
# global_index = {glob_module = pds_module, glob_object = pds_def}
# symb_ident = {
symb_name = pds_ident,
symb_kind = SK_Constructor global_index,
symb_arity = length args
symb_kind = SK_Constructor global_index
}
# (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap
# app = App {app_symb = symb_ident, app_args = args, app_info_ptr = expr_info_ptr}
......@@ -3869,9 +3868,8 @@ buildPredefFunApp predef_index args predefs heaps=:{hp_expression_heap}
# pds_ident = predefined_idents.[predef_index]
# global_index = {glob_module = pds_module, glob_object = pds_def}
# symb_ident = {
symb_name = pds_ident,
symb_kind = SK_Function global_index,
symb_arity = length args
symb_name = pds_ident,
symb_kind = SK_Function global_index
}
# (expr_info_ptr, hp_expression_heap) = newPtr EI_Empty hp_expression_heap
# app = App {app_symb = symb_ident, app_args = args, app_info_ptr = expr_info_ptr}
......@@ -4179,14 +4177,14 @@ makeIdent :: String -> Ident
makeIdent str = {id_name = str, id_info = nilPtr}
makeIntExpr :: Int -> Expression
makeIntExpr value = BasicExpr (BVI (toString value)) BT_Int
makeIntExpr value = BasicExpr (BVI (toString value))
makeStringExpr :: String !PredefinedSymbols -> Expression
makeStringExpr str predefs
#! {pds_module, pds_def} = predefs.[PD_StringType]
#! pds_ident = predefined_idents.[PD_StringType]
#! type_symb = MakeTypeSymbIdent { glob_module = pds_module, glob_object = pds_def } pds_ident 0
= BasicExpr (BVS str) (BT_String (TA type_symb []))
= BasicExpr (BVS str)
makeListExpr :: [Expression] !PredefinedSymbols !*Heaps -> (Expression, !*Heaps)
makeListExpr [] predefs heaps
......
frontend/overloading.icl
View file @ 7ae1e52d
......@@ -789,29 +789,28 @@ getDictionaryTypeAndConstructor {glob_module, glob_object = {ds_ident,ds_index}}
= (class_dictionary, rt_constructor)
convertOverloadedCall :: !{#CommonDefs} ![TypeContext] !SymbIdent !ExprInfoPtr ![ClassApplication] !(!*Heaps, ![ExprInfoPtr]) -> (!*Heaps, ![ExprInfoPtr])
convertOverloadedCall defs contexts {symb_name,symb_kind = SK_OverloadedFunction {glob_module,glob_object}, symb_arity} expr_ptr [class_appl:class_appls] heaps_and_ptrs
convertOverloadedCall defs contexts {symb_name,symb_kind = SK_OverloadedFunction {glob_module,glob_object}} expr_ptr [class_appl:class_appls] heaps_and_ptrs
# mem_def = defs.[glob_module].com_member_defs.[glob_object]
(class_exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts class_appls heaps_and_ptrs
(inst_expr, (heaps, ptrs)) = adjust_member_application defs contexts mem_def symb_arity class_appl class_exprs heaps_and_ptrs
(inst_expr, (heaps, ptrs)) = adjust_member_application defs contexts mem_def class_appl class_exprs heaps_and_ptrs
= ({ heaps & hp_expression_heap = heaps.hp_expression_heap <:= (expr_ptr, inst_expr)}, ptrs)
where
adjust_member_application defs contexts {me_symb,me_offset,me_class} symb_arity (CA_Instance red_contexts) class_exprs heaps_and_ptrs
adjust_member_application defs contexts {me_symb,me_offset,me_class} (CA_Instance red_contexts) class_exprs heaps_and_ptrs
# ({glob_module,glob_object}, red_contexts) = find_instance_of_member me_class me_offset red_contexts
(exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts red_contexts heaps_and_ptrs
class_exprs = exprs ++ class_exprs
= (EI_Instance { glob_module = glob_module, glob_object = { ds_ident = me_symb, ds_arity = length class_exprs, ds_index = glob_object }} class_exprs,
heaps_and_ptrs)
adjust_member_application defs contexts {me_symb,me_offset,me_class={glob_module,glob_object}} symb_arity (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs)
adjust_member_application defs contexts {me_symb,me_offset,me_class={glob_module,glob_object}} (CA_Context tc) class_exprs (heaps=:{hp_type_heaps}, ptrs)
# (class_context, address, hp_type_heaps) = determineContextAddress contexts defs tc hp_type_heaps
{class_dictionary={ds_index,ds_ident}} = defs.[glob_module].com_class_defs.[glob_object]
selector = selectFromDictionary glob_module ds_index me_offset defs
= (EI_Selection (generateClassSelection address [RecordSelection selector me_offset]) class_context.tc_var class_exprs,
({ heaps & hp_type_heaps = hp_type_heaps }, ptrs))
adjust_member_application defs contexts _ _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ heaps_and_ptrs
adjust_member_application defs contexts _ (CA_GlobalTypeCode {tci_index,tci_contexts}) _ heaps_and_ptrs
# (exprs, heaps_and_ptrs) = convertClassApplsToExpressions defs contexts tci_contexts heaps_and_ptrs
= (EI_TypeCode (TCE_Constructor tci_index (map expressionToTypeCodeExpression exprs)), heaps_and_ptrs)
adjust_member_application defs contexts _ _ (CA_LocalTypeCode new_var_ptr) _ heaps_and_ptrs
adjust_member_application defs contexts _ (CA_LocalTypeCode new_var_ptr) _ heaps_and_ptrs
= (EI_TypeCode (TCE_Var new_var_ptr), heaps_and_ptrs)
find_instance_of_member me_class me_offset { rcs_class_context = {rc_class, rc_inst_module, rc_inst_members, rc_red_contexts}, rcs_constraints_contexts}
......@@ -911,8 +910,8 @@ where
{ds_ident,ds_index} = ins_members.[mem_offset]
mem_expr = App { app_symb = {
symb_name = ds_ident,
symb_kind = SK_Function { glob_object = ds_index, glob_module = mod_index },
symb_arity = arity },
symb_kind = SK_Function { glob_object = ds_index, glob_module = mod_index }
},
app_args = class_arguments,
app_info_ptr = nilPtr }
= build_class_members mem_offset ins_members mod_index class_arguments arity [ mem_expr : dictionary_args ]
......@@ -920,8 +919,8 @@ where
build_dictionary class_symbol instance_types dictionary_args defs expr_heap ptrs
# (dict_type, dict_cons) = getDictionaryTypeAndConstructor class_symbol defs
record_symbol = { symb_name = dict_cons.ds_ident,
symb_kind = SK_Constructor {glob_module = class_symbol.glob_module, glob_object = dict_cons.ds_index},
symb_arity = dict_cons.ds_arity }
symb_kind = SK_Constructor {glob_module = class_symbol.glob_module, glob_object = dict_cons.ds_index}
}
dict_type_symbol = MakeTypeSymbIdent {glob_module = class_symbol.glob_module, glob_object = dict_type.ds_index} dict_type.ds_ident dict_type.ds_arity
class_type = TA dict_type_symbol [ AttributedType type \\ type <- instance_types ]
(app_info_ptr, expr_heap) = newPtr (EI_DictionaryType class_type) expr_heap
......@@ -1265,7 +1264,7 @@ class updateExpression e :: !Index !e !*UpdateInfo -> (!e, !*UpdateInfo)
instance updateExpression Expression
where
updateExpression group_index (App app=:{app_symb=symb=:{symb_kind,symb_arity,symb_name},app_args,app_info_ptr}) ui
updateExpression group_index (App app=:{app_symb=symb=:{symb_kind,symb_name},app_args,app_info_ptr}) ui
# (app_args, ui) = updateExpression group_index app_args ui
| isNilPtr app_info_ptr
= (App { app & app_args = app_args }, ui)
......@@ -1279,24 +1278,22 @@ where
-> (App { app & app_args = app_args }, ui)
# (CheckedType {st_context}, ui) = ui!ui_fun_env.[fun_index]
(app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_name) st_context app_args (ui.ui_var_heap, ui.ui_error)
-> (App { app & app_symb = { symb & symb_arity = symb_arity + length st_context}, app_args = app_args },
{ ui & ui_var_heap = ui_var_heap, ui_error = ui_error })
-> (App { app & app_args = app_args }, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })
EI_Context context_args
# (app_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args app_args ui
#! main_dcl_module_n = ui.ui_x.UpdateInfoX.x_main_dcl_module_n
#! fun_index = get_recursive_fun_index group_index symb_kind main_dcl_module_n ui.ui_fun_defs
| fun_index == NoIndex
# app = { app & app_symb = { symb & symb_arity = length context_args + symb_arity }, app_args = app_args}
# app = { app & app_args = app_args}
-> (App app, examine_calls context_args { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })
# (CheckedType {st_context}, ui) = ui!ui_fun_env.[fun_index]
nr_of_context_args = length context_args
nr_of_lifted_contexts = length st_context - nr_of_context_args
(app_args, (ui_var_heap, ui_error)) = mapAppendSt (build_context_arg symb_name) (take nr_of_lifted_contexts st_context) app_args (ui_var_heap, ui_error)
-> (App { app & app_symb = { symb & symb_arity = nr_of_lifted_contexts + nr_of_context_args + symb_arity }, app_args = app_args },
examine_calls context_args { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })
-> (App { app & app_args = app_args }, examine_calls context_args { ui & ui_var_heap = ui_var_heap, ui_error = ui_error })
EI_Instance inst_symbol context_args
# (context_args, ui=:{ui_var_heap, ui_error}) = adjustClassExpressions symb_name context_args [] ui
-> (build_application inst_symbol context_args app_args symb_arity app_info_ptr,
-> (build_application inst_symbol context_args app_args app_info_ptr,
examine_calls context_args (new_call inst_symbol.glob_module inst_symbol.glob_object.ds_index
{ ui & ui_var_heap = ui_var_heap, ui_error = ui_error }))
EI_Selection selectors record_var context_args
......@@ -1339,10 +1336,9 @@ where
get_recursive_fun_index group_index _ main_dcl_module_n fun_defs
= NoIndex
build_application def_symbol=:{glob_object} context_args orig_args nr_of_orig_args app_info_ptr
build_application def_symbol=:{glob_object} context_args orig_args app_info_ptr
= App {app_symb = { symb_name = glob_object.ds_ident,
symb_kind = SK_Function { def_symbol & glob_object = glob_object.ds_index },
symb_arity = glob_object.ds_arity + nr_of_orig_args },
symb_kind = SK_Function { def_symbol & glob_object = glob_object.ds_index } },
app_args = context_args ++ orig_args, app_info_ptr = app_info_ptr }
examine_application (SK_Function {glob_module,glob_object}) ui
......@@ -1554,7 +1550,7 @@ where
= (Var {var_name = v_tc_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}, { ui & ui_var_heap = ui_var_heap, ui_error = ui_error})
// MV ...
convertTypecode (TCE_Constructor index typecode_exprs) ui=:{ui_x={x_internal_type_id}}
# (typecons_symb,ui) = getSymbol PD_TypeConsSymbol SK_Constructor (USE_DummyModuleName 3 2) ui
# (typecons_symb,ui) = getSymbol PD_TypeConsSymbol SK_Constructor ui
(constructor,ui) = get_constructor index ui
(typecode_exprs, ui) = convertTypecodes typecode_exprs ui
# (ui_internal_type_id,ui)