Commit 285a4f20 authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

Several bug fixes:

 - dictionary arguments added properly
 - coercion of function types
parent b3caffdb
......@@ -1537,7 +1537,7 @@ where
checkExpression free_vars (PE_Ident id) e_input e_state e_info cs
= checkIdentExpression cIsNotInExpressionList free_vars id e_input e_state e_info cs
checkExpression free_vars expr e_input e_state e_info cs
= abort "checkExpression (check.icl, line 1433)" <<- expr
= abort "checkExpression (check.icl, line 1433)" // <<- expr
:: LastSelection = LS_Update | LS_Selction | LS_UniqueSelection
......@@ -2128,7 +2128,7 @@ where
= (fun_defs, symbol_table)
get_calls (STE_FunctionOrMacro [x:xs]) = (x,xs)
get_calls ste_kind = abort "get_calls (check.icl)" <<- ste_kind
get_calls ste_kind = abort "get_calls (check.icl)" // <<- ste_kind
checkFunctions :: !Index !Level !Index !Index !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState -> (!*{#FunDef}, !*ExpressionInfo, !*Heaps, !*CheckState)
......@@ -2375,7 +2375,7 @@ where
# ({ste_kind,ste_index}, cs_symbol_table) = readPtr ds_ident.id_info cs.cs_symbol_table
| ste_kind == req_kind
= ({ ds & ds_index = ste_index }, { cs & cs_symbol_table = cs_symbol_table })
# cs_error = checkError "definition module" ("conflicting definition in implementation module"->>("ste_kind",ste_kind,ptrToInt ds_ident.id_info))
# cs_error = checkError "definition module" "conflicting definition in implementation module"
(setErrorAdmin (newPosition ds_ident pos) cs.cs_error)
= ({ ds & ds_index = ste_index }, { cs & cs_error = cs_error, cs_symbol_table = cs_symbol_table })
......
......@@ -50,7 +50,7 @@ where
# ((let_binds,let_expr), ci) = convertCases (addLetVars let_binds let_type bound_vars) group_index common_defs (let_binds,let_expr) ci
-> ({ lad & let_binds = let_binds, let_expr = let_expr }, ci)
_
-> abort "convertCases [Let] (convertcases 53)" <<- let_info
-> abort "convertCases [Let] (convertcases 53)" // <<- let_info
addLetVars [{bind_dst} : binds] [bind_type : bind_types] bound_vars
= addLetVars binds bind_types [ (bind_dst, bind_type) : bound_vars ]
......@@ -760,7 +760,7 @@ where
{ cp_info & cp_free_vars = [ (var_info_ptr, type) : cp_info.cp_free_vars ],
cp_var_heap = cp_var_heap <:= (var_info_ptr, VI_FreeVar var_name new_info_ptr 1 type) })
_
-> abort "copy [BoundVar] (convertcases, 612)" <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
-> abort "copy [BoundVar] (convertcases, 612)" // <<- (var_info ---> (var_name, ptrToInt var_info_ptr))
instance copy Expression
where
......@@ -1274,9 +1274,8 @@ where
# (let_info, di_expr_heap) = readPtr let_info_ptr di_expr_heap
ok = case let_info of
EI_LetTypeAndRefCounts let_type ref_counts -> True
x -> abort ("abort [distributeLets (EI_LetTypeAndRefCounts)]" ->> x)
x -> abort ("abort [distributeLets (EI_LetTypeAndRefCounts)]") // ->> x)
| ok
// ---> ("distributeLets", ptrToInt let_info_ptr, [ x.bind_dst \\ x <- let_binds])
# (EI_LetTypeAndRefCounts let_type ref_counts) = let_info
di_var_heap = set_let_expression_info depth let_strict let_binds ref_counts let_type di_var_heap
(let_expr, dl_info) = distributeLets depth let_expr { dl_info & di_var_heap = di_var_heap, di_expr_heap = di_expr_heap }
......
This diff is collapsed.
......@@ -471,6 +471,7 @@ cIsALocalVar :== False
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
VI_ClassVar !Ident !VarInfoPtr !Int /* used to hold dictionary variables during overloading */ |
VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr |
VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int |
VI_Used | /* for indicating that an imported function has been used */
......@@ -601,7 +602,8 @@ cNonRecursiveAppl :== False
| EI_Overloaded !OverloadedCall /* initial, set by the type checker */
| EI_Instance !(Global DefinedSymbol) ![Expression] /* intermedediate, used during resolving of overloading */
| EI_Selection ![Selection] !BoundVar ![Expression] /* intermedediate, used during resolving of overloading */
// | EI_Selection ![Selection] !BoundVar ![Expression] /* intermedediate, used during resolving of overloading */
| EI_Selection ![Selection] !VarInfoPtr ![Expression] /* intermedediate, used during resolving of overloading */
| EI_Context ![Expression] /* intermedediate, used during resolving of overloading */
/* For handling dynamics */
......@@ -983,8 +985,6 @@ cIsNotStrict :== False
| (@) infixl 9 !Expression ![Expression]
| Let !Let
| Case !Case
// | RecordSelect !SelectorKind !(Global DefinedSymbol) !Int !Expression
// | ArraySelect !SelectorKind !ArraySelector !Expression !Expression
| Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection]
| Update !Expression ![Selection] Expression
| RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)]
......@@ -999,7 +999,8 @@ cIsNotStrict :== False
| MatchExpr !(Optional (Global DefinedSymbol)) !(Global DefinedSymbol) !Expression
| FreeVar FreeVar
| Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */
| Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */
| ClassVariable !VarInfoPtr /* auxiliary clause used during overloading */
| DynamicExpr !DynamicExpr
// | TypeCase !TypeCase
......
......@@ -427,6 +427,7 @@ cIsALocalVar :== False
VI_Alias !BoundVar /* used for resolving aliases just before type checking (in transform) */ |
/* used during elimination and lifting of cases */
VI_FreeVar !Ident !VarInfoPtr !Int !AType | VI_BoundVar !AType | VI_LocalVar |
VI_ClassVar !Ident !VarInfoPtr !Int /* used to hold dictionary variables during overloading */ |
VI_Forward !BoundVar | VI_LetVar !LetVarInfo | VI_LetExpression !LetExpressionInfo | VI_CaseVar !VarInfoPtr |
VI_CorrespondenceNumber !Int | VI_SequenceNumber !Int |
VI_Used | /* for indicating that an imported function has been used */
......@@ -547,7 +548,7 @@ cNotVarNumber :== -1
| EI_Overloaded !OverloadedCall /* initial, set by the type checker */
| EI_Instance !(Global DefinedSymbol) ![Expression] /* intermedediate, used during resolving of overloading */
| EI_Selection ![Selection] !BoundVar ![Expression] /* intermedediate, used during resolving of overloading */
| EI_Selection ![Selection] !VarInfoPtr ![Expression] /* intermedediate, used during resolving of overloading */
| EI_Context ![Expression] /* intermedediate, used during resolving of overloading */
/* For handling dynamics */
......@@ -936,7 +937,8 @@ cIsNotStrict :== False
| MatchExpr !(Optional (Global DefinedSymbol)) !(Global DefinedSymbol) !Expression
| FreeVar FreeVar
| Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */
| Constant !SymbIdent !Int !Priority !Bool /* auxiliary clause used during checking */
| ClassVariable !VarInfoPtr /* auxiliary clause used during overloading */
| DynamicExpr !DynamicExpr
// | TypeCase !TypeCase
......@@ -1375,7 +1377,9 @@ where
(<<<) file (AnyCodeExpr input output code_sequence) = file <<< "code\n" <<< input <<< "\n" <<< output <<< "\n" <<< code_sequence
(<<<) file (FreeVar {fv_name}) = file <<< "FREEVAR " <<< fv_name
(<<<) file expr = abort ("<<< (Expression) [line 1290]" <<- expr)
(<<<) file (ClassVariable _) = file <<< "ClassVariable "
(<<<) file expr = abort ("<<< (Expression) [line 1290]" )//<<- expr)
instance <<< TypeCase
where
......
......@@ -207,7 +207,7 @@ where
ai_cur_ref_counts = { ai_cur_ref_counts & [arg_position]=min (ref_count+1) 2 }
= (temp_var, False, { ai & ai_cur_ref_counts=ai_cur_ref_counts })
continuation var_info ai=:{ai_cur_ref_counts}
= abort ("consumerRequirements" ---> (var_name <<- var_info))
= abort ("consumerRequirements" ---> (var_name))// <<- var_info))
// continuation vi ai
// = (cPassive, ai)
......@@ -280,7 +280,7 @@ instance consumerRequirements Expression where
consumerRequirements EE _ ai
= (cPassive, False, ai)
consumerRequirements expr _ ai
= abort ("consumerRequirements " <<- expr)
= abort ("consumerRequirements ") // <<- expr)
requirementsOfSelectors selectors common_defs ai
= foldSt (reqs_of_selector common_defs) selectors ai
......
......@@ -1373,7 +1373,7 @@ where
-> (var, [{fv_name = var_name, fv_info_ptr = var_info_ptr, fv_def_level = NotALevel, fv_count = 0} : free_vars ],
{ cos & cos_var_heap = writePtr var_info_ptr (VI_Count 1 is_global) cos.cos_var_heap })
_
-> abort "collectVariables [BoundVar] (transform, 1227)" <<- (var_info ---> var_name)
-> abort "collectVariables [BoundVar] (transform, 1227)" // <<- (var_info ---> var_name)
// XXX
instance <<< FreeVar
......
implementation module typesupport
import StdEnv, StdCompare
import syntax, parse, check, unitype, utilities, RWSDebug
import syntax, parse, check, unitype, utilities // , RWSDebug
// MW: this switch is used to en(dis)able the fusion algorithm
SwitchFusion fuse dont_fuse :== dont_fuse
......@@ -799,7 +799,7 @@ where
= file <<< '*'
| isNonUniqueAttribute av_number coercions
= file
= file <<< '.'
= file <<< '.' <<< "[[" <<< av_number <<< "]]"
instance <:: Type
where
......
......@@ -2,7 +2,7 @@ implementation module unitype
import StdEnv
import syntax, analunitypes, type, utilities
import syntax, analunitypes, type, utilities // , RWSDebug
import cheat
......@@ -64,6 +64,16 @@ determineAttributeCoercions off_type dem_type coercible position subst coercions
No
-> (subst, crc_coercions, crc_td_infos, crc_type_heaps, error)
/*
No
# (crc_coercions, copy_crc_coercions) = uniqueCopy crc_coercions
format = { form_properties = cMarkAttribute, form_attr_position = Yes ([], copy_crc_coercions) }
| file_to_true (stderr <:: (format, exp_off_type) <:: (format, exp_dem_type) <<< '\n')
---> ("determineAttributeCoercions", exp_off_type, exp_dem_type)
-> (subst, crc_coercions, crc_td_infos, crc_type_heaps, error)
-> undef
*/
NotChecked :== -1
DummyAttrNumber :== -1
:: AttributeGroups :== {! [Int]}
......@@ -525,6 +535,7 @@ makeNonUnique attr {coer_demanded, coer_offered}
# (dem_coercions, coer_demanded) = replace coer_demanded attr CT_Empty
coer_offered = { coer_offered & [attr] = CT_NonUnique }
= make_non_unique dem_coercions {coer_offered = coer_offered, coer_demanded = coer_demanded}
// ---> ("makeNonUnique", attr)
where
make_non_unique (CT_Node this_attr ct_less ct_greater) coercions
# coercions = makeNonUnique this_attr coercions
......@@ -549,8 +560,8 @@ Success (Yes _) = False
instance coerce AType
where
coerce sign defs cons_vars tpos at1=:{at_attribute=attr1,at_type=type1} at2=:{at_attribute=attr2,at_type=type2} cs=:{crc_coercions}
# sign = adjust_sign sign type1 cons_vars
(succ, crc_coercions) = coerceAttributes attr1 attr2 sign crc_coercions
# attr_sign = adjust_sign sign type1 cons_vars
(succ, crc_coercions) = coerceAttributes attr1 attr2 attr_sign crc_coercions
| succ
# (succ, cs) = coerce sign defs cons_vars tpos type1 type2 { cs & crc_coercions = crc_coercions }
| Success succ
......@@ -651,7 +662,8 @@ where
= coerce sign defs cons_vars tpos dem_type off_type { cs & crc_type_heaps = crc_type_heaps, crc_td_infos = crc_td_infos }
= (No, { cs & crc_type_heaps = crc_type_heaps, crc_td_infos = crc_td_infos })
coerce sign defs cons_vars tpos (arg_type1 --> res_type1) (arg_type2 --> res_type2) cs
# (succ, cs) = coerce (NegativeSign * sign) defs cons_vars [0 : tpos] arg_type1 arg_type2 cs
# arg_sign = NegativeSign * sign
# (succ, cs) = coerce arg_sign defs cons_vars [0 : tpos] arg_type1 arg_type2 cs
| Success succ
= coerce sign defs cons_vars [1 : tpos] res_type1 res_type2 cs
= (succ, cs)
......@@ -731,4 +743,12 @@ where
| del_char == ident.[del_pos]
= del_pos
= find_delimiter del_char (inc del_pos) ident
file_to_true :: !File -> Bool
file_to_true file = code {
.inline file_to_true
pop_b 2
pushB TRUE
.end
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment