Implement INLINE PROC and INLINE FUNCTION

fco2/AST.hs

@@ -203,12 +203,16 @@ data SpecType =
   | DataTypeRecord Meta Bool [(Name, Type)]
   | Protocol Meta [Type]
   | ProtocolCase Meta [(Name, [Type])]
-  | Proc Meta [Formal] Process
-  | Function Meta [Type] [Formal] Structured
+  | Proc Meta SpecMode [Formal] Process
+  | Function Meta SpecMode [Type] [Formal] Structured
   | Retypes Meta AbbrevMode Type Variable
   | RetypesExpr Meta AbbrevMode Type Expression
   deriving (Show, Eq, Typeable, Data)
 
+data SpecMode =
+  PlainSpec | InlineSpec
+  deriving (Show, Eq, Typeable, Data)
+
 data Formal =
   Formal AbbrevMode Type Name
   deriving (Show, Eq, Typeable, Data)

fco2/GenerateC.hs

@@ -957,8 +957,9 @@ introduceSpec (A.Specification _ n (A.ProtocolCase _ ts))
           tell ["} "]
           genName n
           tell [";\n"]
-introduceSpec (A.Specification _ n (A.Proc _ fs p))
-    =  do tell ["void "]
+introduceSpec (A.Specification _ n (A.Proc _ sm fs p))
+    =  do genSpecMode sm
+          tell ["void "]
           genName n
           tell [" (Process *me"]
           genFormals fs
@@ -989,6 +990,10 @@ removeSpec (A.Specification m n (A.Declaration _ t))
   where
     var = A.Variable m n
 removeSpec _ = return ()
+
+genSpecMode :: A.SpecMode -> CGen ()
+genSpecMode A.PlainSpec = return ()
+genSpecMode A.InlineSpec = tell ["inline "]
 --}}}
 
 --{{{  actuals/formals

fco2/LANGUAGE

@@ -8,8 +8,7 @@ Everything in occam2.1, minus:
 
 KRoC's TLP interface.
 
-INLINE PROC, although it's ignored (because it should be up to the C compiler
-what gets inlined).
+INLINE PROC and INLINE FUNCTION.
 
 Intrinsics:
 - ASSERT

fco2/Parse.hs

@@ -879,7 +879,7 @@ functionSingle :: OccParser A.Expression
 functionSingle
     =  do m <- md
           n <- tryVX (functionNameValued False) sLeftR
-          A.Function _ _ fs _ <- specTypeOfName n
+          A.Function _ _ _ fs _ <- specTypeOfName n
           as <- functionActuals fs
           sRightR
           return $ A.FunctionCall m n as
@@ -889,7 +889,7 @@ functionMulti :: [A.Type] -> OccParser A.ExpressionList
 functionMulti types
     =  do m <- md
           n <- tryVX (functionNameValued True) sLeftR
-          A.Function _ _ fs _ <- specTypeOfName n
+          A.Function _ _ _ fs _ <- specTypeOfName n
           as <- functionActuals fs
           sRightR
           rts <- returnTypesOfFunction n
@@ -1216,6 +1216,14 @@ chanArrayAbbrev
            return $ A.Specification m n $ A.IsChannelArray m s cs
     <?> "channel array abbreviation"
 
+specMode :: OccParser () -> OccParser A.SpecMode
+specMode keyword
+    =   do tryXX sINLINE keyword
+           return A.InlineSpec
+    <|> do keyword
+           return A.PlainSpec
+    <?> "specification mode"
+
 definition :: OccParser A.Specification
 definition
     =   do m <- md
@@ -1230,8 +1238,7 @@ definition
            do { sIS; p <- sequentialProtocol; sColon; eol; return $ A.Specification m n $ A.Protocol m p }
              <|> do { eol; indent; sCASE; eol; ps <- maybeIndentedList m "empty CASE protocol" taggedProtocol; outdent; sColon; eol; return $ A.Specification m n $ A.ProtocolCase m ps }
     <|> do m <- md
-           -- FIXME INLINE is ignored.
-           sPROC <|> (tryXX sINLINE sPROC)
+           sm <- specMode sPROC
            n <- newProcName
            fs <- formalList
            eol
@@ -1242,14 +1249,13 @@ definition
            outdent
            sColon
            eol
-           return $ A.Specification m n $ A.Proc m fs' p
+           return $ A.Specification m n $ A.Proc m sm fs' p
     <|> do m <- md
-           -- FIXME INLINE is ignored.
-           rs <- tryVX (sepBy1 dataType sComma) (sFUNCTION <|> tryXX sINLINE sFUNCTION)
+           (rs, sm) <- tryVV (sepBy1 dataType sComma) (specMode sFUNCTION)
            n <- newFunctionName
            fs <- formalList
-           do { sIS; fs' <- scopeInFormals fs; el <- expressionList rs; scopeOutFormals fs'; sColon; eol; return $ A.Specification m n $ A.Function m rs fs' (A.OnlyEL m el) }
-             <|> do { eol; indent; fs' <- scopeInFormals fs; vp <- valueProcess rs; scopeOutFormals fs'; outdent; sColon; eol; return $ A.Specification m n $ A.Function m rs fs' vp }
+           do { sIS; fs' <- scopeInFormals fs; el <- expressionList rs; scopeOutFormals fs'; sColon; eol; return $ A.Specification m n $ A.Function m sm rs fs' (A.OnlyEL m el) }
+             <|> do { eol; indent; fs' <- scopeInFormals fs; vp <- valueProcess rs; scopeOutFormals fs'; outdent; sColon; eol; return $ A.Specification m n $ A.Function m sm rs fs' vp }
     <|> retypesAbbrev
     <?> "definition"
 
@@ -1774,7 +1780,7 @@ procInstance
     =  do m <- md
           n <- tryVX procName sLeftR
           st <- specTypeOfName n
-          let fs = case st of A.Proc _ fs _ -> fs
+          let fs = case st of A.Proc _ _ fs _ -> fs
           as <- actuals fs
           sRightR
           eol

fco2/ParseState.hs

@@ -170,7 +170,7 @@ defineNonce m s st nt am
 -- | Generate and define a no-arg wrapper PROC around a process.
 makeNonceProc :: PSM m => Meta -> A.Process -> m A.Specification
 makeNonceProc m p
-    = defineNonce m "wrapper_proc" (A.Proc m [] p) A.ProcName A.Abbrev
+    = defineNonce m "wrapper_proc" (A.Proc m A.PlainSpec [] p) A.ProcName A.Abbrev
 
 -- | Generate and define a variable abbreviation.
 makeNonceIs :: PSM m => String -> Meta -> A.Type -> A.AbbrevMode -> A.Variable -> m A.Specification

fco2/SimplifyExprs.hs

@@ -28,7 +28,7 @@ functionsToProcs = doGeneric `extM` doSpecification
     doGeneric = gmapM functionsToProcs
 
     doSpecification :: A.Specification -> PassM A.Specification
-    doSpecification (A.Specification m n (A.Function mf rts fs vp))
+    doSpecification (A.Specification m n (A.Function mf sm rts fs vp))
         = do -- Create new names for the return values.
              specs <- sequence [makeNonceVariable "return_formal" mf t A.VariableName A.Abbrev | t <- rts]
              let names = [n | A.Specification mf n _ <- specs]
@@ -36,7 +36,7 @@ functionsToProcs = doGeneric `extM` doSpecification
              modify $ (\ps -> ps { psFunctionReturns = (A.nameName n, rts) : psFunctionReturns ps })
              -- Turn the value process into an assignment process.
              let p = A.Seq mf $ vpToSeq vp [A.Variable mf n | n <- names]
-             let st = A.Proc mf (fs ++ [A.Formal A.Abbrev t n | (t, n) <- zip rts names]) p
+             let st = A.Proc mf sm (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
              let nd = A.NameDef {

fco2/TLP.hs

@@ -24,7 +24,7 @@ tlpInterface
           let mainName = snd $ head $ psMainLocals ps
           st <- specTypeOfName mainName
           formals <- case st of
-                       A.Proc _ fs _ -> return fs
+                       A.Proc _ _ fs _ -> return fs
                        _ -> die "Last definition is not a PROC"
           chans <- mapM tlpChannel formals
           when ((nub chans) /= chans) $ die "Channels used more than once in TLP"

fco2/TODO

@@ -29,9 +29,6 @@ Add an option for whether to compile out overflow/bounds checks.
 
 Record literals aren't implemented.
 
-Inline PROCs and FUNCTIONs should be marked with a flag in the AST (i.e. they
-should be ignored at the C generation stage, rather than in the parser).
-
 Inline C code should be supported; say something like "INLINE "C"" and the
 block indented inside that gets passed through to the C source, with local
 names in it replaced appropriately.

fco2/Types.hs

@@ -165,7 +165,7 @@ returnTypesOfFunction :: (PSM m, Die m) => A.Name -> m [A.Type]
 returnTypesOfFunction n
     =  do st <- specTypeOfName n
           case st of
-            A.Function m rs fs vp -> return rs
+            A.Function _ _ rs _ _ -> return rs
             -- If it's not defined as a function, it might have been converted to a proc.
             _ ->
               do ps <- get

fco2/Unnest.hs

@@ -52,8 +52,8 @@ freeNamesIn = doGeneric `extQ` doName `extQ` doStructured `extQ` doSpecType
           A.For _ n b c -> (n, Map.union (freeNamesIn b) (freeNamesIn c))
 
     doSpecType :: A.SpecType -> NameMap
-    doSpecType (A.Proc _ fs p) = Map.difference (freeNamesIn p) (freeNamesIn fs)
-    doSpecType (A.Function _ _ fs vp) = Map.difference (freeNamesIn vp) (freeNamesIn fs)
+    doSpecType (A.Proc _ _ fs p) = Map.difference (freeNamesIn p) (freeNamesIn fs)
+    doSpecType (A.Function _ _ _ fs vp) = Map.difference (freeNamesIn vp) (freeNamesIn fs)
     doSpecType st = doGeneric st
 
 -- | Replace names.
@@ -77,8 +77,8 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
 
     doSpecification :: A.Specification -> PassM A.Specification
     doSpecification spec = case spec of
-        A.Specification m n st@(A.Proc _ _ _) ->
-          do st'@(A.Proc _ fs p) <- removeFreeNames st
+        A.Specification m n st@(A.Proc _ _ _ _) ->
+          do st'@(A.Proc mp sm fs p) <- removeFreeNames st
 
              -- If this is the top-level process, we shouldn't add new args --
              -- we know it's not going to be moved by removeNesting, so anything
@@ -112,7 +112,7 @@ removeFreeNames = doGeneric `extM` doSpecification `extM` doProcess
 
              -- Add formals for each of the free names
              let newFs = [A.Formal am t n | (am, t, n) <- zip3 ams types newNames]
-             let st'' = A.Proc m (fs ++ newFs) $ replaceNames (zip freeNames newNames) p
+             let st'' = A.Proc mp sm (fs ++ newFs) $ replaceNames (zip freeNames newNames) p
              let spec' = A.Specification m n st''
 
              -- Update the definition of the proc
@@ -168,7 +168,7 @@ removeNesting p
     doStructured s = doGeneric s
 
     canPull :: A.SpecType -> Bool
-    canPull (A.Proc _ _ _) = True
+    canPull (A.Proc _ _ _ _) = True
     canPull (A.DataType _ _) = True
     canPull (A.DataTypeRecord _ _ _) = True
     canPull (A.Protocol _ _) = True

fco2/testcases/inline.occ

@@ -0,0 +1,18 @@
+INT INLINE FUNCTION negate (VAL INT v) IS -v:
+INT INLINE FUNCTION negate2 (VAL INT v)
+  VALOF
+    SKIP
+    RESULT -v
+:
+INLINE PROC test.negate ()
+  INT x:
+  SEQ
+    x := 42
+    x := negate (x)
+    ASSERT (x = (-42))
+    x := negate2 (x)
+    ASSERT (x = 42)
+:
+PROC P ()
+  test.negate ()
+: