X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=a15c9b394ce65f75ee7b7be55d8fc4d7b9399c51;hb=c13ec403850827c4679eb6979476a3876f96a397;hp=6fa043c5e61039a6c52dd82f7920909b3f65c33d;hpb=55dbd3dcc8a8e6b9b5718be9e4da61a8ab031a72;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Translator.hs b/Translator.hs
index 6fa043c..a15c9b3 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -43,24 +43,22 @@ main =
           --load LoadAllTargets
           --core <- GHC.compileToCoreSimplified "Adders.hs"
           core <- GHC.compileToCoreSimplified "Adders.hs"
-          liftIO $ printBinds (cm_binds core)
-          let bind = findBind "full_adder" (cm_binds core)
-          let NonRec var expr = bind
+          --liftIO $ printBinds (cm_binds core)
+          let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["full_adder", "half_adder"]
+          liftIO $ printBinds binds
           -- Turn bind into VHDL
-          let vhdl = State.evalState (mkVHDL bind) (VHDLSession 0 builtin_funcs)
-          liftIO $ putStr $ showSDoc $ ppr expr
-          liftIO $ putStr "\n\n"
-          liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr $ vhdl
-          return expr
+          let vhdl = State.evalState (mkVHDL binds) (VHDLSession 0 builtin_funcs)
+          liftIO $ putStr $ concat $ map (render . ForSyDe.Backend.Ppr.ppr) vhdl
+          return ()
   where
     -- Turns the given bind into VHDL
-    mkVHDL bind = do
-      -- Get the function signature
-      (name, f) <- mkHWFunction bind
-      -- Add it to the session
-      addFunc name f
-      arch <- getArchitecture bind
-      return arch
+    mkVHDL binds = do
+      -- Get the function signatures
+      funcs <- mapM mkHWFunction binds
+      -- Add them to the session
+      mapM (uncurry addFunc) funcs
+      -- Create architectures for them
+      mapM getArchitecture binds
 
 printTarget (Target (TargetFile file (Just x)) obj Nothing) =
   print $ show file
@@ -81,18 +79,18 @@ printBind (Rec binds) = do
 
 printBind' (b, expr) = do
   putStr $ getOccString b
-  --putStr $ showSDoc $ ppr expr
+  putStr $ showSDoc $ ppr expr
   putStr "\n"
 
-findBind :: String -> [CoreBind] -> CoreBind
-findBind lookfor =
+findBind :: [CoreBind] -> String -> Maybe CoreBind
+findBind binds lookfor =
   -- This ignores Recs and compares the name of the bind with lookfor,
   -- disregarding any namespaces in OccName and extra attributes in Name and
   -- Var.
-  Maybe.fromJust . find (\b -> case b of 
+  find (\b -> case b of 
     Rec l -> False
     NonRec var _ -> lookfor == (occNameString $ nameOccName $ getName var)
-  )
+  ) binds
 
 getPortMapEntry ::
   SignalNameMap AST.VHDLId  -- The port name to bind to
@@ -227,6 +225,16 @@ expandExpr binds (Var id) =
       (error $ "Argument " ++ getOccString id ++ "is unknown")
       (lookup id binds)
 
+expandExpr binds l@(Let (NonRec b bexpr) expr) = do
+  (signal_decls, statements, arg_signals, res_signals) <- expandExpr binds bexpr
+  let binds' = (b, res_signals) : binds
+  (signal_decls', statements', arg_signals', res_signals') <- expandExpr binds' expr
+  return (
+    signal_decls ++ signal_decls',
+    statements ++ statements',
+    arg_signals',
+    res_signals')
+
 expandExpr binds app@(App _ _) = do
   let ((Var f), args) = collectArgs app
   if isTupleConstructor f