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

fco2/AST.hs

@@ -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 =

fco2/GenerateC.hs

@@ -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
+--{{{  declarations
-genConst :: A.AbbrevMode -> CGen ()
+genDeclType :: A.AbbrevMode -> A.Type -> CGen ()
-genConst A.Abbrev = return ()
+genDeclType am t
-genConst A.ValAbbrev = tell ["const "]
+    =  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
+    = case t of
+        A.Timer -> return ()
         A.Chan _ ->
-              do cn <- makeNonce "channel"
+          do tell ["Channel "]
-                 tell ["Channel ", cn, ";\n"]
-                 tell ["ChanInit (&", cn, ");\n"]
-                 tell ["Channel *"]
              genName n
-                 tell [" = &", cn, ";\n"]
+             tell [";\n"]
+             tell ["ChanInit (&"]
+             genName n
+             tell [");\n"]
         _ ->
-              do genType t
+          do genDeclType A.Original t
              tell [" "]
              genName n
              tell [";\n"]
 introduceSpec (n, A.Is m am t v)
-    =  do genConst am
+    =  do genDecl am t n
-          genType t
+          tell [" = &"]
-          tell ["& "]
-          genName n
-          tell [" = "]
           genVariable v
           tell [";\n"]
 introduceSpec (n, A.IsExpr m am t e)
-    =  do genConst am
+    =  do genDecl am t n
-          genType t
-          tell [" "]
-          genName n
           tell [" = "]
           genExpression e
           tell [";\n"]
 introduceSpec (n, A.IsChannel m t c)
-    =  do genType t
+    =  do genDecl A.Abbrev t n
-          tell [" "]
-          genName n
           tell [" = "]
           genChannel c
           tell [";\n"]
 introduceSpec (n, A.IsChannelArray m t cs)
-    =  do genType t
+    =  do genDecl A.Abbrev t n
-          tell [" "]
-          genName 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
+    =  do genDeclType am t
-            A.ValAbbrev ->
-              do genConst am
-                 genType t
           tell [" "]
-            A.Abbrev ->
-              do genType 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
+                                      t <- checkJust $ typeOfVariable st v
-                                      genType (fromJust t)
+                                      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

fco2/Parse.hs

@@ -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
+actuals :: [A.Formal] -> OccParser [A.Actual]
-actual
+actuals fs = intersperseP (map actual fs) sComma
-    =   try (do { e <- expression; return $ A.ActualExpression e })
+
-    <|> try (do { c <- channel; return $ A.ActualChannel c })
+actual :: A.Formal -> OccParser A.Actual
-    <?> "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

fco2/Types.hs

@@ -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
 

fco2/testcases/actuals.occ

@@ -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)
+: