Commit dda636ed authored by simonpj's avatar simonpj
Browse files

[project @ 2001-05-09 13:46:29 by simonpj]

Fix bug in spec-constr rule generation [Sergei2]
parent f11dacd8
......@@ -468,18 +468,17 @@ spec_one :: ScEnv
Example
In-scope: a, x::a
f = /\b \y::[(a,b)] -> ....f (b,c) ((:) (a,(b,c)) v (h v))...
[c is presumably bound by the (...) part]
f = /\b \y::[(a,b)] -> ....f (b,c) ((:) (a,(b,c)) (x,v) (h w))...
[c::*, v::(b,c) are presumably bound by the (...) part]
==>
f_spec = /\ b c \ v::(a,(b,c)) ->
(...entire RHS of f...) (b,c) ((:) (a,(b,c)) v (h v))
f_spec = /\ b c \ v::(b,c) hw::[(a,(b,c))] ->
(...entire RHS of f...) (b,c) ((:) (a,(b,c)) (x,v) hw)
RULE: forall b c,
y::[(a,(b,c))],
v::(a,(b,c)),
h::(a,(b,c))->[(a,(b,c))] .
RULE: forall b::* c::*, -- Note, *not* forall a, x
v::(b,c),
hw::[(a,(b,c))] .
f (b,c) ((:) (a,(b,c)) v (h v)) = f_spec b c v
f (b,c) ((:) (a,(b,c)) (x,v) hw) = f_spec b c v hw
-}
spec_one env fn rhs (pats, n)
......@@ -491,14 +490,15 @@ spec_one env fn rhs (pats, n)
pat_fvs = varSetElems (exprsFreeVars pats)
vars_to_bind = filter not_avail pat_fvs
not_avail v = not (v `elemVarEnv` scope env)
-- Put the type variables first just for tidiness
-- Put the type variables first; the type of a term
-- variable may mention a type variable
(tvs, ids) = partition isTyVar vars_to_bind
bndrs = tvs ++ ids
rule_name = _PK_ ("SC:" ++ showSDoc (ppr fn <> int n))
spec_rhs = mkLams bndrs (mkApps rhs pats)
spec_id = mkUserLocal spec_occ spec_uniq (exprType spec_rhs) fn_loc
rule = Rule rule_name pat_fvs pats (mkVarApps (Var spec_id) bndrs)
rule = Rule rule_name bndrs pats (mkVarApps (Var spec_id) bndrs)
in
returnUs (rule, (spec_id, spec_rhs))
\end{code}
......
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