Commit 7ae1e52d authored by John van Groningen's avatar John van Groningen

removed type from BasicExpr

added BVInt
removed symb_arity from SymbIdent
parent a2eee0c0
......@@ -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)
......
......@@ -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
......
......@@ -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 })
......
......@@ -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)
......
......@@ -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
......
......@@ -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
}
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
This diff is collapsed.
......@@ -2282,8 +2282,38 @@ where
trySimpleExpressionT CurlyOpenToken is_pattern pState
# (rec_or_aray_exp, pState) = wantRecordOrArrayExp is_pattern pState
= (True, rec_or_aray_exp, pState)
trySimpleExpressionT (IntToken int) is_pattern pState
= (True, PE_Basic (BVI int), pState)
trySimpleExpressionT (IntToken int_string) is_pattern pState
# (ok,int) = string_to_int int_string
with
string_to_int s
| len==0
= (False,0)
| s.[0] == '-'
| len>2 && s.[1]=='0' /* octal */
= (False,0)
# (ok,int) = (string_to_int2 1 0 s)
= (ok,~int)
| s.[0] == '+'
| len>2&& s.[1]=='0' /* octal */
= (False,0)
= string_to_int2 1 0 s
| s.[0]=='0' && len>1 /* octal */
= (False,0)
= string_to_int2 0 0 s
where
len = size s
string_to_int2:: !Int !Int !{#Char} -> (!Bool,!Int)
string_to_int2 posn val s
| len==posn
= (True,val)
# n = toInt (s.[posn]) - toInt '0'
| 0<=n && n<= 9
= string_to_int2 (posn+1) (n+val*10) s
= (False,0)
| ok
= (True, PE_Basic (BVInt int), pState)
= (True, PE_Basic (BVI int_string), pState)
trySimpleExpressionT (StringToken string) is_pattern pState
= (True, PE_Basic (BVS string), pState)
trySimpleExpressionT (BoolToken bool) is_pattern pState
......
This diff is collapsed.
......@@ -4,6 +4,8 @@ import syntax, hashtable
cPredefinedModuleIndex :== 1
PD_StringTypeIndex :== 0
:: PredefinedSymbols :== {# PredefinedSymbol}
:: PredefinedSymbol = {
......
......@@ -4,6 +4,8 @@ import syntax, hashtable, type_io_common
cPredefinedModuleIndex :== 1
PD_StringTypeIndex :== 0
:: PredefinedSymbols :== {# PredefinedSymbol}
:: PredefinedSymbol = {
......
......@@ -653,11 +653,11 @@ cNonRecursiveAppl :== False
:: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Function !SymbIdent !Int !Index
| PR_Class !App ![(BoundVar, Type)] !Type
| PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_Curried !SymbIdent
| PR_Constructor !SymbIdent !Int ![Expression]
| PR_GeneratedFunction !SymbIdent !Int !Index
| PR_Curried !SymbIdent !Int
:: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
......@@ -787,7 +787,6 @@ cNonRecursiveAppl :== False
:: SymbIdent =
{ symb_name :: !Ident
, symb_kind :: !SymbKind
, symb_arity :: !Int
}
:: ConsDef =
......@@ -949,7 +948,7 @@ cNonRecursiveAppl :== False
| BT_File | BT_World
| BT_String !Type /* the internal string type synonym only used to type string denotations */
:: BasicValue = BVI !String | BVC !String | BVB !Bool | BVR !String | BVS !String
:: BasicValue = BVI !String | BVInt !Int |BVC !String | BVB !Bool | BVR !String | BVS !String
:: TypeKind = KindVar !KindInfoPtr | KindConst | KindArrow ![TypeKind] | KindCycle
......@@ -1122,8 +1121,7 @@ cIsNotStrict :== False
| Update !Expression ![Selection] Expression
| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
| TupleSelect !DefinedSymbol !Int !Expression
// | Lambda .[FreeVar] !Expression
| BasicExpr !BasicValue !BasicType
| BasicExpr !BasicValue
| WildCard
| Conditional !Conditional
......@@ -1345,9 +1343,6 @@ MakeNewTypeSymbIdent name arity
MakeTypeSymbIdent type_index name arity
:== { newTypeSymbIdentCAF & type_name = name, type_arity = arity, type_index = type_index }
MakeSymbIdent name arity :== { symb_name = name, symb_kind = SK_Unknown, symb_arity = arity }
MakeConstant name :== MakeSymbIdent name 0
ParsedSelectorToSelectorDef sd_type_index ps :==
{ sd_symb = ps.ps_selector_name, sd_field_nr = NoIndex, sd_pos = ps.ps_field_pos, sd_type_index = sd_type_index,
sd_exi_vars = [], sd_type_ptr = nilPtr, sd_field = ps.ps_field_name,
......
......@@ -638,11 +638,11 @@ cNotVarNumber :== -1
:: FunctionInfo = FI_Empty | FI_Function !GeneratedFunction
:: Producer = PR_Empty
| PR_Function !SymbIdent !Index
| PR_Function !SymbIdent !Int !Index
| PR_Class !App ![(BoundVar, Type)] !Type
| PR_Constructor !SymbIdent ![Expression]
| PR_GeneratedFunction !SymbIdent !Index
| PR_Curried !SymbIdent
| PR_Constructor !SymbIdent !Int ![Expression]
| PR_GeneratedFunction !SymbIdent !Int !Index
| PR_Curried !SymbIdent !Int
:: InstanceInfo = II_Empty | II_Node !{! Producer} !FunctionInfoPtr !InstanceInfo !InstanceInfo
......@@ -765,7 +765,6 @@ cNotVarNumber :== -1
:: SymbIdent =
{ symb_name :: !Ident
, symb_kind :: !SymbKind
, symb_arity :: !Int