Merge branch 'master' of http://github.com/niswegmann/copilot-c99

.gitignore

@@ -0,0 +1,2 @@
+dist
+*~

src/Copilot/Compile/C99/C2A.hs

@@ -2,8 +2,7 @@
 -- Copyright © 2011 National Institute of Aerospace / Galois, Inc.
 --------------------------------------------------------------------------------
 
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE ExistentialQuantification, Rank2Types #-}
 
 module Copilot.Compile.C99.C2A
   ( c2aExpr
@@ -96,6 +95,7 @@ instance C.Expr C2AExpr where
   ----------------------------------------------------
 
   local t1 _ name e1 e2 = C2AExpr $ \ env meta ->
+
     let
       e1'  = c2aExpr_ e1 env meta
       env' = M.insert name (Local e1' t1) env
@@ -105,6 +105,7 @@ instance C.Expr C2AExpr where
   ----------------------------------------------------
 
   var t1 name = C2AExpr $ \ env _ ->
+
     let
       Just local = M.lookup name env
     in
@@ -126,6 +127,40 @@ instance C.Expr C2AExpr where
 
     (A.value . A.var' name . c2aType) t
 
+  ----------------------------------------------------
+
+  externFun t name _ = C2AExpr $ \ _ meta ->
+
+    let
+      Just extFunInfo = M.lookup name (externFunInfoMap meta)
+    in
+      externFun1 t extFunInfo
+
+    where
+
+    externFun1 t1
+      ExternFunInfo
+        { externFunInfoVar  = var
+        , externFunInfoType = t2
+        } =
+      let
+        Just p = t2 =~= t1
+      in
+        case W.exprInst t2 of
+          W.ExprInst ->
+            coerce (cong p) (A.value var)
+
+  ----------------------------------------------------
+
+  externArray t1 t2 name e1 = C2AExpr $ \ env meta ->
+
+    case ( W.integralEInst t1, W.exprInst t2 ) of
+         ( W.IntegralEInst   , W.ExprInst    ) ->
+            let
+              arr = A.array' name (c2aType t2)
+              idx = c2aExpr_ e1 env meta
+            in
+              arr A.!. idx
 
   ----------------------------------------------------
 
@@ -170,7 +205,6 @@ instance C.Op1 C2AOp1 where
   acosh t = C2AOp1 $ case W.floatingEInst   t of W.FloatingEInst   -> acosh
   bwNot t = C2AOp1 $ case W.bitsEInst       t of W.BitsEInst       -> (A.complement)
 
-
 instance C.Op2 C2AOp2 where
   and     = C2AOp2                                                    (A.&&.)
   or      = C2AOp2                                                    (A.||.)
@@ -194,5 +228,3 @@ instance C.Op2 C2AOp2 where
 
 instance C.Op3 C2AOp3 where
   mux t   = C2AOp3 $ case W.exprInst        t of W.ExprInst        -> A.mux
-
---------------------------------------------------------------------------------------------------------------------------------------------------------------

src/Copilot/Compile/C99/MetaTable.hs

@@ -7,8 +7,10 @@
 module Copilot.Compile.C99.MetaTable
   ( StreamInfo (..)
   , ExternInfo (..)
+  , ExternFunInfo (..)
   , StreamInfoMap
   , ExternInfoMap
+  , ExternFunInfoMap
   , MetaTable (..)
   , allocMetaTable
   ) where
@@ -43,9 +45,19 @@ type ExternInfoMap = Map C.Name ExternInfo
 
 --------------------------------------------------------------------------------
 
+data ExternFunInfo = forall a . ExternFunInfo
+  { externFunInfoArgs :: [(C.UType, C.UExpr)]
+  , externFunInfoVar  :: A.V a
+  , externFunInfoType :: C.Type a }
+
+type ExternFunInfoMap = Map C.Name ExternFunInfo
+
+--------------------------------------------------------------------------------
+
 data MetaTable = MetaTable
   { streamInfoMap     :: StreamInfoMap
-  , externInfoMap     :: ExternInfoMap }
+  , externInfoMap     :: ExternInfoMap
+  , externFunInfoMap  :: ExternFunInfoMap }
 
 --------------------------------------------------------------------------------
 
@@ -58,7 +70,7 @@ allocMetaTable spec =
     externInfoMap_ <-
       liftM M.fromList $ mapM allocExtern (externals spec)
 
-    return (MetaTable streamInfoMap_ externInfoMap_)
+    return (MetaTable streamInfoMap_ externInfoMap_ undefined)
 
 --------------------------------------------------------------------------------
 
@@ -100,5 +112,3 @@ mkQueueName id = "str" ++ show id
 
 mkTempVarName :: C.Id -> A.Name
 mkTempVarName id = "tmp" ++ show id
-
---------------------------------------------------------------------------------

src/Copilot/Compile/C99/Phases.hs

@@ -25,6 +25,7 @@ import Prelude hiding (id)
 
 data Phase
   = SampleExterns
+  | SampleExternFuns
   | UpdateStates
   | FireTriggers
   | UpdateBuffers
@@ -39,11 +40,12 @@ numberOfPhases = succ (fromEnum (maxBound :: Phase))
 schedulePhases :: MetaTable -> Core.Spec -> Atom ()
 schedulePhases meta spec =
   A.period numberOfPhases $
-    sampleExterns   meta      >>
-    updateStates    meta spec >>
-    fireTriggers    meta spec >>
+    sampleExterns    meta      >>
+--    sampleExternFuns meta spec >>
+    updateStates     meta spec >>
+    fireTriggers     meta spec >>
 --    updateObservers meta spec >>
-    updateBuffers   meta spec
+    updateBuffers    meta spec
 
 --------------------------------------------------------------------------------
 
@@ -63,6 +65,11 @@ sampleExterns =
 
 --------------------------------------------------------------------------------
 
+sampleExternFuns :: MetaTable -> Core.Spec -> Atom ()
+sampleExternFuns = undefined
+
+--------------------------------------------------------------------------------
+
 updateStates :: MetaTable -> Core.Spec -> Atom ()
 updateStates meta
   Core.Spec
@@ -100,33 +107,6 @@ updateStates meta
           Just p <- return (t1 =~= t2)
           tmp <== coerce (cong p) e1
 
-{-
-  updateLet :: Core.Let -> Atom ()
-  updateLet
-    Core.Let
-      { Core.letVar  = name
-      , Core.letExpr = e
-      , Core.letType = t1
-      } =
-    let
-      Just letInfo = M.lookup name (letInfoMap meta)
-    in
-      updateLet1 t1 name (c2aExpr meta e) letInfo
-
-  updateLet1 :: Core.Type a -> Core.Name -> A.E a -> LetInfo -> Atom ()
-  updateLet1 t1 name e1
-    LetInfo
-      { letInfoVar  = v
-      , letInfoType = t2
-      } =
-    exactPhase (fromEnum UpdateStates) $
-      atom ("update_let_" ++ name) $
-        do
-          W.AssignInst <- return (W.assignInst t2)
-          Just p <- return (t1 =~= t2)
-          v <== coerce (cong p) e1
--}
-
 --------------------------------------------------------------------------------
 
 fireTriggers :: MetaTable -> Core.Spec -> Atom ()
@@ -155,8 +135,8 @@ fireTriggers meta
 
       where
 
-      triggerArg2UE :: Core.TriggerArg -> A.UE
-      triggerArg2UE (Core.TriggerArg e t) =
+      triggerArg2UE :: Core.UExpr -> A.UE
+      triggerArg2UE (Core.UExpr t e) =
         case W.exprInst t of
           W.ExprInst -> A.ue (c2aExpr meta e)
 
@@ -196,5 +176,3 @@ updateBuffers meta
         do
           W.AssignInst <- return (W.assignInst t)
           Q.dropFirstElemAndSnoc (A.value tmp) que
-
---------------------------------------------------------------------------------

src/Copilot/Compile/C99/PreCode.hs

@@ -21,7 +21,7 @@ externProto (Extern name t) = "extern " ++ typeSpec t ++ " " ++ name ++ ";"
 
 --------------------------------------------------------------------------------
 
-typeSpec :: Core.Type α -> String
+typeSpec :: Core.Type a -> String
 typeSpec (Core.Bool   _) = "bool"
 typeSpec (Core.Int8   _) = "int8_t"
 typeSpec (Core.Int16  _) = "int16_t"
@@ -34,4 +34,4 @@ typeSpec (Core.Word64 _) = "uint64_t"
 typeSpec (Core.Float  _) = "float"
 typeSpec (Core.Double _) = "double"
 
---------------------------------------------------------------------------------
+--------------------------------------------------------------------------------

src/Copilot/Compile/C99/Test/Driver.hs

@@ -7,7 +7,7 @@ module Copilot.Compile.C99.Test.Driver
   ) where
 
 import Copilot.Core
-  (Spec (..), Trigger (..), TriggerArg (..), Type (..), UType (..), utype)
+  (Spec (..), Trigger (..), UExpr (..), Type (..), UType (..), utype)
 import Data.List (intersperse)
 import Data.Map (Map)
 import qualified Data.Map as M
@@ -72,7 +72,7 @@ ppTrigger
     , string "}"
     ]
 
-ppPrintf :: String -> [TriggerArg] -> Doc
+ppPrintf :: String -> [UExpr] -> Doc
 ppPrintf name args =
   string "printf(\"" <>
   string name <>
@@ -82,13 +82,13 @@ ppPrintf name args =
   ppArgs args <>
   string ")"
 
-ppFormats :: [TriggerArg] -> Doc
+ppFormats :: [UExpr] -> Doc
 ppFormats
   = concatV
   . intersperse (string ",")
   . map ppFormat
 
-ppPars :: [TriggerArg] -> Doc
+ppPars :: [UExpr] -> Doc
 ppPars
   = concatV
   . intersperse (string ", ")
@@ -97,13 +97,13 @@ ppPars
 
   where
 
-  ppPar :: (Int, TriggerArg) -> Doc
+  ppPar :: (Int, UExpr) -> Doc
   ppPar (k, par) = case par of
-    TriggerArg
-      { triggerArgType = t } ->
+    UExpr
+      { uExprType = t } ->
           ppUType (utype t) <+> string ("t" ++ show k)
 
-ppArgs :: [TriggerArg] -> Doc
+ppArgs :: [UExpr] -> Doc
 ppArgs args
   = concatV
   $ intersperse (string ", ")
@@ -125,9 +125,9 @@ ppUType t = string $
     UWord32 -> "uint32_t" ; UWord64 -> "uint64_t"
     UFloat  -> "float"    ; UDouble -> "double"
 
-ppFormat :: TriggerArg -> Doc
+ppFormat :: UExpr -> Doc
 ppFormat
-  TriggerArg { triggerArgType = t } =
+  UExpr { uExprType = t } =
   string $ case t of
     Bool   _ -> "%d"
     Int8   _ -> "%d" ; Int16  _ -> "%d" ; Int32  _ -> "%d" ; Int64  _ -> "%lld"