Wrap PAR subprocesses, and add some Haddock

fco2/AST.hs

@@ -1,7 +1,5 @@
--- Data types for occam abstract syntax
--- This is intended to be imported qualified:
---   import qualified AST as A
-
+-- | Data types for occam abstract syntax.
+-- This is intended to be imported qualified as A.
 module AST where
 
 import Data.Generics

fco2/Errors.hs

@@ -1,3 +1,4 @@
+-- | Error handling and reporting.
 module Errors where
 
 import Data.Generics

fco2/GenerateC.hs

@@ -1,5 +1,4 @@
--- vim:foldmethod=marker
-
+-- | Generate C++ code from the mangled AST.
 module GenerateC where
 
 -- FIXME: Checks should be done in the parser, not here -- for example, the
@@ -50,13 +49,6 @@ missing s = tell ["\n#error Unimplemented: ", s, "\n"]
 genComma :: CGen ()
 genComma = tell [", "]
 
-makeNonce :: CGen String
-makeNonce
-    =  do st <- get
-          let i = psNonceCounter st
-          put $ st { psNonceCounter = i + 1 }
-          return $ "nonce" ++ show i
-
 withPS :: (ParseState -> a) -> CGen a
 withPS f
     =  do st <- get

fco2/Indentation.hs

@@ -1,3 +1,4 @@
+-- | Parse indentation in occam source.
 module Indentation (parseIndentation, indentMarker, outdentMarker, eolMarker) where
 
 import Data.List

fco2/Main.hs

@@ -1,5 +1,4 @@
--- Driver for FCO
-
+-- | Driver for the compiler.
 module Main where
 
 import List
@@ -62,6 +61,8 @@ main = do
 
   progress "{{{ Unnest"
   (state, ast) <- unnest state ast
+  progress $ pshow ast
+  progress $ pshow state
   progress "}}}"
 
   if ParseOnly `elem` opts then do

fco2/Metadata.hs

@@ -1,5 +1,4 @@
--- Metadata types
-
+-- | Metadata.
 module Metadata where
 
 import Data.Generics

fco2/Parse.hs

@@ -1,13 +1,11 @@
--- vim:foldmethod=marker
--- Parse occam code
+-- | Parse occam code into an AST.
+module Parse where
 
 -- FIXME: Need to:
 -- - insert type checks
 -- - remove as many trys as possible; every production should consume input
 --   when it's unambiguous
 
-module Parse where
-
 import Data.List
 import Text.ParserCombinators.Parsec
 import qualified Text.ParserCombinators.Parsec.Token as P
@@ -333,10 +331,9 @@ scopeIn n@(A.Name m nt s) t am
             A.ndType = t,
             A.ndAbbrevMode = am
           }
-          setState $ st {
+          setState $ psDefineName n' nd $ st {
             psNameCounter = (psNameCounter st) + 1,
-            psLocalNames = (s, n') : (psLocalNames st),
-            psNames = (s', nd) : (psNames st)
+            psLocalNames = (s, n') : (psLocalNames st)
             }
           return n'
 

fco2/ParseState.hs

@@ -1,11 +1,13 @@
--- State that is kept while parsing (and compiling) occam.
-
+-- | Compiler state.
 module ParseState where
 
 import Data.Generics
+import Control.Monad.State
 
 import qualified AST as A
 
+-- FIXME This is a rather inappropriate name now...
+-- | State necessary for compilation.
 data ParseState = ParseState {
     psLocalNames :: [(String, A.Name)],
     psNames :: [(String, A.NameDef)],
@@ -22,6 +24,19 @@ emptyState = ParseState {
     psNonceCounter = 0
   }
 
+-- | Add the definition of a name.
+psDefineName :: A.Name -> A.NameDef -> ParseState -> ParseState
+psDefineName n nd ps = ps { psNames = (A.nameName n, nd) : psNames ps }
+
+-- | Find the definition of a name.
 psLookupName :: ParseState -> A.Name -> Maybe A.NameDef
 psLookupName ps n = lookup (A.nameName n) (psNames ps)
 
+-- | Generate a throwaway unique name.
+makeNonce :: MonadState ParseState m => m String
+makeNonce
+    =  do ps <- get
+          let i = psNonceCounter ps
+          put ps { psNonceCounter = i + 1 }
+          return $ "nonce" ++ show i
+

fco2/PrettyShow.hs

@@ -1,8 +1,7 @@
--- A generic show implementation that pretty-prints expressions
+-- | A generic show implementation that pretty-prints expressions.
 -- This ought to use a class (like show does), so that it can be extended
 -- properly without me needing to have FCO-specific cases in here -- see the
 -- appropriate SYB paper.
-
 module PrettyShow (pshow) where
 
 import Data.Generics
@@ -44,6 +43,8 @@ doMeta m = text $ formatSourcePos m
 doAny :: Data a => a -> Doc
 doAny = doGeneral `ext1Q` doList `extQ` doString `extQ` doMeta
 
+-- | Convert an arbitrary data structure to a string in a reasonably pretty way.
+-- This is currently rather slow.
 pshow :: Data a => a -> String
 pshow x = render $ doAny x
 

fco2/Types.hs

@@ -1,3 +1,4 @@
+-- | Type inference and checking.
 module Types where
 
 import qualified AST as A

fco2/Unnest.hs

@@ -1,11 +1,60 @@
+-- | Flatten nested declarations.
 module Unnest where
 
+import Control.Monad.State
+import Data.Generics
+
 import qualified AST as A
 import Metadata
 import ParseState
 import Types
 
+type UnM a = StateT ParseState IO a
+
+-- | Generate and define a no-arg wrapper PROC around a process.
+makeNonceProc :: Meta -> A.Process -> UnM A.Specification
+makeNonceProc m p
+    =  do ns <- makeNonce
+          let n = A.Name m A.ProcName ns
+          let st = A.Proc m [] p
+          let nd = A.NameDef {
+                     A.ndMeta = m,
+                     A.ndName = ns,
+                     A.ndOrigName = "PAR branch",
+                     A.ndType = st,
+                     A.ndAbbrevMode = A.Abbrev
+                   }
+          modify $ psDefineName n nd
+          return (n, st)
+
 unnest :: ParseState -> A.Process -> IO (ParseState, A.Process)
 unnest ps ast
-    =  do return (ps, ast)
+    =  do (ast', ps') <- runStateT (parsToProcs ast) ps
+          (ast'', ps'') <- runStateT (removeNesting ast') ps'
+          return (ps'', ast'')
+
+-- | Wrap the subprocesses of PARs in no-arg PROCs.
+parsToProcs :: Data t => t -> UnM t
+parsToProcs = doGeneric `extM` doProcess
+  where
+    doGeneric :: Data t => t -> UnM t
+    doGeneric = gmapM parsToProcs
+
+    doProcess :: A.Process -> UnM A.Process
+    doProcess (A.Par m pm ps)
+        =  do ps' <- mapM parsToProcs ps
+              procs <- mapM (makeNonceProc m) ps'
+              let calls = [A.ProcSpec m s (A.ProcCall m n []) | s@(n, _) <- procs]
+              return $ A.Par m pm calls
+    doProcess (A.ParRep m pm rep p)
+        =  do p' <- parsToProcs p
+              rep' <- parsToProcs rep
+              s@(n, _) <- makeNonceProc m p'
+              let call = A.ProcSpec m s (A.ProcCall m n [])
+              return $ A.ParRep m pm rep' call
+    doProcess p = doGeneric p
+
+-- | Pull nested declarations to the top level.
+removeNesting :: Data t => t -> UnM t
+removeNesting p = return p
 

fco2/testcases/par.occ

@@ -0,0 +1,11 @@
+PROC Q (VAL INT v)
+  SKIP
+:
+PROC P ()
+  PAR
+    Q (1)
+    Q (2)
+    Q (3)
+    PAR i = 4 FOR 4
+      Q (i)
+: