diff --git a/fco2/AST.hs b/fco2/AST.hs index 7afe06d..fe98897 100644 --- a/fco2/AST.hs +++ b/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) diff --git a/fco2/GenerateC.hs b/fco2/GenerateC.hs index d61dfaa..2f80ef8 100644 --- a/fco2/GenerateC.hs +++ b/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 diff --git a/fco2/LANGUAGE b/fco2/LANGUAGE index ce7a5cb..5dac2b7 100644 --- a/fco2/LANGUAGE +++ b/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 diff --git a/fco2/Parse.hs b/fco2/Parse.hs index fc663dd..d245448 100644 --- a/fco2/Parse.hs +++ b/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 diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs index 90ffa9a..33b21e7 100644 --- a/fco2/ParseState.hs +++ b/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 diff --git a/fco2/SimplifyExprs.hs b/fco2/SimplifyExprs.hs index 634e176..5f65830 100644 --- a/fco2/SimplifyExprs.hs +++ b/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 { diff --git a/fco2/TLP.hs b/fco2/TLP.hs index 649f082..11882f8 100644 --- a/fco2/TLP.hs +++ b/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" diff --git a/fco2/TODO b/fco2/TODO index b7719dd..c0c3d95 100644 --- a/fco2/TODO +++ b/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. diff --git a/fco2/Types.hs b/fco2/Types.hs index 4ac4281..d111e93 100644 --- a/fco2/Types.hs +++ b/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 diff --git a/fco2/Unnest.hs b/fco2/Unnest.hs index fcc6bbf..3466c18 100644 --- a/fco2/Unnest.hs +++ b/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 diff --git a/fco2/testcases/inline.occ b/fco2/testcases/inline.occ new file mode 100644 index 0000000..8cbce3e --- /dev/null +++ b/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 () +: