projects
/
matthijs
/
master-project
/
cλash.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge branch 'master' of git://github.com/christiaanb/clash
[matthijs/master-project/cλash.git]
/
clash
/
CLasH
/
Normalize.hs
diff --git
a/clash/CLasH/Normalize.hs
b/clash/CLasH/Normalize.hs
index ea171ca05f7b783a6731845e037a4c7216ee9291..11212f943df0678a4b9cef09fb52657ba06bc2dd 100644
(file)
--- a/
clash/CLasH/Normalize.hs
+++ b/
clash/CLasH/Normalize.hs
@@
-380,7
+380,7
@@
funextract c expr@(App _ _) | is_var fexpr = do
-- We could use is_applicable here instead of is_fun, but I think
-- arguments to functions could only have forall typing when existential
-- typing is enabled. Not sure, though.
-- We could use is_applicable here instead of is_fun, but I think
-- arguments to functions could only have forall typing when existential
-- typing is enabled. Not sure, though.
- doarg arg | not (is_simple arg) && is_fun arg = do
+ doarg arg | not (is_simple arg) && is_fun arg
&& not (has_free_tyvars arg)
= do
-- Create a new top level binding that binds the argument. Its body will
-- be extended with lambda expressions, to take any free variables used
-- by the argument expression.
-- Create a new top level binding that binds the argument. Its body will
-- be extended with lambda expressions, to take any free variables used
-- by the argument expression.
@@
-410,15
+410,14
@@
funextract c expr = return expr
-- Make sure the scrutinee of a case expression is a local variable
-- reference.
scrutsimpl :: Transform
-- Make sure the scrutinee of a case expression is a local variable
-- reference.
scrutsimpl :: Transform
--- Don't touch scrutinees that are already simple
-scrutsimpl c expr@(Case (Var _) _ _ _) = return expr
--- Replace all other cases with a let that binds the scrutinee and a new
+-- Replace a case expression with a let that binds the scrutinee and a new
-- simple scrutinee, but only when the scrutinee is representable (to prevent
-- loops with inlinenonrep, though I don't think a non-representable scrutinee
-- simple scrutinee, but only when the scrutinee is representable (to prevent
-- loops with inlinenonrep, though I don't think a non-representable scrutinee
--- will be supported anyway...)
+-- will be supported anyway...)
and is not a local variable already.
scrutsimpl c expr@(Case scrut b ty alts) = do
repr <- isRepr scrut
scrutsimpl c expr@(Case scrut b ty alts) = do
repr <- isRepr scrut
- if repr
+ local_var <- Trans.lift $ is_local_var scrut
+ if repr && not local_var
then do
id <- Trans.lift $ mkBinderFor scrut "scrut"
change $ Let (NonRec id scrut) (Case (Var id) b ty alts)
then do
id <- Trans.lift $ mkBinderFor scrut "scrut"
change $ Let (NonRec id scrut) (Case (Var id) b ty alts)
@@
-753,7
+752,7
@@
inlinenonrepresult :: Transform
-- that is fully applied (i.e., dos not have a function type) but is not
-- representable. We apply in any context, since non-representable
-- expressions are generally left alone and can occur anywhere.
-- that is fully applied (i.e., dos not have a function type) but is not
-- representable. We apply in any context, since non-representable
-- expressions are generally left alone and can occur anywhere.
-inlinenonrepresult context expr | not (is_
fun
expr) =
+inlinenonrepresult context expr | not (is_
applicable expr) && not (has_free_tyvars
expr) =
case collectArgs expr of
(Var f, args) | not (Id.isDictId f) -> do
repr <- isRepr expr
case collectArgs expr of
(Var f, args) | not (Id.isDictId f) -> do
repr <- isRepr expr
@@
-821,6
+820,10
@@
inlinenonrepresult context expr | not (is_fun expr) =
-- Leave all other expressions unchanged
inlinenonrepresult c expr = return expr
-- Leave all other expressions unchanged
inlinenonrepresult c expr = return expr
+----------------------------------------------------------------
+-- Type-class transformations
+----------------------------------------------------------------
+
--------------------------------
-- ClassOp resolution
--------------------------------
--------------------------------
-- ClassOp resolution
--------------------------------
@@
-952,7
+955,7
@@
letmerge c expr = return expr
-- What transforms to run?
transforms = [ ("inlinedict", inlinedict)
, ("inlinetoplevel", inlinetoplevel)
-- What transforms to run?
transforms = [ ("inlinedict", inlinedict)
, ("inlinetoplevel", inlinetoplevel)
-
--
, ("inlinenonrepresult", inlinenonrepresult)
+ , ("inlinenonrepresult", inlinenonrepresult)
, ("knowncase", knowncase)
, ("classopresolution", classopresolution)
, ("argprop", argprop)
, ("knowncase", knowncase)
, ("classopresolution", classopresolution)
, ("argprop", argprop)