Permalink
Browse files

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

  • Loading branch information...
seni seni
seni authored and seni committed Aug 11, 2011
2 parents cc7a501 + 4ce8b2b commit 3cdb138dab690c2aa086f0f3687ede21ced9a642
View
@@ -0,0 +1,2 @@
+dist
+*~
@@ -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
-
---------------------------------------------------------------------------------------------------------------------------------------------------------------
@@ -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
-
---------------------------------------------------------------------------------
@@ -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
-
---------------------------------------------------------------------------------
@@ -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"
---------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
@@ -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"

0 comments on commit 3cdb138

Please sign in to comment.