X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=e1c3325d0e2c753ef0948e7d0f0b8fe5152ddd32;hb=a5334443f2d490ae6ada3f332eb04b508ff81648;hp=babd622fda8df41c8c962ccd6737d48eecbb6c49;hpb=ad6bf1a1380ac5cf48d58a7b7969fd45b7b6a49d;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Translator.hs b/Translator.hs
index babd622..e1c3325 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 )
@@ -53,7 +54,7 @@ main =
           let binds = Maybe.mapMaybe (findBind (cm_binds core)) ["sfull_adder"]
           liftIO $ putStr $ prettyShow binds
           -- Turn bind into VHDL
-          let (vhdl, sess) = State.runState (mkVHDL binds) (VHDLSession core 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"
@@ -62,7 +63,7 @@ main =
     -- Turns the given bind into VHDL
     mkVHDL binds = do
       -- Add the builtin functions
-      --mapM (uncurry addFunc) builtin_funcs
+      mapM addBuiltIn builtin_funcs
       -- Create entities and architectures for them
       mapM flattenBind binds
       return $ AST.DesignFile 
@@ -95,7 +96,8 @@ flattenBind bind@(NonRec var expr) = do
   -- Add it to the session
   --addFunc hsfunc hwfunc 
   let flatfunc = flattenFunction hsfunc bind
-  addFunc hsfunc flatfunc
+  addFunc hsfunc
+  setFlatFunc hsfunc flatfunc
   let used_hsfuncs = map appFunc (apps flatfunc)
   State.mapM resolvFunc used_hsfuncs
   return ()
@@ -168,4 +170,22 @@ splitTupleType ty =
         Nothing
     Nothing -> Nothing
 
+-- | A consise representation of a (set of) ports on a builtin function
+type PortMap = HsValueMap (String, AST.TypeMark)
+-- | A consise representation of a builtin function
+data BuiltIn = BuiltIn String [PortMap] PortMap
+
+-- | Translate a concise representation of a builtin function to something
+--   that can be put into FuncMap directly.
+addBuiltIn :: BuiltIn -> VHDLState ()
+addBuiltIn (BuiltIn name args res) = do
+    addFunc hsfunc
+  where
+    hsfunc = HsFunction name (map useAsPort args) (useAsPort res)
+
+builtin_funcs = 
+  [ 
+    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: