Changed FUNCTIONs and PROCs to have optional bodies, and put all the externals into the AST (without bodies)

This may seem like an odd change, but it simplifies the logic a lot.  I kept having problems with passes not operating on externals (e.g. functions-to-procs, adding array sizes, constant folding in array dimensions) and adding a special case every time to also process the externals was getting silly.

Putting the externals in the AST therefore made sense, but I didn't want to just add dummy bodies as this would cause them to throw up errors (e.g. in the type-checking for functions).  So I turned the bodies into a Maybe type, and that has worked out well.

I also stopped storing the formals in csExternals (since they are now in csNames, and the tree), which streamlined that nicely, and stopped me having to keep them up to date.

backends/BackendPasses.hs

@@ -234,14 +234,6 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
    \t -> do pushPullContext
             t' <- recurse t >>= applyPulled
             popPullContext
-            exts <- getCompState >>* csExternals
-            exts' <- sequence [do fs' <- transformExternal (findMeta t) extType fs
-                                  modifyName (A.Name emptyMeta n) $ \nd -> nd
-                                    {A.ndSpecType = A.Proc (findMeta t)
-                                      (A.PlainSpec, A.PlainRec) fs' (A.Skip (findMeta t))}
-                                  return $ (n, (extType, fs'))
-                              | (n, (extType, fs)) <- exts]
-            modify $ \cs -> cs { csExternals = exts' }
             return t'
             )
   where
@@ -358,7 +350,8 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
                do -- We descend into the scope first, so that all the actuals get
                   -- fixed before the formals:
                   s' <- recurse s
-                  (args', newargs) <- transformFormals Nothing m args
+                  ext <- getCompState >>* csExternals >>* lookup (A.nameName n)
+                  (args', newargs) <- transformFormals ext m args
                   sequence_ [defineSizesName m' n (A.Declaration m' t)
                             | A.Formal _ t n <-  newargs]
                   -- We descend into the body after the formals have been
@@ -372,13 +365,6 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
              _ -> descend str
     doStructured s = descend s
 
-    transformExternal :: Meta -> ExternalType -> [A.Formal] -> PassM [A.Formal]
-    transformExternal m extType args
-      = do (args', newargs) <- transformFormals (Just extType) m args
-           sequence_ [defineSizesName m n (A.Declaration m t)
-                     | A.Formal _ t n <-  newargs]
-           return args'
-
     transformFormals :: Maybe ExternalType -> Meta -> [A.Formal] -> PassM ([A.Formal], [A.Formal])
     transformFormals _ _ [] = return ([],[])
     transformFormals ext m ((f@(A.Formal am t n)):fs)
@@ -413,7 +399,7 @@ declareSizesArray = occamOnlyPass "Declare array-size arrays"
 
     doProcess :: A.Process -> PassM A.Process
     doProcess (A.ProcCall m n params)
-      = do ext <- getCompState >>* csExternals >>* lookup (A.nameName n) >>* fmap fst
+      = do ext <- getCompState >>* csExternals >>* lookup (A.nameName n)
            A.Proc _ _ fs _ <- specTypeOfName n
            concatMapM (transformActual ext) (zip fs params) >>* A.ProcCall m n
     doProcess p = descend p
@@ -536,16 +522,16 @@ mobileReturn = cOnlyPass "Add MOBILE returns" [] [] recurse
              _ -> return (ps, f : fs')
 
     doStructured :: Data a => Transform (A.Structured a)
-    doStructured s@(A.Spec msp (A.Specification m n (A.Proc m' sm fs pr)) scope)
+    doStructured s@(A.Spec msp (A.Specification m n (A.Proc m' sm fs (Just pr))) scope)
       = do pr' <- recurse pr
            -- We do the scope first, so that all the callers are updated before
            -- we fix our state:
            scope' <- recurse scope
            ig <- ignoreProc n
            if ig
-             then return $ A.Spec msp (A.Specification m n (A.Proc m' sm fs pr')) scope'
+             then return $ A.Spec msp (A.Specification m n (A.Proc m' sm fs $ Just pr')) scope'
              else do (ps, fs') <- addChansForm m fs
-                     let newSpec = A.Proc m' sm fs' (A.Seq m' $ A.Several m' $
+                     let newSpec = A.Proc m' sm fs' $ Just (A.Seq m' $ A.Several m' $
                                             map (A.Only m') $ pr' : ps)
                      modifyName n (\nd -> nd {A.ndSpecType = newSpec})
                      return $ A.Spec msp (A.Specification m n newSpec) scope'

backends/GenerateC.hs

@@ -204,7 +204,7 @@ cgenTopLevel headerName s
 
           -- Forward declarations of externals:
           sequence_ [tell ["extern void ", mungeExternalName n, "(int*);"]
-                    | (n, (ExternalOldStyle, _)) <- csExternals cs]
+                    | (n, ExternalOldStyle) <- csExternals cs]
 
           call genStructured TopLevel s (\m _ -> tell ["\n#error Invalid top-level item: ", show m])
 
@@ -1584,7 +1584,7 @@ realFormals (A.Formal am t n)
 -- one of the original top-level procs, other than to add an occam_ prefix (which
 -- avoids name collisions).
 genProcSpec :: Level -> A.Name -> A.SpecType -> Bool -> CGen ()
-genProcSpec lvl n (A.Proc _ (sm, rm) fs p) forwardDecl
+genProcSpec lvl n (A.Proc _ (sm, rm) fs (Just p)) forwardDecl
     =  do cs <- getCompState
           let (header, params) = if n `Set.member` csParProcs cs
                                     || rm == A.Recursive
@@ -1631,6 +1631,8 @@ genProcSpec lvl n (A.Proc _ (sm, rm) fs p) forwardDecl
                             n
                          | (t, n) <- rfs]
               tell [")"]
+-- For externals, do nothing here:
+genProcSpec _ _ (A.Proc _ _ _ Nothing) _ = return ()
 
 -- | Generate a ProcAlloc for a PAR subprocess, returning a nonce for the
 -- workspace pointer and the name of the function to call.
@@ -2060,7 +2062,7 @@ cgenProcCall n as
             (A.Recursive, _) ->
               let m = A.nameMeta n
               in call genPar A.PlainPar $ A.Only m $ A.ProcCall m n as
-            (_, Just (ExternalOldStyle, _)) ->
+            (_, Just ExternalOldStyle) ->
                  do let (c:cs) = A.nameName n
                     tell ["{int ext_args[] = {"]
                     -- We don't use the formals in csExternals because they won't

backends/GenerateCPPCSP.hs

@@ -574,7 +574,7 @@ cppgenForwardDeclaration _ = return ()
 
 cppintroduceSpec :: Level -> A.Specification -> CGen ()
 --I generate process wrappers for all functions by default:
-cppintroduceSpec lvl (A.Specification _ n (A.Proc _ (sm, _) fs p))
+cppintroduceSpec lvl (A.Specification _ n (A.Proc _ (sm, _) fs (Just p)))
     =  do --Generate the "process" as a C++ function:
           genStatic lvl n
           call genSpecMode sm

common/GenericUtils.hs

@@ -29,7 +29,7 @@ module GenericUtils (
   , gmapMFor
   , gmapMForRoute
   , routeModify, routeGet, routeSet, Route(..), (@->), routeIdentity, routeId, routeList
-  , route22, route23, route33, route34, route44, route45, route55
+  , route11, route22, route23, route33, route34, route44, route45, route55
   ) where
 
 import Control.Monad.Identity
@@ -286,6 +286,9 @@ gmapMWithRoute f = gmapFuncs [GM {unGM = f' n} | n <- [0..]]
 makeRoute :: (Data s, Data t) => Int -> Route s t
 makeRoute target = Route [target] (\f -> gmapFuncs [mkM' (if n == target then f else return) | n <- [0..]])
 
+decomp11 :: (Monad m, Data a, Typeable a0) => (a0 -> a) -> (a0 -> m a0) -> (a -> m a)
+decomp11 con f1 = decomp1 con f1
+
 decomp22 :: (Monad m, Data a, Typeable a0, Typeable a1) => (a0 -> a1 -> a) -> (a1 -> m a1) -> (a -> m a)
 decomp22 con f1 = decomp2 con return f1
 
@@ -311,6 +314,9 @@ decomp55 :: (Monad m, Data a, Typeable a0, Typeable a1, Typeable a2, Typeable a3
   (a0 -> a1 -> a2 -> a3 -> a4 -> a) -> (a4 -> m a4) -> (a -> m a)
 decomp55 con f4 = decomp5 con return return return return f4
 
+route11 :: (Data a, Typeable a0) => Route a b -> (a0 -> a) -> Route a0 b
+route11 route con = route @-> Route [0] (decomp11 con)
+
 route22 :: (Data a, Typeable a0, Typeable a1) => Route a b -> (a0 -> a1 -> a) -> Route a1 b
 route22 route con = route @-> Route [1] (decomp22 con)
 

common/OccamEDSL.hs

@@ -250,7 +250,7 @@ oPROC str params body scope = do
   s <- scope
   defineProc str [(A.nameName name, A.Original, t) | (t, A.Variable _ name) <- params]
   return $ A.Spec emptyMeta (A.Specification emptyMeta (simpleName str) $
-             A.Proc emptyMeta (A.PlainSpec, A.PlainRec) formals p
+             A.Proc emptyMeta (A.PlainSpec, A.PlainRec) formals (Just p)
            ) (singlify s)
   where
     formals = [A.Formal A.Original t n | (t, A.Variable _ n) <- params]

common/ShowCode.hs

@@ -508,7 +508,7 @@ instance ShowOccam A.RecordAttr where
 
 instance ShowOccam A.Specification where
   -- TODO add specmode to the output
-  showOccamM (A.Specification _ n (A.Proc _ sm params body))
+  showOccamM (A.Specification _ n (A.Proc _ sm params (Just body)))
     = do let params' = intersperse (tell [","]) $ map showOccamM params
          showOccamLine $ do tell ["PROC "]
                             showName n
@@ -535,11 +535,11 @@ instance ShowOccam A.Specification where
          occamOutdent
          (showOccamLine colon)
   --TODO use the specmode
-  showOccamM (A.Specification _ n (A.Function _ sm retTypes params (Left el@(A.Only {}))))
+  showOccamM (A.Specification _ n (A.Function _ sm retTypes params (Just (Left el@(A.Only {})))))
     = showOccamLine $
         showWithCommas retTypes >> (tell [" FUNCTION "]) >> showName n >> tell ["("] >> showWithCommas params >> tell [")"]
         >> tell [" IS "] >> showOccamM el >> colon
-  showOccamM (A.Specification _ n (A.Function _ sm retTypes params (Left body)))
+  showOccamM (A.Specification _ n (A.Function _ sm retTypes params (Just (Left body))))
     = (showOccamLine $ showWithCommas retTypes >> (tell [" FUNCTION "]) >> showName n >> tell ["("] >> showWithCommas params >> tell [")"])
       >> occamIndent
       >> showOccamM body

common/TestUtils.hs

@@ -111,7 +111,7 @@ testCheck config property =
 -- | Wraps a structured process into a complete AST fragment.
 wrapProcSeq :: A.Structured A.Process -> A.AST
 wrapProcSeq x = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo")
-  $ A.Proc emptyMeta (A.PlainSpec, A.PlainRec) [] $ A.Seq emptyMeta x) (A.Several emptyMeta [])
+  $ A.Proc emptyMeta (A.PlainSpec, A.PlainRec) [] $ Just $ A.Seq emptyMeta x) (A.Several emptyMeta [])
 
 
 -- | Helper function to generate an array dimension.
@@ -367,7 +367,7 @@ defineFunction :: String -> [A.Type] -> [(String, A.Type)]
 defineFunction s rs as
     = defineThing s st A.Original A.NameUser
   where
-    st = A.Function emptyMeta (A.PlainSpec, A.PlainRec) rs fs (Right $ A.Skip emptyMeta)
+    st = A.Function emptyMeta (A.PlainSpec, A.PlainRec) rs fs (Just $ Right $ A.Skip emptyMeta)
     fs = [A.Formal A.ValAbbrev t (simpleName s) | (s, t) <- as]
 
 -- | Define a proc.
@@ -375,7 +375,7 @@ defineProc :: CSM m => String -> [(String, A.AbbrevMode, A.Type)] -> m ()
 defineProc s as
     = defineThing s st A.Original A.NameUser
   where
-    st = A.Proc emptyMeta (A.PlainSpec, A.PlainRec) fs $ A.Skip emptyMeta
+    st = A.Proc emptyMeta (A.PlainSpec, A.PlainRec) fs $ Just $ A.Skip emptyMeta
     fs = [A.Formal am t (simpleName s) | (s, am, t) <- as]
 
 -- | Define a protocol.

data/AST.hs

@@ -496,11 +496,11 @@ data SpecType =
   -- | Declare a variant protocol.
   -- The list pairs tag names with item types.
   | ProtocolCase Meta [(Name, [Type])]
-  -- | Declare a @PROC@.
+  -- | Declare a @PROC@.  Body is Nothing if it's external
-  | Proc Meta (SpecMode, RecMode) [Formal] Process
+  | Proc Meta (SpecMode, RecMode) [Formal] (Maybe Process)
-  -- | Declare a @FUNCTION@.
+  -- | Declare a @FUNCTION@.  Body is Nothing if it's external
   | Function Meta (SpecMode, RecMode) [Type] [Formal]
-             (Either (Structured ExpressionList) Process)
+             (Maybe (Either (Structured ExpressionList) Process))
   -- | Declare a retyping abbreviation of a variable.
   | Retypes Meta AbbrevMode Type Variable
   -- | Declare a retyping abbreviation of an expression.

data/CompState.hs

@@ -135,7 +135,7 @@ data CompState = CompState {
     -- up (and therefore the things that should be visible to other files during
     -- separate compilation)
     csOriginalTopLevelProcs :: [String],
-    csExternals :: [(String, (ExternalType, [A.Formal]))],
+    csExternals :: [(String, ExternalType)],
     -- Maps an array variable name to the name of its _sizes array:
     csArraySizes :: Map String A.Name,
     -- Stores a map of constant sizes arrays declared for that size:
@@ -396,7 +396,7 @@ defineNonce m s st am
 -- | Generate and define a no-arg wrapper PROC around a process.
 makeNonceProc :: CSM m => Meta -> A.Process -> m A.Specification
 makeNonceProc m p
-    = defineNonce m "wrapper_proc" (A.Proc m (A.PlainSpec, A.PlainRec) [] p) A.Abbrev
+    = defineNonce m "wrapper_proc" (A.Proc m (A.PlainSpec, A.PlainRec) [] (Just p)) A.Abbrev
 
 -- | Generate and define a counter for a replicator.
 makeNonceCounter :: CSM m => String -> Meta -> m A.Name
@@ -440,7 +440,7 @@ findAllProcesses
     findAllProcesses' :: (String, A.NameDef) -> Maybe (String, A.Process)
     findAllProcesses' (n, nd)
       = case A.ndSpecType nd of
-          A.Proc _ _ _ p -> Just (n, p)
+          A.Proc _ _ _ (Just p) -> Just (n, p)
           _ -> Nothing
 
 -- | A new identifer for the unify types in the tree

flow/FlowGraph.hs

@@ -69,16 +69,16 @@ addSpecNodes spec route
 -- Descends into process or function specifications, but doesn't join them up.  Any other specifications are ignored
 buildProcessOrFunctionSpec :: (Monad mAlter, Monad mLabel) => A.Specification -> ASTModifier mAlter (A.Specification) structType ->
   GraphMaker mLabel mAlter label structType ()
-buildProcessOrFunctionSpec (A.Specification _ _ (A.Proc m _ args p)) route
+buildProcessOrFunctionSpec (A.Specification _ _ (A.Proc m _ args (Just p))) route
  = let procRoute = (route33 route A.Specification) in
-   addNewSubProcFunc m args (Left (p, route44 procRoute A.Proc)) (route34 procRoute A.Proc)
+   addNewSubProcFunc m args (Left (p, route11 (route44 procRoute A.Proc) Just)) (route34 procRoute A.Proc)
-buildProcessOrFunctionSpec (A.Specification _ _ (A.Function m _ _ args es)) route
+buildProcessOrFunctionSpec (A.Specification _ _ (A.Function m _ _ args (Just es))) route
   = let funcRoute = (route33 route A.Specification) in
     case es of
       Left sel -> addNewSubProcFunc m args (Right (sel, route55 funcRoute A.Function @-> (Route
-        [0] $ \f (Left e) -> f e >>* Left))) (route45 funcRoute A.Function)
+        [0,0] $ \f (Just (Left e)) -> f e >>* (Just . Left)))) (route45 funcRoute A.Function)
       Right p -> addNewSubProcFunc m args (Left (p, route55 funcRoute A.Function @-> (Route
-        [0] $ \f (Right p) -> f p >>* Right))) (route45 funcRoute A.Function)
+        [0,0] $ \f (Just (Right p)) -> f p >>* (Just . Right)))) (route45 funcRoute A.Function)
 buildProcessOrFunctionSpec _ _ = return ()
 
 -- All the various types of Structured (SEQ, PAR, ALT, IF, CASE, input-CASE, VALOF) deal with their nodes so differently

flow/FlowGraphTest.hs

@@ -386,27 +386,27 @@ testProcFuncSpec = TestLabel "testProcFuncSpec" $ TestList
   [
    -- Single spec of process (with SKIP body) in AST (not connected up):
     testGraph' "testProcFuncSpec 0" [(0, m0), (5,m5)] [5] [(5,0,ESeq Nothing)]
-      (A.Spec mU (A.Specification m1 undefined $ A.Proc m5 undefined undefined sm0) $ A.Several mU [])
+      (A.Spec mU (A.Specification m1 undefined $ A.Proc m5 undefined undefined $ Just sm0) $ A.Several mU [])
       
    -- Single spec of process (with body with SEQ SKIP SKIP):
    ,testGraph' "testProcFuncSpec 1" [(0, m3), (4,m5), (9,m9)] [9] ([(9,0,ESeq Nothing), (0,4,ESeq Nothing)])
       (A.Spec mU (A.Specification m6 undefined $ A.Proc m9 undefined undefined $
-        A.Seq m0 $ A.Several m1 [A.Only m2 sm3,A.Only m4 sm5]
+        Just $ A.Seq m0 $ A.Several m1 [A.Only m2 sm3,A.Only m4 sm5]
       ) $ A.Several mU [])
    -- Nested spec of process (with bodies with SEQ SKIP SKIP):
    ,testGraph' "testProcFuncSpec 2" [(3,m2),(4,m3),(5,m4),(6,m5), (10,m10), (11, m11)] [10,11]
       ([(10,3,ESeq Nothing), (3,4,ESeq Nothing)] ++ [(11,5,ESeq Nothing), (5,6,ESeq Nothing)])
       (A.Spec mU (A.Specification m6 undefined $ A.Proc m10 undefined undefined $
-        A.Seq mU $ A.Several mU [A.Only mU sm2,A.Only mU sm3]
+        Just $ A.Seq mU $ A.Several mU [A.Only mU sm2,A.Only mU sm3]
       ) $ 
        A.Spec mU (A.Specification m7 undefined $ A.Proc m11 undefined undefined $
-        A.Seq mU $ A.Several mU [A.Only mU sm4,A.Only mU sm5]
+        Just $ A.Seq mU $ A.Several mU [A.Only mU sm4,A.Only mU sm5]
       )  
       $ A.Several mU [])
       
    -- Single spec of process (with SKIP body) in a SEQ (connected up):
    ,testGraph "testProcFuncSpec 10" [(0, m0),(1,m1),(2,sub m1 100), (3, m3), (5,m5)] [1,5] [(5,0,ESeq Nothing), (1,3,ESeq Nothing), (3,2,ESeq Nothing)]
-      (A.Seq mU $ A.Spec mU (A.Specification m1 undefined $ A.Proc m5 undefined undefined sm0) $ A.Several m3 [])
+      (A.Seq mU $ A.Spec mU (A.Specification m1 undefined $ A.Proc m5 undefined undefined $ Just sm0) $ A.Several m3 [])
       
   ]
 

frontends/OccamPasses.hs

@@ -69,7 +69,7 @@ writeIncFile = occamOnlyPass "Write .inc file" [] []
   ))
   where
     emitProcsAsExternal :: A.AST -> PassM (Seq.Seq String)
-    emitProcsAsExternal (A.Spec _ (A.Specification _ n (A.Proc _ _ fs _)) scope)
+    emitProcsAsExternal (A.Spec _ (A.Specification _ n (A.Proc _ _ fs (Just _))) scope)
       = do origN <- lookupName n >>* A.ndOrigName
            thisProc <- sequence (
              [return $ "#PRAGMA TOCKEXTERNAL \"PROC " ++ origN ++ "("
@@ -79,7 +79,7 @@ writeIncFile = occamOnlyPass "Write .inc file" [] []
            modify $ \cs -> cs { csOriginalTopLevelProcs =
              A.nameName n : csOriginalTopLevelProcs cs }
            emitProcsAsExternal scope >>* (thisProc Seq.<|)
-    emitProcsAsExternal (A.Spec _ (A.Specification _ n (A.Function _ _ ts fs _)) scope)
+    emitProcsAsExternal (A.Spec _ (A.Specification _ n (A.Function _ _ ts fs (Just _))) scope)
       = do origN <- lookupName n >>* A.ndOrigName
            thisProc <- sequence (
              [return $ "#PRAGMA TOCKEXTERNAL \""

frontends/OccamTypes.hs

@@ -937,12 +937,12 @@ inferTypes = occamOnlyPass "Infer types"
                         _ -> return (t'', id)
                     _ -> return (t'', id)
                   return $ A.Is m am t''' $ A.ActualChannelArray $ map f vs'
-            A.Function m sm ts fs (Left sel) -> lift $
+            A.Function m sm ts fs (Just (Left sel)) -> lift $
                do sm' <- recurse sm
                   ts' <- recurse ts
                   fs' <- recurse fs
                   sel' <- doFuncDef ts sel
-                  return $ A.Function m sm' ts' fs' (Left sel')
+                  return $ A.Function m sm' ts' fs' $ Just (Left sel')
             A.RetypesExpr _ _ _ _ -> lift $ noTypeContext $ descend st
             -- For PROCs that take any channels without direction,
             -- we must determine if we can infer a specific direction
@@ -1404,7 +1404,7 @@ checkSpecTypes = checkDepthM doSpecType
     doSpecType (A.Proc m _ fs _)
         = sequence_ [when (am == A.Original) $ unexpectedAM m
                      | A.Formal am _ n <- fs]
-    doSpecType (A.Function m _ rs fs body)
+    doSpecType (A.Function m _ rs fs (Just body))
         =  do when (length rs == 0) $
                 dieP m "A function must have at least one return type"
               sequence_ [do when (am /= A.ValAbbrev) $
@@ -1420,6 +1420,7 @@ checkSpecTypes = checkDepthM doSpecType
         doFunctionBody rs (Left s) = checkStructured (checkExpressionList rs) s
         -- FIXME: Need to know the name of the function to do this
         doFunctionBody rs (Right p) = dieP m "Cannot check function process body"
+    doSpecType (A.Function _ _ _ _ Nothing) = return ()
     doSpecType (A.Retypes m am t v)
         =  do fromT <- astTypeOf v
               checkRetypes m fromT t

frontends/OccamTypesTest.hs

@@ -457,18 +457,18 @@ testOccamTypes = TestList
                                        ]
 
     -- Proc
-    , testOK   2090 $ A.Proc m (A.PlainSpec, A.PlainRec) [] skip
+    , testOK   2090 $ A.Proc m (A.PlainSpec, A.PlainRec) [] jskip
-    , testOK   2091 $ A.Proc m (A.InlineSpec, A.PlainRec) [] skip
+    , testOK   2091 $ A.Proc m (A.InlineSpec, A.PlainRec) [] jskip
     , testOK   2092 $ A.Proc m (A.PlainSpec, A.PlainRec)
                              [ A.Formal A.Abbrev A.Int (simpleName "x")
                              , A.Formal A.ValAbbrev A.Int (simpleName "y")
                              , A.Formal A.Abbrev chanIntT (simpleName "c")
                              ]
-                             skip
+                             jskip
     , testFail 2093 $ A.Proc m (A.PlainSpec, A.PlainRec)
                              [ A.Formal A.Original A.Int (simpleName "x")
                              ]
-                             skip
+                             jskip
 
     -- Function
     , testOK   2100 $ A.Function m (A.PlainSpec, A.PlainRec) [A.Int] [] returnOne
@@ -600,6 +600,7 @@ testOccamTypes = TestList
     --{{{  process fragments
 
     skip = A.Skip m
+    jskip = Just skip
     sskip = A.Only m skip
     insim iis = A.InputSimple m iis
     inputSimple c iis = A.Input m c $ insim iis
@@ -620,9 +621,9 @@ testOccamTypes = TestList
     --}}}
     --{{{  specification fragments
 
-    returnNone = Left $ A.Only m $ A.ExpressionList m []
+    returnNone = Just $ Left $ A.Only m $ A.ExpressionList m []
-    returnOne = Left $ A.Only m $ A.ExpressionList m [intE]
+    returnOne = Just $ Left $ A.Only m $ A.ExpressionList m [intE]
-    returnTwo = Left $ A.Only m $ A.ExpressionList m [intE, intE]
+    returnTwo = Just $ Left $ A.Only m $ A.ExpressionList m [intE, intE]
 
     retypesV = A.Retypes m A.Abbrev
     retypesE = A.RetypesExpr m A.ValAbbrev

frontends/ParseOccam.hs

@@ -371,8 +371,7 @@ handleSpecs specs inner specMarker
            v <- inner
            mapM scopeOutSpec (reverse ss')
            after
-           return $ foldl (\e s -> specMarker m s e) v
+           return $ foldl (\e s -> specMarker m s e) v ss'
-             [s | (s,(_,_,(_,A.NameUser))) <- zip ss' ss]
 
 -- | 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
@@ -1179,7 +1178,7 @@ definition
            indent
            n' <- if rm == A.Recursive
                    then scopeIn n ProcName
-                          (A.Proc m (sm, rm) (map fst fs) (A.Skip m)) A.Original normalName
+                          (A.Proc m (sm, rm) (map fst fs) Nothing) A.Original normalName
                    else return n
            fs' <- scopeInFormals fs
            p <- process
@@ -1187,7 +1186,7 @@ definition
            outdent
            sColon
            eol
-           return (A.Specification m n' $ A.Proc m (sm, rm) fs' p, ProcName, normalName)
+           return (A.Specification m n' $ A.Proc m (sm, rm) fs' (Just p), ProcName, normalName)
     <|> do m <- md
            (rs, (sm, (rm, _))) <- tryVV (sepBy1 dataType sComma) (specMode $ recMode sFUNCTION)
            n <- newFunctionName
@@ -1195,7 +1194,7 @@ definition
            let addScope body
                  = do n' <- if rm == A.Recursive
                               then scopeIn n FunctionName
-                                     (A.Function m (sm, rm) rs (map fst fs) (Left $ A.Several m []))
+                                     (A.Function m (sm, rm) rs (map fst fs) Nothing)
                                      A.Original normalName
                               else return n
                       fs' <- scopeInFormals fs
@@ -1203,9 +1202,11 @@ definition
                       scopeOutFormals fs'
                       return (x, fs', n')
            do { sIS; (el, fs', n') <- addScope expressionList; sColon; eol;
-                return (A.Specification m n' $ A.Function m (sm, rm) rs fs' (Left $ A.Only m el), FunctionName, normalName) }
+                return (A.Specification m n' $ A.Function m (sm, rm) rs fs'
+                  (Just $ Left $ A.Only m el), FunctionName, normalName) }
              <|> do { eol; indent; (vp, fs', n') <- addScope valueProcess; outdent; sColon; eol;
-                return (A.Specification m n' $ A.Function m (sm, rm) rs fs' (Left vp), FunctionName, normalName) }
+                return (A.Specification m n' $ A.Function m (sm, rm) rs fs'
+                  (Just $ Left vp), FunctionName, normalName) }
     <|> retypesAbbrev
     <?> "definition"
   where
@@ -1421,23 +1422,23 @@ pragma = do m <- getPosition >>* sourcePosToMeta
                             fs <- formalList'
                             sEq
                             integer
-                            return (n, ProcName, n, fs, A.Proc m (A.PlainSpec, A.PlainRec) fs (A.Skip m))
+                            return (n, ProcName, n, fs, A.Proc m (A.PlainSpec, A.PlainRec) fs Nothing)
                     else do sPROC
                             origN <- anyName ProcName
                             fs <- formalList'
                             sEq
                             n <- newProcName
-                            return (n, ProcName, origN, fs, A.Proc m (A.PlainSpec, A.PlainRec) fs (A.Skip m))
+                            return (n, ProcName, origN, fs, A.Proc m (A.PlainSpec, A.PlainRec) fs Nothing)
                          <|> do ts <- tryVX (sepBy1 dataType sComma) sFUNCTION
                                 origN <- anyName FunctionName
                                 fs <- formalList'
                                 sEq
                                 n <- newFunctionName
                                 return (n, FunctionName, origN, fs, A.Function m (A.PlainSpec, A.PlainRec) ts fs
-                                  $ Right (A.Skip m))
+                                  Nothing)
                 let ext = if pragmaType == 2 then ExternalOldStyle else ExternalOccam
                 modify $ \st -> st
-                  { csExternals = (A.nameName n, (ext, fs)) : csExternals st
+                  { csExternals = (A.nameName n, ext) : csExternals st
                   }
                 return $ Just (A.Specification m origN sp, nt, (Just n, A.NameExternal))
             ns <- case (prag, mprod) of

frontends/ParseRain.hs

@@ -495,13 +495,13 @@ terminator = A.Several emptyMeta []
 processDecl :: RainParser A.AST
 processDecl = do {m <- sProcess ; procName <- name ; params <- tupleDef ; body <- block ;
   return $ A.Spec m
-    (A.Specification m procName (A.Proc m (A.PlainSpec, A.Recursive) (formaliseTuple params) body))
+    (A.Specification m procName (A.Proc m (A.PlainSpec, A.Recursive) (formaliseTuple params) $ Just body))
   terminator}
 
 functionDecl :: RainParser A.AST
 functionDecl = do {m <- sFunction ; retType <- dataType ; sColon ; funcName <- name ; params <- tupleDef ; body <- innerBlock False (Just funcName) ;
   return $ A.Spec m
-    (A.Specification m funcName (A.Function m (A.PlainSpec, A.Recursive) [retType] (formaliseTuple params) (Right $ A.Seq m body)))
+    (A.Specification m funcName (A.Function m (A.PlainSpec, A.Recursive) [retType] (formaliseTuple params) (Just $ Right $ A.Seq m body)))
     terminator}
 
 topLevelDecl :: RainParser A.AST

frontends/ParseRainTest.hs

@@ -487,21 +487,22 @@ testTopLevelDecl :: [ParseTest A.AST]
 testTopLevelDecl =
  [
   passTop (0, "process noargs() {}", 
-    [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m (A.PlainSpec, A.Recursive) [] emptyBlock) emptySeveral])
+    [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m (A.PlainSpec, A.Recursive) [] jemptyBlock) emptySeveral])
   
   ,passTop (1, "process onearg(int: x) {x = 0;}",
     [A.Spec m (A.Specification m (simpleName "onearg") $ A.Proc m (A.PlainSpec, A.Recursive)
-      [A.Formal A.ValAbbrev A.Int (simpleName "x")] $
+      [A.Formal A.ValAbbrev A.Int (simpleName "x")] $ Just $
       makeSeq [makeAssign (variable "x") (intLiteral 0)])
       emptySeveral
     ])
     
   ,passTop (2, "process noargs0() {} process noargs1 () {}",
-    [A.Spec m (A.Specification m (simpleName "noargs0") $ A.Proc m (A.PlainSpec, A.Recursive) [] emptyBlock) emptySeveral 
+    [A.Spec m (A.Specification m (simpleName "noargs0") $ A.Proc m (A.PlainSpec, A.Recursive) [] jemptyBlock) emptySeveral 
-    ,A.Spec m (A.Specification m (simpleName "noargs1") $ A.Proc m (A.PlainSpec, A.Recursive) [] emptyBlock) emptySeveral])
+    ,A.Spec m (A.Specification m (simpleName "noargs1") $ A.Proc m (A.PlainSpec, A.Recursive) [] jemptyBlock) emptySeveral])
 
   ,passTop (4, "process noargs() par {}",
-    [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m (A.PlainSpec, A.Recursive) [] $ A.Par m A.PlainPar emptySeveral) emptySeveral])
+    [A.Spec m (A.Specification m (simpleName "noargs") $ A.Proc m (A.PlainSpec, A.Recursive) [] $
+      Just $ A.Par m A.PlainPar emptySeveral) emptySeveral])
 
   , fail ("process", RP.topLevelDecl)
   , fail ("process () {}", RP.topLevelDecl)
@@ -513,22 +514,25 @@ testTopLevelDecl =
   , fail ("process foo (int x) {}", RP.topLevelDecl)
     
   ,passTop (100, "function uint8: cons() {}",
-    [A.Spec m (A.Specification m (simpleName "cons") $ A.Function m (A.PlainSpec,A.Recursive) [A.Byte] [] $ Right emptyBlock) emptySeveral])
+    [A.Spec m (A.Specification m (simpleName "cons") $ A.Function m (A.PlainSpec,A.Recursive) [A.Byte] []
+      $ Just $ Right emptyBlock) emptySeveral])
 
   ,passTop (101, "function uint8: f(uint8: x) {}",
     [A.Spec m (A.Specification m (simpleName "f") $
-      A.Function m (A.PlainSpec, A.Recursive) [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ Right emptyBlock)
+      A.Function m (A.PlainSpec, A.Recursive) [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")]
+        $ Just $ Right emptyBlock)
       emptySeveral])
 
   ,passTop (102, "function uint8: id(uint8: x) {return x;}",
     [A.Spec m (A.Specification m (simpleName "id") $
-      A.Function m (A.PlainSpec, A.Recursive) [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ Right $
+      A.Function m (A.PlainSpec, A.Recursive) [A.Byte] [A.Formal A.ValAbbrev A.Byte (simpleName "x")] $ Just $ Right $
         A.Seq m $ A.Several m [A.Only m $ A.Assign m [variable "id"] (A.ExpressionList m [exprVariable "x"])])
       emptySeveral])
  ]
  where
    passTop :: (Int, String, [A.AST]) -> ParseTest A.AST
    passTop (ind, input, exp) = pass (input, RP.topLevelDecl, assertPatternMatch ("testTopLevelDecl " ++ show ind) $ pat $ A.Several m exp)
+   jemptyBlock = Just emptyBlock
 
 nonShared :: A.ChanAttributes
 nonShared = A.ChanAttributes { A.caWritingShared = A.Unshared, A.caReadingShared = A.Unshared}

frontends/RainPasses.hs

@@ -223,7 +223,7 @@ checkFunction :: PassType
 checkFunction = return -- applyDepthM checkFunction'
   where
     checkFunction' :: A.Specification -> PassM A.Specification
-    checkFunction' spec@(A.Specification _ n (A.Function m _ _ _ (Right body)))
+    checkFunction' spec@(A.Specification _ n (A.Function m _ _ _ (Just (Right body))))
       = case body of 
           (A.Seq m' seqBody) ->
             let A.Several _ statements = skipSpecs seqBody in

frontends/RainPassesTest.hs

@@ -175,17 +175,19 @@ testUnique2b = TestCase $ testPassWithItemsStateCheck "testUnique2b" exp uniquif
 testUnique3 :: Test
 testUnique3 = TestCase $ testPassWithItemsStateCheck "testUnique3" exp uniquifyAndResolveVars orig (return ()) check
   where
-    orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] $ A.Skip m) (A.Only m $ A.ProcCall m (procName "foo") [])
+    orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] $ Just
+      $ A.Skip m) (A.Only m $ A.ProcCall m (procName "foo") [])
     exp = orig
     check (items,state) = assertVarDef "testUnique3: Variable was not recorded" state "foo"
                             (tag7 A.NameDef DontCare "foo" "foo"
-                              (A.Proc m (A.PlainSpec, A.Recursive) [] $ A.Skip m) A.Original A.NameUser A.Unplaced)
+                              (A.Proc m (A.PlainSpec, A.Recursive) [] $ Just $
+                                A.Skip m) A.Original A.NameUser A.Unplaced)
 
 -- | Tests that parameters are uniquified and resolved:
 testUnique4 :: Test
 testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp uniquifyAndResolveVars orig (return ()) check
   where
-    orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [A.Formal A.ValAbbrev A.Byte $ simpleName "c"] $ 
+    orig = A.Spec m (A.Specification m (procName "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [A.Formal A.ValAbbrev A.Byte $ simpleName "c"] $ Just $ 
       A.ProcCall m (procName "foo") [A.ActualExpression $ exprVariable "c"]) (skipP)
     exp = mSpecP
              (tag3 A.Specification DontCare (procNamePattern "foo") $ tag4 A.Proc DontCare (A.PlainSpec, A.Recursive)
@@ -226,7 +228,7 @@ testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp uniquifyA
 testFindMain0 :: Test
 testFindMain0 = TestCase $ testPassWithItemsStateCheck "testFindMain0" exp (uniquifyAndResolveVars >>> findMain) orig (return ()) check
   where
-    orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) $ A.Several m [] :: A.AST
+    orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m (A.PlainSpec, A.Recursive) [] (Just $ A.Skip m)) $ A.Several m [] :: A.AST
     exp = mSpecAST (tag3 A.Specification DontCare (tag2 A.Name DontCare ("main"@@DontCare)) $
       tag4 A.Proc DontCare (A.PlainSpec, A.Recursive) ([] :: [A.Formal]) (tag1 A.Skip DontCare)) $ mSeveralAST ([] :: [A.AST])
     check (items,state) 
@@ -239,15 +241,15 @@ testFindMain0 = TestCase $ testPassWithItemsStateCheck "testFindMain0" exp (uniq
 testFindMain1 :: Test
 testFindMain1 = TestCase $ testPassWithStateCheck "testFindMain1" orig (uniquifyAndResolveVars >>> findMain) orig (return ()) check
   where
-    orig = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) $ A.Several m ([] :: [A.AST])
+    orig = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] (Just $ A.Skip m)) $ A.Several m ([] :: [A.AST])
     check state = assertEqual "testFindMain1" [] (csMainLocals state)
     
 testFindMain2 :: Test
 testFindMain2 = TestCase $ testPassWithItemsStateCheck "testFindMain2" exp (uniquifyAndResolveVars >>> findMain) orig (return ()) check
   where
-    inner = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) $
+    inner = A.Spec m (A.Specification m (A.Name m "foo") $ A.Proc m (A.PlainSpec, A.Recursive) [] (Just $ A.Skip m)) $
                A.Several m ([] :: [A.AST])
-    orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m (A.PlainSpec, A.Recursive) [] (A.Skip m)) inner
+    orig = A.Spec m (A.Specification m (A.Name m "main") $ A.Proc m (A.PlainSpec, A.Recursive) [] (Just $ A.Skip m)) inner
              
     exp = mSpecAST (tag3 A.Specification DontCare (tag2 A.Name DontCare ("main"@@DontCare)) $
       tag4 A.Proc DontCare (A.PlainSpec, A.Recursive) ([] :: [A.Formal]) (tag1 A.Skip DontCare)) (stopCaringPattern m $ mkPattern inner)
@@ -274,12 +276,12 @@ testParamPass testName formals params transParams
     startStateProc = do defineName (simpleName "x") $ simpleDefDecl "x" (A.UInt16)
                         case formals of
                           Nothing -> return ()
-                          Just formals' -> defineName (procName "foo") $ simpleDef "foo" $ A.Proc m (A.PlainSpec, A.Recursive) formals' (A.Skip m)
+                          Just formals' -> defineName (procName "foo") $ simpleDef "foo" $ A.Proc m (A.PlainSpec, A.Recursive) formals' (Just $ A.Skip m)
     startStateFunc :: State CompState ()
     startStateFunc = do defineName (simpleName "x") $ simpleDefDecl "x" (A.UInt16)
                         case formals of
                           Nothing -> return ()
-                          Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m (A.PlainSpec,A.Recursive) [A.Byte] formals' (Left $ A.Only m $ A.ExpressionList m [])
+                          Just formals' -> defineName (funcName "foo") $ simpleDef "foo" $ A.Function m (A.PlainSpec,A.Recursive) [A.Byte] formals' (Just $ Left $ A.Only m $ A.ExpressionList m [])
     origProc = A.ProcCall m (procName "foo") params
     expProc ps = A.ProcCall m (procName "foo") ps
     origFunc = A.FunctionCall m (funcName "foo") (deActualise params)

pass/PassList.hs

@@ -88,11 +88,9 @@ nullStateBodies = Pass
   where
     nullProcFuncDefs :: A.NameDef -> A.NameDef
     nullProcFuncDefs (A.NameDef m n on (A.Proc m' sm fs _) am ns pl)
-      = (A.NameDef m n on (A.Proc m' sm fs (A.Skip m')) am ns pl)
+      = (A.NameDef m n on (A.Proc m' sm fs Nothing) am ns pl)
-    nullProcFuncDefs (A.NameDef m n on (A.Function m' sm ts fs (Left _)) am ns pl)
+    nullProcFuncDefs (A.NameDef m n on (A.Function m' sm ts fs _) am ns pl)
-      = (A.NameDef m n on (A.Function m' sm ts fs (Left $ A.Several m' [])) am ns pl)
+      = (A.NameDef m n on (A.Function m' sm ts fs Nothing) am ns pl)
-    nullProcFuncDefs (A.NameDef m n on (A.Function m' sm ts fs (Right _)) am ns pl)
-      = (A.NameDef m n on (A.Function m' sm ts fs (Right $ A.Skip m')) am ns pl)
     nullProcFuncDefs x = x
     
 

transformations/PassTest.hs

@@ -61,11 +61,11 @@ assertGetItemCast k kv
 -- | Given a body, returns a function spec:
 singleParamFunc :: A.Structured A.ExpressionList -> A.Specification
 singleParamFunc body = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec,
-  A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Left body))
+  A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Just $ Left body))
 
 singleParamFuncProc :: A.Process -> A.Specification
 singleParamFuncProc body = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec,
-  A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Right body))
+  A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "param0")] (Just $ Right body))
 
 -- | Returns the expected body of the single parameter process (when the function had valof0 as a body)
 singleParamBodyExp :: Pattern -- ^ to match: A.Process
@@ -100,7 +100,7 @@ testFunctionsToProcs1 :: Test
 testFunctionsToProcs1 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs1 A" exp functionsToProcs orig (return ()) check
   where
     orig = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec, A.Recursive) [A.Int,A.Real32] 
-      [A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] (Left $ valofTwo "param0" "param1"))
+      [A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] (Just $ Left $ valofTwo "param0" "param1"))
     exp = tag3 A.Specification DontCare (simpleName "foo") procBody
     procBody = tag4 A.Proc DontCare (A.PlainSpec, A.Recursive)
                                                 [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), 
@@ -134,7 +134,7 @@ testFunctionsToProcs2 :: Test
 testFunctionsToProcs2 = TestCase $ testPassWithItemsStateCheck "testFunctionsToProcs2 A" exp functionsToProcs orig (return ()) check
   where
     orig = A.Specification m (simpleName "fooOuter") (A.Function m (A.PlainSpec,
-      A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0")] $ Left $
+      A.PlainRec) [A.Int] [A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0")] $ Just $ Left $
       A.Spec m (singleParamFunc valof0) valof0)
     exp = tag3 A.Specification DontCare (simpleName "fooOuter") procBodyOuter
     procHeader body = tag4 A.Proc DontCare (A.PlainSpec, A.PlainRec) [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "paramOuter0"), tag3 A.Formal A.Abbrev A.Int (Named "retOuter0" DontCare)] body
@@ -190,7 +190,7 @@ testFunctionsToProcs4 = TestCase $ testPassWithItemsStateCheck "testFunctionsToP
   where
     orig = A.Specification m (simpleName "foo") (A.Function m (A.PlainSpec, A.PlainRec) [A.Int,A.Real32] 
       [A.Formal A.ValAbbrev A.Byte (simpleName "param0"),A.Formal A.Abbrev A.Real32 (simpleName "param1")] $
-        Right $ A.Seq m $ A.Only m $ A.Assign m [variable "foo"] $ A.ExpressionList m [exprVariable "param0", exprVariable "param1"])
+        Just $ Right $ A.Seq m $ A.Only m $ A.Assign m [variable "foo"] $ A.ExpressionList m [exprVariable "param0", exprVariable "param1"])
     exp = tag3 A.Specification DontCare (simpleName "foo") procBody
     procBody = tag4 A.Proc DontCare (A.PlainSpec, A.PlainRec) [tag3 A.Formal A.ValAbbrev A.Byte (simpleName "param0"), 
                                                  tag3 A.Formal A.Abbrev A.Real32 (simpleName "param1"),

transformations/SimplifyAbbrevs.hs

@@ -111,7 +111,7 @@ removeInitial
             --         process
             --   :
             --   inner
-            A.Proc m'' sm fs p ->
+            A.Proc m'' sm fs (Just p) ->
                do -- Find the INITIAL formals, and note their positions.
                   let (positions, fromFS)
                         = unzip [(i, f)
@@ -144,7 +144,7 @@ removeInitial
                                                 A.Only m' p))
                                  p (reverse $ zip temps fromFS)
 
-                  let spec' = A.Specification m' n (A.Proc m'' sm fs' p')
+                  let spec' = A.Specification m' n (A.Proc m'' sm fs' (Just p'))
                   return $ A.Spec m spec' inner
 
             _ -> leave

transformations/SimplifyAbbrevsTest.hs

@@ -60,11 +60,11 @@ testRemoveInitial = TestLabel "testRemoveInitial" $ TestList
   , ok   30 (spec foo (A.Proc m
                               (A.PlainSpec, A.PlainRec)
                               [A.Formal A.InitialAbbrev A.Int bar]
-                              skip)
+                              $ Just skip)
               inner)
             (mSpec foo (mProc (A.PlainSpec, A.PlainRec)
                               [mFormal' A.ValAbbrev A.Int mTemp]
-                              (mSeq
+                              (Just $ mSeq
                                 (mDeclareAssign bar A.Int mTempE
                                   (A.Only m skip))))
               inner)
@@ -76,14 +76,14 @@ testRemoveInitial = TestLabel "testRemoveInitial" $ TestList
                               , A.Formal A.ValAbbrev     A.Int baz
                               , A.Formal A.InitialAbbrev A.Int quux
                               ]
-                              skip)
+                              (Just skip))
               inner)
             (mSpec foo (mProc (A.PlainSpec, A.PlainRec)
                               [ mFormal' A.ValAbbrev A.Int mTemp
                               , mFormal' A.ValAbbrev A.Int baz
                               , mFormal' A.ValAbbrev A.Int mTemp2
                               ]
-                              (mSeq
+                              (Just $ mSeq
                                 (mDeclareAssign bar A.Int mTempE
                                   (mOnlyP
                                     (mSeq

transformations/SimplifyExprs.hs

@@ -51,15 +51,7 @@ functionsToProcs = pass "Convert FUNCTIONs to PROCs"
   (Prop.agg_namesDone ++ [Prop.expressionTypesChecked, Prop.parUsageChecked,
         Prop.functionTypesChecked])
   [Prop.functionsRemoved]
-  (\t -> do exts <- getCompState >>* csExternals
+  (applyDepthM doSpecification)
-            exts' <- sequence [do st <- specTypeOfName $ A.Name emptyMeta n
-                                  A.Specification _ _ st'@(A.Proc _ _ fs' _) <-
-                                    doSpecification $ A.Specification
-                                      (findMeta st) (A.Name emptyMeta n) st
-                                  return $ (n, (extType, fs'))
-                              | (n, (extType, fs)) <- exts]
-            modify $ \cs -> cs { csExternals = exts' }
-            applyDepthM doSpecification t)
   where
     doSpecification :: A.Specification -> PassM A.Specification
     doSpecification (A.Specification m n (A.Function mf smrm rts fs evp))
@@ -69,7 +61,7 @@ functionsToProcs = pass "Convert FUNCTIONs to PROCs"
              -- Note the return types so we can fix calls later.
              modify $ (\ps -> ps { csFunctionReturns = Map.insert (A.nameName n) rts (csFunctionReturns ps) })
              -- Turn the value process into an assignment process.
-             let p = vpToSeq m n evp [A.Variable mf n | n <- names]
+             let p = fmap (vpToSeq m n [A.Variable mf n | n <- names]) evp
              let st = A.Proc mf smrm (fs ++ [A.Formal A.Abbrev t n | (t, n) <- zip rts names]) p
              -- Build a new specification and redefine the function.
              let spec = A.Specification m n st
@@ -86,9 +78,9 @@ functionsToProcs = pass "Convert FUNCTIONs to PROCs"
              return spec
     doSpecification s = return s
 
-    vpToSeq :: Meta -> A.Name -> Either (A.Structured A.ExpressionList) A.Process -> [A.Variable] -> A.Process
+    vpToSeq :: Meta -> A.Name -> [A.Variable] -> Either (A.Structured A.ExpressionList) A.Process -> A.Process
-    vpToSeq m n (Left el) vs = A.Seq m $ vpToSeq' el vs
+    vpToSeq m n vs (Left el) = A.Seq m $ vpToSeq' el vs
-    vpToSeq _ n (Right p) vs = subst p
+    vpToSeq _ n vs (Right p) = subst p
       where
         subst :: Data t => t -> t
         subst = doGenericSubst `extT` doAssignSubst

transformations/SimplifyProcs.hs

@@ -169,7 +169,7 @@ flattenAssign = pass "Flatten assignment"
                          let code = A.Seq m $ A.Several m $ map (A.Only m) assigns
                              proc = A.Proc m (A.InlineSpec, A.PlainRec)
                                       [A.Formal A.Abbrev t nonceLHS, A.Formal A.ValAbbrev t nonceRHS]
-                                      code
+                                      (Just code)
                          defineName n' $ A.NameDef {
                            A.ndMeta = m,
                            A.ndName = A.nameName n',