Merge branch 'cλash' of http://git.stderr.nl/matthijs/projects/master-project
authorChristiaan Baaij <christiaan.baaij@gmail.com>
Tue, 23 Jun 2009 10:24:25 +0000 (12:24 +0200)
committerChristiaan Baaij <christiaan.baaij@gmail.com>
Tue, 23 Jun 2009 10:24:25 +0000 (12:24 +0200)
* 'cλash' of http://git.stderr.nl/matthijs/projects/master-project:
  Don't generate a signal for the output port.
  Perform subsititutions one after another.

NormalizeTools.hs
VHDL.hs

index 25c9273d8fb38ef4810f6207925aa8e109251e73..14e3faca07543f497da404cd8e5cb317c7e6d099 100644 (file)
@@ -7,6 +7,7 @@ module NormalizeTools where
 import Debug.Trace
 import qualified List
 import qualified Data.Monoid as Monoid
+import qualified Control.Arrow as Arrow
 import qualified Control.Monad as Monad
 import qualified Control.Monad.Trans.State as State
 import qualified Control.Monad.Trans.Writer as Writer
@@ -202,8 +203,21 @@ mkUnique = Trans.lift $ do
 -- Replace each of the binders given with the coresponding expressions in the
 -- given expression.
 substitute :: [(CoreBndr, CoreExpr)] -> CoreExpr -> CoreExpr
-substitute replace expr = CoreSubst.substExpr subs expr
-    where subs = foldl (\s (b, e) -> CoreSubst.extendSubst s b e) CoreSubst.emptySubst replace
+substitute [] expr = expr
+-- Apply one substitution on the expression, but also on any remaining
+-- substitutions. This seems to be the only way to handle substitutions like
+-- [(b, c), (a, b)]. This means we reuse a substitution, which is not allowed
+-- according to CoreSubst documentation (but it doesn't seem to be a problem).
+-- TODO: Find out how this works, exactly.
+substitute ((b, e):subss) expr = substitute subss' expr'
+  where 
+    -- Create the Subst
+    subs = (CoreSubst.extendSubst CoreSubst.emptySubst b e)
+    -- Apply this substitution to the main expression
+    expr' = CoreSubst.substExpr subs expr
+    -- Apply this substitution on all the expressions in the remaining
+    -- substitutions
+    subss' = map (Arrow.second (CoreSubst.substExpr subs)) subss
 
 -- Run a given TransformSession. Used mostly to setup the right calls and
 -- an initial state.
diff --git a/VHDL.hs b/VHDL.hs
index ec6e5833490f4080507f9e6908d114964a3c2bdf..84e4e379eabc6dce461728272a96ae0c41056d41 100644 (file)
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -199,10 +199,12 @@ createArchitecture (fname, expr) = do
   -- Strip off lambda's, these will be arguments
   let (args, letexpr) = CoreSyn.collectBinders expr
   -- There must be a let at top level 
-  let (CoreSyn.Let (CoreSyn.Rec binds) res) = letexpr
+  let (CoreSyn.Let (CoreSyn.Rec binds) (Var res)) = letexpr
 
-  -- Create signal declarations for all internal and state signals
-  sig_dec_maybes <- mapM (mkSigDec' . fst) binds
+  -- Create signal declarations for all binders in the let expression, except
+  -- for the output port (that will already have an output port declared in
+  -- the entity).
+  sig_dec_maybes <- mapM (mkSigDec' . fst) (filter ((/=res).fst) binds)
   let sig_decs = Maybe.catMaybes $ sig_dec_maybes
 
   statements <- Monad.mapM mkConcSm binds