suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use AbbrevMode to track whether things are abbreviated, and thus generate C

Browse Source
This commit is contained in:
Adam Sampson 2007-04-10 22:12:53 +00:00
parent 8d3f8153eb
commit 6085cae11f
5 changed files with 156 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
fco2/AST.hs
View File

@ -171,7 +171,8 @@ data InputMode =
deriving (Show, Eq, Typeable, Data)
data AbbrevMode =
Abbrev
Original
| Abbrev
| ValAbbrev
deriving (Show, Eq, Typeable, Data)
@ -198,8 +199,9 @@ data Formal =
deriving (Show, Eq, Typeable, Data)
data Actual =
ActualExpression Expression
ActualVariable Variable
| ActualChannel Channel
| ActualExpression Expression
deriving (Show, Eq, Typeable, Data)
data ValueProcess =

150
fco2/GenerateC.hs
View File

@ -1,23 +1,26 @@
-- | Generate C++ code from the mangled AST.
-- | Generate C code from the mangled AST.
module GenerateC where
-- FIXME: Use AbbrevMode to track whether something is an abbreviation at all
-- (and hence make it a pointer or not -- so we can go to C proper).
-- FIXME: Use Structured for Par and Seq (and ValOf, etc.). This would make it
-- easier to put {} around sets of declarations.
-- FIXME: Checks should be done in the parser, not here -- for example, the
-- expressionList production should take an argument with a list of types.
-- FIXME: There should be a pass that pulls PAR branches (that aren't already
-- PROC calls) out into PROCs.
-- FIXME: Arrays. Should be a struct that contains the data and size, and we
-- then use a pointer to the struct to pass around.
-- FIXME: The show instance for types should produce occam-looking types.
-- FIXME: Should have a "current type context" in the parser, so that
-- VAL BYTE b IS 4: works correctly.
-- FIXME: Tock would be a good name for this (Translator from occam to C from Kent).
-- FIXME: Should have a pass that converts functions to procs, and calls to a
-- call outside the enclosing process (which can be found by a generic pass
-- over the tree).
import Data.List
import Data.Maybe
import Control.Monad.Writer
@ -59,6 +62,10 @@ withPS :: (ParseState -> a) -> CGen a
withPS f
= do st <- get
return $ f st
checkJust :: Maybe t -> CGen t
checkJust (Just v) = return v
checkJust Nothing = fail "checkJust failed"
--}}}
--{{{ names
@ -91,10 +98,23 @@ genType (A.Chan t)
genType t = missing $ "genType " ++ show t
--}}}
--{{{ abbreviations
genConst :: A.AbbrevMode -> CGen ()
genConst A.Abbrev = return ()
genConst A.ValAbbrev = tell ["const "]
--{{{ declarations
genDeclType :: A.AbbrevMode -> A.Type -> CGen ()
genDeclType am t
= do case am of
A.ValAbbrev -> tell ["const "]
_ -> return ()
genType t
case (am, t) of
(_, A.Chan _) -> return ()
(A.Abbrev, _) -> tell ["*"]
_ -> return ()
genDecl :: A.AbbrevMode -> A.Type -> A.Name -> CGen ()
genDecl am t n
= do genDeclType am t
tell [" "]
genName n
--}}}
--{{{ conversions
@ -153,12 +173,41 @@ convStringStar c = [c]
--}}}
--{{{ channels, variables
{-
FIXME All this stuff will change once we do arrays properly...
Channel c; -> &c \ Original
Channel c[10]; -> &c[i] /
Channel *c; -> c \ Abbrev
Channel **c; -> c[i] /
-}
genChannel :: A.Channel -> CGen ()
genChannel (A.Channel m n) = genName n
genChannel (A.Channel m n)
= do ps <- get
am <- checkJust $ abbrevModeOfName ps n
case am of
A.Original -> tell ["&"]
A.Abbrev -> return ()
genName n
genChannel (A.SubscriptedChannel m s c) = genSubscript s (genChannel c)
{-
int x; -> x \ Original, ValAbbrev
int x[10]; -> x[i] /
int *x; -> (*x) \ Abbrev
int **x; -> (*x)[i] /
-}
genVariable :: A.Variable -> CGen ()
genVariable (A.Variable m n) = genName n
genVariable (A.Variable m n)
= do ps <- get
am <- checkJust $ abbrevModeOfName ps n
case am of
A.Abbrev -> tell ["(*"]
_ -> return ()
genName n
case am of
A.Abbrev -> tell [")"]
_ -> return ()
genVariable (A.SubscriptedVariable m s v) = genSubscript s (genVariable v)
--}}}
@ -249,7 +298,7 @@ genInputItem c (A.InCounted m cv av)
missing "genInputItem counted"
genInputItem c (A.InVariable m v)
= do ps <- get
let t = fromJust $ typeOfVariable ps v
t <- checkJust $ typeOfVariable ps v
case t of
A.Int ->
do tell ["ChanInInt ("]
@ -273,7 +322,7 @@ genOutputItem c (A.OutCounted m ce ae)
genOutputItem c (A.OutExpression m e)
= do n <- makeNonce "output_item"
ps <- get
let t = fromJust $ typeOfExpression ps e
t <- checkJust $ typeOfExpression ps e
case t of
A.Int ->
do tell ["ChanOutInt ("]
@ -333,49 +382,43 @@ genSpec spec body
body
removeSpec spec
-- FIXME This needs to be rather smarter than it is -- in particular,
-- when declaring arrays of things (like channels) it needs to make sure
-- they're initialised. Probably split into declare/init parts so that
-- it can just recurse sensibly.
introduceSpec :: A.Specification -> CGen ()
introduceSpec (n, A.Declaration m A.Timer) = return ()
introduceSpec (n, A.Declaration m t)
= do case t of
A.Chan _ ->
do cn <- makeNonce "channel"
tell ["Channel ", cn, ";\n"]
tell ["ChanInit (&", cn, ");\n"]
tell ["Channel *"]
genName n
tell [" = &", cn, ";\n"]
_ ->
do genType t
tell [" "]
genName n
tell [";\n"]
= case t of
A.Timer -> return ()
A.Chan _ ->
do tell ["Channel "]
genName n
tell [";\n"]
tell ["ChanInit (&"]
genName n
tell [");\n"]
_ ->
do genDeclType A.Original t
tell [" "]
genName n
tell [";\n"]
introduceSpec (n, A.Is m am t v)
= do genConst am
genType t
tell ["& "]
genName n
tell [" = "]
= do genDecl am t n
tell [" = &"]
genVariable v
tell [";\n"]
introduceSpec (n, A.IsExpr m am t e)
= do genConst am
genType t
tell [" "]
genName n
= do genDecl am t n
tell [" = "]
genExpression e
tell [";\n"]
introduceSpec (n, A.IsChannel m t c)
= do genType t
tell [" "]
genName n
= do genDecl A.Abbrev t n
tell [" = "]
genChannel c
tell [";\n"]
introduceSpec (n, A.IsChannelArray m t cs)
= do genType t
tell [" "]
genName n
= do genDecl A.Abbrev t n
tell [" = {"]
sequence_ $ intersperse genComma (map genChannel cs)
tell ["};\n"]
@ -401,6 +444,9 @@ genActuals as = sequence_ $ intersperse genComma (map genActual as)
genActual :: A.Actual -> CGen ()
genActual (A.ActualExpression e) = genExpression e
genActual (A.ActualChannel c) = genChannel c
genActual (A.ActualVariable v)
= do tell ["&"]
genVariable v
genFormals :: [A.Formal] -> CGen ()
genFormals fs = sequence_ $ intersperse genComma (map genFormal fs)
@ -408,14 +454,8 @@ genFormals fs = sequence_ $ intersperse genComma (map genFormal fs)
-- Arrays must be handled specially
genFormal :: A.Formal -> CGen ()
genFormal (A.Formal am t n)
= do case am of
A.ValAbbrev ->
do genConst am
genType t
tell [" "]
A.Abbrev ->
do genType t
tell ["& "]
= do genDeclType am t
tell [" "]
genName n
--}}}
@ -459,8 +499,8 @@ genAssign vs el
do tell ["{\n"]
ns <- mapM (\_ -> makeNonce "assign_tmp") vs
mapM (\(v, n, e) -> do st <- get
let t = typeOfVariable st v
genType (fromJust t)
t <- checkJust $ typeOfVariable st v
genType t
tell [" ", n, " = "]
genExpression e
tell [";\n"])
@ -473,7 +513,7 @@ genAssign vs el
genInput :: A.Channel -> A.InputMode -> CGen ()
genInput c im
= do ps <- get
let t = fromJust $ typeOfChannel ps c
t <- checkJust $ typeOfChannel ps c
case t of
A.Timer -> case im of
A.InputSimple m [A.InVariable m' v] -> genTimerRead v

45
fco2/Parse.hs
View File

@ -266,7 +266,7 @@ handleSpecs specs inner specMarker
mapM scopeOutSpec ss'
return $ foldl (\e s -> specMarker m s e) v ss'
-- Like sepBy1, but not eager: it won't consume the separator unless it finds
-- | Like sepBy1, but not eager: it won't consume the separator unless it finds
-- another item after it.
sepBy1NE :: OccParser a -> OccParser b -> OccParser [a]
sepBy1NE item sep
@ -275,6 +275,20 @@ sepBy1NE item sep
sepBy1NE item sep)
return $ i : rest
-- | Run several different parsers with a separator between them.
-- If you give it [a, b, c] and s, it'll parse [a, s, b, s, c] then
-- give you back the results from [a, b, c].
intersperseP :: [OccParser a] -> OccParser b -> OccParser [a]
intersperseP [] _ = return []
intersperseP [f] _
= do a <- f
return [a]
intersperseP (f:fs) sep
= do a <- f
sep
as <- intersperseP fs sep
return $ a : as
tryTrail :: OccParser a -> OccParser b -> OccParser a
tryTrail p q = try (do { v <- p; q; return v })
@ -296,7 +310,7 @@ checkMaybe msg op
Just t -> return t
Nothing -> fail msg
pTypeOf :: (ParseState -> a -> Maybe A.Type) -> a -> OccParser A.Type
pTypeOf :: (ParseState -> a -> Maybe b) -> a -> OccParser b
pTypeOf f item
= do st <- getState
case f st item of
@ -306,6 +320,7 @@ pTypeOf f item
pTypeOfVariable = pTypeOf typeOfVariable
pTypeOfChannel = pTypeOf typeOfChannel
pTypeOfExpression = pTypeOf typeOfExpression
pSpecTypeOfName = pTypeOf specTypeOfName
--}}}
--{{{ name scoping
@ -1170,14 +1185,28 @@ guard
--{{{ PROC calls
procInstance :: OccParser A.Process
procInstance
= do { m <- md; n <- tryTrail procName sLeftR; as <- sepBy actual sComma; sRightR; eol; return $ A.ProcCall m n as }
= do m <- md
n <- tryTrail procName sLeftR
st <- pSpecTypeOfName n
let fs = case st of A.Proc _ fs _ -> fs
as <- actuals fs
sRightR
eol
return $ A.ProcCall m n as
<?> "procInstance"
actual :: OccParser A.Actual
actual
= try (do { e <- expression; return $ A.ActualExpression e })
<|> try (do { c <- channel; return $ A.ActualChannel c })
<?> "actual"
actuals :: [A.Formal] -> OccParser [A.Actual]
actuals fs = intersperseP (map actual fs) sComma
actual :: A.Formal -> OccParser A.Actual
actual (A.Formal am t n)
= do case am of
A.ValAbbrev -> do { e <- expression; et <- pTypeOfExpression e; matchType t et; return $ A.ActualExpression e } <?> "actual expression for " ++ an
_ -> case t of
A.Chan _ -> do { c <- channel; ct <- pTypeOfChannel c; matchType t ct; return $ A.ActualChannel c } <?> "actual channel for " ++ an
_ -> do { v <- variable; vt <- pTypeOfVariable v; matchType t vt; return $ A.ActualVariable v } <?> "actual variable for " ++ an
where
an = A.nameName n
--}}}
--}}}
--{{{ top-level forms

17
fco2/Types.hs
View File

@ -1,18 +1,13 @@
-- | Type inference and checking.
module Types where
import Control.Monad
import qualified AST as A
import ParseState
-- I'm pretty sure this is in the standard library, but I can't find it!
perhapsM :: Maybe a -> (a -> Maybe b) -> Maybe b
perhapsM m f
= case m of
Just v -> f v
_ -> Nothing
perhaps :: Maybe a -> (a -> b) -> Maybe b
perhaps m f = m `perhapsM` (Just . f)
perhaps m f = m >>= (Just . f)
-- FIXME: Eww, this shouldn't be necessary -- the lookups should really work on
-- Strings.
@ -30,6 +25,10 @@ specTypeOfName :: ParseState -> A.Name -> Maybe A.SpecType
specTypeOfName ps n
= (psLookupName ps n) `perhaps` A.ndType
abbrevModeOfName :: ParseState -> A.Name -> Maybe A.AbbrevMode
abbrevModeOfName ps n
= (psLookupName ps n) `perhaps` A.ndAbbrevMode
typeOfName :: ParseState -> A.Name -> Maybe A.Type
typeOfName ps n
= case specTypeOfName ps n of
@ -108,5 +107,5 @@ abbrevModeOfSpec s
A.IsChannelArray _ _ _ -> A.Abbrev
A.Retypes _ am _ _ -> am
A.RetypesExpr _ am _ _ -> am
_ -> A.ValAbbrev
_ -> A.Original

12
fco2/testcases/actuals.occ Normal file
View File

@ -0,0 +1,12 @@
-- FIXME This should check arrays too.
PROC O (VAL INT val1, val2, INT abbr, CHAN OF INT channel)
SKIP
:
PROC P (VAL INT val1, val2, INT abbr, CHAN OF INT channel)
O (val1, val2, abbr, channel)
:
PROC Q ()
INT x, y:
CHAN OF INT c:
P (42, x, y, c)
: