aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/syntax.dcl2
-rw-r--r--frontend/syntax.icl79
-rw-r--r--frontend/type.icl13
3 files changed, 51 insertions, 43 deletions
diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl
index 066c32d..7d1b086 100644
--- a/frontend/syntax.dcl
+++ b/frontend/syntax.dcl
@@ -1513,7 +1513,7 @@ instance == OverloadedListType
:: CoercionPosition
= CP_Expression !Expression
| CP_FunArg !Ident !Int // Function or constructor ident, argument position (>=1)
- | CP_SymbArg !SymbIdent !Int // Function or constructor symbol, argument position (>=1)
+ | CP_SymbArgAndExpression !SymbIdent !Int !Expression // Function or constructor symbol, argument position (>=1)
| CP_LiftedFunArg !Ident !Ident // Function symbol, lifted argument ident
:: IdentPos =
diff --git a/frontend/syntax.icl b/frontend/syntax.icl
index f0cf4b1..5146852 100644
--- a/frontend/syntax.icl
+++ b/frontend/syntax.icl
@@ -716,7 +716,6 @@ instance <<< ParsedSelector
where
(<<<) file {ps_field_ident,ps_field_type} = file <<< ps_field_ident <<< ps_field_type
-
instance <<< ModuleKind
where
(<<<) file kind = file
@@ -772,7 +771,15 @@ where
instance <<< ExprWithLocalDefs
where
- (<<<) file {ewl_expr,ewl_locals} = file <<< ewl_expr <<< ewl_locals
+ (<<<) file {ewl_expr,ewl_locals,ewl_nodes=[]} = file <<< ewl_expr <<< ewl_locals
+ (<<<) file {ewl_expr,ewl_locals,ewl_nodes} = file <<< ewl_nodes <<< '\n' <<< ewl_expr <<< ewl_locals
+
+instance <<< NodeDefWithLocals
+where
+ (<<<) file {ndwl_strict,ndwl_def,ndwl_locals}
+ | ndwl_strict
+ = file <<< "\n#! " <<< ndwl_def <<< ndwl_locals;
+ = file <<< "\n# " <<< ndwl_def <<< ndwl_locals;
instance <<< GuardedExpr
where
@@ -855,43 +862,43 @@ instance <<< CoercionPosition
where
(<<<) file (CP_FunArg fun_name arg_nr)
= file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name
- (<<<) file (CP_SymbArg fun_name arg_nr)
- = file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name.symb_ident
+ (<<<) file (CP_SymbArgAndExpression fun_name arg_nr expression)
+ = show_expression (file <<< "argument " <<< arg_nr <<< " of " <<< readable fun_name.symb_ident <<< " : ") expression
(<<<) file (CP_LiftedFunArg fun_name arg_name)
= file <<< "lifted argument " <<< arg_name <<< " of " <<< readable fun_name
(<<<) file (CP_Expression expression) = show_expression file expression
- where
- show_expression file (Var {var_ident})
- = file <<< var_ident
- show_expression file (FreeVar {fv_ident})
- = file <<< fv_ident
- show_expression file (App {app_symb={symb_ident}, app_args})
- | symb_ident.id_name=="_dummyForStrictAlias"
- = show_expression file (hd app_args)
- = file <<< readable symb_ident
- show_expression file (fun @ fun_args)
- = show_expression file fun
- show_expression file (Case {case_ident=No})
- = file <<< "(case ... )"
- show_expression file (Selection _ expr selectors)
- = file <<< "selection"
- show_expression file (Update expr1 selectors expr2)
- = file <<< "update"
- show_expression file (TupleSelect {ds_arity} elem_nr expr)
- = file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
- show_expression file (BasicExpr bv)
- = file <<< bv
- show_expression file (RecordUpdate _ _ _)
- = file <<< "update of record"
- show_expression file (MatchExpr _ expr)
- = file <<< "match expression"
- show_expression file (IsConstructor _ _ _ _ _ _)
- = file <<< "is constructor expression"
- show_expression file (Let _)
- = file <<< "(let ... ) or #"
- show_expression file _
- = file
-
+
+show_expression file (Var {var_ident})
+ = file <<< var_ident
+show_expression file (FreeVar {fv_ident})
+ = file <<< fv_ident
+show_expression file (App {app_symb={symb_ident}, app_args})
+ | symb_ident.id_name=="_dummyForStrictAlias"
+ = show_expression file (hd app_args)
+ = file <<< readable symb_ident
+show_expression file (fun @ fun_args)
+ = show_expression file fun
+show_expression file (Case {case_ident=No})
+ = file <<< "(case ... )"
+show_expression file (Selection _ expr selectors)
+ = file <<< "selection"
+show_expression file (Update expr1 selectors expr2)
+ = file <<< "update"
+show_expression file (TupleSelect {ds_arity} elem_nr expr)
+ = file <<< "argument " <<< (elem_nr + 1) <<< " of " <<< ds_arity <<< "-tuple"
+show_expression file (BasicExpr bv)
+ = file <<< bv
+show_expression file (RecordUpdate _ _ _)
+ = file <<< "update of record"
+show_expression file (MatchExpr _ expr)
+ = file <<< "match expression"
+show_expression file (IsConstructor _ _ _ _ _ _)
+ = file <<< "is constructor expression"
+show_expression file (Let _)
+ = file <<< "(let ... ) or #"
+show_expression file _
+ = file
+
instance <<< Declaration
where
(<<<) file (Declaration { decl_ident, decl_kind })
diff --git a/frontend/type.icl b/frontend/type.icl
index c7d3ec3..4491456 100644
--- a/frontend/type.icl
+++ b/frontend/type.icl
@@ -269,17 +269,18 @@ cannot_unify t1 t2 position common_defs err
ea_file = case position of
CP_FunArg _ _
-> ea_file <<< "\"" <<< position <<< "\""
- CP_SymbArg {symb_kind=SK_Constructor {glob_module,glob_object},symb_ident} arg_n
+ CP_SymbArgAndExpression {symb_kind=SK_Constructor {glob_module,glob_object},symb_ident} arg_n expression
#! type_index = common_defs.[glob_module].com_cons_defs.[glob_object].cons_type_index
-> case common_defs.[glob_module].com_type_defs.[type_index].td_rhs of
RecordType {rt_fields}
# field_name = rt_fields.[arg_n-1].fs_ident.id_name
record_name = symb_ident.id_name
record_name = if (record_name.[0]=='_') (record_name % (1,size record_name-1)) record_name
- -> ea_file <<< "\"" <<< "field " <<< field_name <<< " of " <<< record_name <<< "\""
+ -> ea_file <<< "\"" <<< "field " <<< field_name <<< " of " <<< record_name
+ <<< " : " <<< CP_Expression expression <<< "\""
_
-> ea_file <<< "\"" <<< position <<< "\""
- CP_SymbArg _ _
+ CP_SymbArgAndExpression _ _ _
-> ea_file <<< "\"" <<< position <<< "\""
CP_LiftedFunArg _ _
-> ea_file <<< "\"" <<< position <<< "\""
@@ -1630,7 +1631,7 @@ where
= reqs_ts
requirements_of_args ti fun_ident arg_nr [expr:exprs] [lt:lts] reqs_ts
# (e_type, opt_expr_ptr, (reqs, ts)) = requirements ti expr reqs_ts
- #! type_coercion = {tc_demanded = lt, tc_offered = e_type, tc_position = CP_SymbArg fun_ident arg_nr, tc_coercible = True}
+ #! type_coercion = {tc_demanded = lt, tc_offered = e_type, tc_position = CP_SymbArgAndExpression fun_ident arg_nr expr, tc_coercible = True}
# req_type_coercions = [type_coercion : reqs.req_type_coercions]
ts_expr_heap = storeAttribute opt_expr_ptr lt.at_attribute ts.ts_expr_heap
= requirements_of_args ti fun_ident (arg_nr+1) exprs lts ({reqs & req_type_coercions = req_type_coercions}, {ts & ts_expr_heap = ts_expr_heap})
@@ -2675,7 +2676,7 @@ where
| group_index == size comps
= funs_and_state
#! comp = comps.[group_index]
- # funs_and_state = type_component list_inferred_types comp.group_members class_instances ti funs_and_state
+ # funs_and_state = type_component list_inferred_types comp.group_members class_instances ti funs_and_state
= type_components list_inferred_types (inc group_index) comps class_instances ti funs_and_state
/*
show_component comp fun_defs
@@ -2871,7 +2872,7 @@ where
case tc_position of
CP_FunArg _ _
-> ea_file <<< "\"" <<< tc_position <<< "\" "
- CP_SymbArg _ _
+ CP_SymbArgAndExpression _ _ _
-> ea_file <<< "\"" <<< tc_position <<< "\" "
CP_LiftedFunArg _ _
-> ea_file <<< "\"" <<< tc_position <<< "\" "
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-13 17:21:22 +0000