Commit 763c68f3 authored by Ronny Wichers Schreur's avatar Ronny Wichers Schreur

don't allow strict #! lets in macro bodies

make top-level cases in macros explicit
parent 59f28016
......@@ -4,7 +4,7 @@ import StdEnv
import syntax, typesupport, parse, checksupport, utilities, checktypes, transform, predef
import explicitimports, comparedefimp, checkFunctionBodies, containers, portToNewSyntax, compilerSwitches
import RWSDebug
// import RWSDebug
cUndef :== (-1)
cDummyArray :== {}
......@@ -790,6 +790,106 @@ ident_for_errors_from_fun_symb_and_fun_kind {id_name} (FK_Function fun_name_is_l
ident_for_errors_from_fun_symb_and_fun_kind fun_symb _
= fun_symb
// check that there are no strict lets, mark top-level cases as explicit
class checkMacro a :: !Bool !a !*ErrorAdmin -> (!a, !*ErrorAdmin)
instance checkMacro [a] | checkMacro a where
checkMacro topLevel l ea
= mapSt (checkMacro topLevel) l ea
instance checkMacro FunctionBody where
checkMacro topLevel (CheckedBody body) ea
# (body, ea)
= checkMacro topLevel body ea
= (CheckedBody body, ea)
instance checkMacro CheckedBody where
checkMacro topLevel body=:{cb_rhs} ea
# (cb_rhs, ea)
= checkMacro topLevel cb_rhs ea
= ({body & cb_rhs = cb_rhs}, ea)
instance checkMacro CheckedAlternative where
checkMacro topLevel alt=:{ca_rhs} ea
# (ca_rhs, ea)
= checkMacro topLevel ca_rhs ea
= ({alt & ca_rhs = ca_rhs}, ea)
instance checkMacro Expression where
checkMacro topLevel (Let lad) ea
# (lad, ea)
= checkMacro topLevel lad ea
= (Let lad, ea)
checkMacro topLevel (Case kees) ea
# (kees, ea)
= checkMacro topLevel kees ea
= (Case kees, ea)
checkMacro _ expr ea
= (expr, ea)
instance checkMacro Let where
checkMacro topLevel lad=:{let_strict_binds, let_expr} ea
# ea
= check_strict_binds let_strict_binds ea
# (let_expr, ea)
= checkMacro topLevel let_expr ea
= ({lad & let_expr = let_expr}, ea)
where
check_strict_binds [] ea
= ea
check_strict_binds _ ea
= checkError "#! not allowed in macros" "" ea
instance checkMacro Case where
checkMacro topLevel kees=:{case_guards, case_explicit} ea
# (case_guards, ea)
= checkMacro False case_guards ea
= ({kees & case_guards = case_guards,case_explicit = topLevel || case_explicit}, ea)
instance checkMacro CasePatterns where
checkMacro topLevel (AlgebraicPatterns type patterns) ea
# (patterns, ea)
= checkMacro topLevel patterns ea
= (AlgebraicPatterns type patterns, ea)
checkMacro topLevel (BasicPatterns type patterns) ea
# (patterns, ea)
= checkMacro topLevel patterns ea
= (BasicPatterns type patterns, ea)
checkMacro topLevel (DynamicPatterns patterns) ea
# (patterns, ea)
= checkMacro topLevel patterns ea
= (DynamicPatterns patterns, ea)
checkMacro topLevel (OverloadedListPatterns type decons patterns) ea
# (patterns, ea)
= checkMacro topLevel patterns ea
= (OverloadedListPatterns type decons patterns, ea)
checkMacro _ NoPattern ea
= (NoPattern, ea)
instance checkMacro AlgebraicPattern where
checkMacro topLevel pattern=:{ap_expr} ea
# (ap_expr, ea)
= checkMacro topLevel ap_expr ea
= ({pattern & ap_expr = ap_expr}, ea)
instance checkMacro BasicPattern where
checkMacro topLevel pattern=:{bp_expr} ea
# (bp_expr, ea)
= checkMacro topLevel bp_expr ea
= ({pattern & bp_expr = bp_expr}, ea)
instance checkMacro DynamicPattern where
checkMacro topLevel pattern=:{dp_rhs} ea
# (dp_rhs, ea)
= checkMacro topLevel dp_rhs ea
= ({pattern & dp_rhs = dp_rhs}, ea)
checkFunctionBodyIfMacro :: !FunKind !FunctionBody !*ErrorAdmin -> (!FunctionBody, !*ErrorAdmin)
checkFunctionBodyIfMacro FK_Macro def ea
= checkMacro True def ea
checkFunctionBodyIfMacro _ def ea
= (def, ea)
checkFunction :: !FunDef !Index !FunctionOrMacroIndex !Level !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!FunDef,!*{#FunDef},!*ExpressionInfo,!*Heaps,!*CheckState);
checkFunction fun_def=:{fun_symb,fun_pos,fun_body,fun_type,fun_kind} mod_index fun_index def_level local_functions_index_offset
......@@ -808,7 +908,8 @@ checkFunction fun_def=:{fun_symb,fun_pos,fun_body,fun_type,fun_kind} mod_index f
# {es_fun_defs,es_calls,es_var_heap,es_expr_heap,es_type_heaps,es_dynamics} = e_state
(ef_type_defs, ef_modules, es_type_heaps, es_expr_heap, cs) =
checkDynamicTypes mod_index es_dynamics fun_type e_info.ef_type_defs e_info.ef_modules es_type_heaps es_expr_heap cs
cs = { cs & cs_error = popErrorAdmin cs.cs_error }
(fun_body, cs_error) = checkFunctionBodyIfMacro fun_kind fun_body cs.cs_error
cs = { cs & cs_error = popErrorAdmin cs_error }
fi_properties = (if ef_is_macro_fun FI_IsMacroFun 0) bitor (has_type fun_type)
fun_info = { fun_def.fun_info & fi_calls = es_calls, fi_def_level = def_level, fi_free_vars = free_vars, fi_dynamics = es_dynamics,
fi_properties = fi_properties }
......
Markdown is supported
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