X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=5b58232b9845e52ea950c8c1133b33908d4de7fa;hb=495e75489457be4ea5bfa9692e2b8736047a41ae;hp=defa8cabe7990b7dc8bc8bf2841a88884edeac99;hpb=8325780f83f31cc3520029912d0797704d058d7e;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Translator.hs b/Translator.hs
index defa8ca..5b58232 100644
--- a/Translator.hs
+++ b/Translator.hs
@@ -10,6 +10,7 @@ import qualified Maybe
 import qualified Module
 import qualified Control.Monad.State as State
 import Name
+import qualified Data.Map as Map
 import Data.Generics
 import NameEnv ( lookupNameEnv )
 import HscTypes ( cm_binds, cm_types )
@@ -51,9 +52,9 @@ main =
           core <- GHC.compileToCoreSimplified "Adders.hs"
           --liftIO $ printBinds (cm_binds core)
           let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
-          liftIO $ printBinds binds
+          liftIO $ putStr $ prettyShow binds
           -- Turn bind into VHDL
-          let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession 0 [])
+          let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 0 Map.empty)
           liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr vhdl
           liftIO $ ForSyDe.Backend.VHDL.FileIO.writeDesignFile vhdl "../vhdl/vhdl/output.vhdl"
           liftIO $ putStr $ "\n\nFinal session:\n" ++ prettyShow sess ++ "\n\n"
@@ -69,28 +70,6 @@ main =
         []
         []
 
-printTarget (Target (TargetFile file (Just x)) obj Nothing) =
-  print $ show file
-
-printBinds [] = putStr "done\n\n"
-printBinds (b:bs) = do
-  printBind b
-  putStr "\n"
-  printBinds bs
-
-printBind (NonRec b expr) = do
-  putStr "NonRec: "
-  printBind' (b, expr)
-
-printBind (Rec binds) = do
-  putStr "Rec: \n"  
-  foldl1 (>>) (map printBind' binds)
-
-printBind' (b, expr) = do
-  putStr $ getOccString b
-  putStr $ showSDoc $ ppr expr
-  putStr "\n"
-
 findBind :: [CoreBind] -> String -> Maybe CoreBind
 findBind binds lookfor =
   -- This ignores Recs and compares the name of the bind with lookfor,
@@ -128,8 +107,24 @@ resolvFunc ::
   HsFunction        -- | The function to look for
   -> VHDLState ()
 
-resolvFunc hsfunc =
-  return ()
+resolvFunc hsfunc = do
+  -- See if the function is already known
+  func <- getFunc hsfunc
+  case func of
+    -- Already known, do nothing
+    Just _ -> do
+      return ()
+    -- New function, resolve it
+    Nothing -> do
+      -- Get the current module
+      core <- getModule
+      -- Find the named function
+      let bind = findBind (cm_binds core) name
+      case bind of
+        Nothing -> error $ "Couldn't find function " ++ name ++ " in current module."
+        Just b  -> flattenBind b
+  where
+    name = hsFuncName hsfunc
 
 -- | Translate a top level function declaration to a HsFunction. i.e., which
 --   interface will be provided by this function. This function essentially
@@ -174,4 +169,20 @@ splitTupleType ty =
         Nothing
     Nothing -> Nothing
 
+-- | A consise representation of a (set of) ports on a builtin function
+type PortMap = HsValueMap (String, AST.TypeMark)
+{-
+-- | Translate a concise representation of a builtin function to something
+--   that can be put into FuncMap directly.
+make_builtin :: String -> [PortMap] -> PortMap -> (HsFunction, FuncData)
+make_builtin name args res =
+    (hsfunc, (Nothing))
+  where
+    hsfunc = HsFunction name (map useAsPort args) (useAsPort res)
+
+builtin_funcs = 
+  [ 
+    make_builtin "hwxor" [(Single ("a", VHDL.bit_ty)), (Single ("b", VHDL.bit_ty))] (Single ("o", VHDL.bit_ty))
+  ]
+-}
 -- vim: set ts=8 sw=2 sts=2 expandtab: