From 7722e95dfd4c64c47a33285a10b40420bce09226 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Thu, 29 Jan 2009 00:27:11 +0000 Subject: [PATCH] Added support for recursive functions (not procs, yet) At the moment, the information is only needed in the parser, which must define recursive names before parsing the body of the function. But in future, we should keep the information when the function becomes a proc, and then the C/C++ backends may need to use it (for example, when calculating stack space usage) --- data/AST.hs | 9 ++++- frontends/LexOccam.x | 2 +- frontends/ParseOccam.hs | 57 ++++++++++++++++++++++++-------- frontends/ParseRain.hs | 2 +- transformations/SimplifyExprs.hs | 2 +- 5 files changed, 54 insertions(+), 18 deletions(-) diff --git a/data/AST.hs b/data/AST.hs index de6d9bd..9631187 100644 --- a/data/AST.hs +++ b/data/AST.hs @@ -501,7 +501,7 @@ data SpecType = -- | Declare a @PROC@. | Proc Meta SpecMode [Formal] Process -- | Declare a @FUNCTION@. - | Function Meta SpecMode [Type] [Formal] + | Function Meta (SpecMode, RecMode) [Type] [Formal] (Either (Structured ExpressionList) Process) -- | Declare a retyping abbreviation of a variable. | Retypes Meta AbbrevMode Type Variable @@ -521,6 +521,13 @@ data SpecMode = PlainSpec | InlineSpec deriving (Show, Eq, Typeable, Data) +-- | Recursive mode for @PROC@s and @FUNCTION@s. +-- This indicates whether a function/proc can call itself, for which it must be +-- in scope during its own definition +data RecMode = + PlainRec | Recursive + deriving (Show, Eq, Typeable, Data) + -- | Formal parameters for @PROC@s and @FUNCTION@s. data Formal = Formal AbbrevMode Type Name diff --git a/frontends/LexOccam.x b/frontends/LexOccam.x index 9f40434..a581c6d 100644 --- a/frontends/LexOccam.x +++ b/frontends/LexOccam.x @@ -64,7 +64,7 @@ $vertSpace = [\r\n] | "OF" | "OFFSETOF" | "OR" | "PACKED" | "PAR" | "PLACE" | "PLACED" | "PLUS" | "PORT" | "PRI" | "PROC" | "PROCESSOR" | "PROTOCOL" - | "REAL32" | "REAL64" | "RECORD" | "REM" | "RESHAPES" + | "REAL32" | "REAL64" | "REC" | "RECORD" | "RECURSIVE" | "REM" | "RESHAPES" | "RESULT" | "RETYPES" | "ROUND" | "SEQ" | "SIZE" | "SKIP" | "STEP" | "STOP" | "TIMER" | "TIMES" | "TRUE" | "TRUNC" | "TYPE" diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index 85bc458..d7b0ee1 100644 --- a/frontends/ParseOccam.hs +++ b/frontends/ParseOccam.hs @@ -113,10 +113,10 @@ sAFTER, sALT, sAND, sANY, sAT, sBITAND, sBITNOT, sBITOR, sBOOL, sBYTE, sBYTESIN, sCASE, sCHAN, sDATA, sELSE, sFALSE, sFOR, sFROM, sFUNCTION, sIF, sINLINE, sIN, sINITIAL, sINT, sINT16, sINT32, sINT64, sIS, sMINUS, sMOSTNEG, sMOSTPOS, sNOT, sOF, sOFFSETOF, sOR, sPACKED, sPAR, sPLACE, sPLACED, sPLUS, - sPORT, sPRI, sPROC, sPROCESSOR, sPROTOCOL, sREAL32, sREAL64, sRECORD, sREM, - sRESHAPES, sRESULT, sRETYPES, sROUND, sSEQ, sSIZE, sSKIP, sSTEP, sSTOP, - sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, sWHILE, sWORKSPACE, - sVECSPACE + sPORT, sPRI, sPROC, sPROCESSOR, sPROTOCOL, sREAL32, sREAL64, sRECORD, + sREC_RECURSIVE, sREM, sRESHAPES, sRESULT, sRETYPES, sROUND, sSEQ, sSIZE, + sSKIP, sSTEP, sSTOP, sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, + sWHILE, sWORKSPACE, sVECSPACE :: OccParser () sAFTER = reserved "AFTER" @@ -166,6 +166,7 @@ sPROCESSOR = reserved "PROCESSOR" sPROTOCOL = reserved "PROTOCOL" sREAL32 = reserved "REAL32" sREAL64 = reserved "REAL64" +sREC_RECURSIVE = reserved "REC" <|> reserved "RECURSIVE" sRECORD = reserved "RECORD" sREM = reserved "REM" sRESHAPES = reserved "RESHAPES" @@ -398,9 +399,17 @@ scopeOutRep n = scopeOut n type NameSpec = (A.Specification, NameType) scopeInSpec :: NameSpec -> OccParser A.Specification -scopeInSpec (A.Specification m n st, nt) +scopeInSpec (spec@(A.Specification m n st), nt) + -- If it's recursive, the spec has already been defined: + | isRecursive st + = do modifyName n $ \nd -> nd {A.ndSpecType = st} + return spec + | otherwise = do n' <- scopeIn n nt st (abbrevModeOfSpec st) return $ A.Specification m n' st + where + isRecursive (A.Function _ (_, A.Recursive) _ _ _) = True + isRecursive _ = False scopeOutSpec :: A.Specification -> OccParser () scopeOutSpec (A.Specification _ n _) = scopeOut n @@ -1049,14 +1058,22 @@ chanArrayAbbrev return (A.Specification m n $ A.IsChannelArray m t' cs, ChannelName) "channel array abbreviation" -specMode :: OccParser () -> OccParser A.SpecMode +specMode :: OccParser a -> OccParser (A.SpecMode, a) specMode keyword - = do tryXX sINLINE keyword - return A.InlineSpec - <|> do keyword - return A.PlainSpec + = do x <- tryXV sINLINE keyword + return (A.InlineSpec, x) + <|> do x <- keyword + return (A.PlainSpec, x) "specification mode" +recMode :: OccParser a -> OccParser (A.RecMode, a) +recMode keyword + = do x <- tryXV sREC_RECURSIVE keyword + return (A.Recursive, x) + <|> do x <- keyword + return (A.PlainRec, x) + "recursion mode" + definition :: OccParser NameSpec definition = do m <- md @@ -1070,7 +1087,7 @@ definition do { sIS; p <- sequentialProtocol; sColon; eol; return (A.Specification m n $ A.Protocol m p, ProtocolName) } <|> do { eol; indent; sCASE; eol; ps <- maybeIndentedList m "empty CASE protocol" taggedProtocol; outdent; sColon; eol; return (A.Specification m n $ A.ProtocolCase m ps, ProtocolName) } <|> do m <- md - sm <- specMode sPROC + (sm, _) <- specMode sPROC n <- newProcName fs <- formalList eol @@ -1083,11 +1100,23 @@ definition eol return (A.Specification m n $ A.Proc m sm fs' p, ProcName) <|> do m <- md - (rs, sm) <- tryVV (sepBy1 dataType sComma) (specMode sFUNCTION) + (rs, (sm, (rm, _))) <- tryVV (sepBy1 dataType sComma) (specMode $ recMode sFUNCTION) n <- newFunctionName fs <- formalList - do { sIS; fs' <- scopeInFormals fs; el <- expressionList; scopeOutFormals fs'; sColon; eol; return (A.Specification m n $ A.Function m sm rs fs' (Left $ A.Only m el), FunctionName) } - <|> do { eol; indent; fs' <- scopeInFormals fs; vp <- valueProcess; scopeOutFormals fs'; outdent; sColon; eol; return (A.Specification m n $ A.Function m sm rs fs' (Left vp), FunctionName) } + 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.Original + else return n + fs' <- scopeInFormals fs + x <- body + 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) } + <|> 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) } <|> retypesAbbrev "definition" diff --git a/frontends/ParseRain.hs b/frontends/ParseRain.hs index b553eca..7cd6c5c 100644 --- a/frontends/ParseRain.hs +++ b/frontends/ParseRain.hs @@ -500,7 +500,7 @@ processDecl = do {m <- sProcess ; procName <- name ; params <- tupleDef ; body < 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 [retType] (formaliseTuple params) (Right $ A.Seq m body))) + (A.Specification m funcName (A.Function m (A.PlainSpec, A.Recursive) [retType] (formaliseTuple params) (Right $ A.Seq m body))) terminator} topLevelDecl :: RainParser A.AST diff --git a/transformations/SimplifyExprs.hs b/transformations/SimplifyExprs.hs index ead1251..afa085e 100644 --- a/transformations/SimplifyExprs.hs +++ b/transformations/SimplifyExprs.hs @@ -53,7 +53,7 @@ functionsToProcs = pass "Convert FUNCTIONs to PROCs" (applyDepthM doSpecification) where doSpecification :: A.Specification -> PassM A.Specification - doSpecification (A.Specification m n (A.Function mf sm rts fs evp)) + doSpecification (A.Specification m n (A.Function mf (sm, _) rts fs evp)) = do -- Create new names for the return values. specs <- sequence [makeNonceVariable "return_formal" mf t A.Abbrev | t <- rts] let names = [n | A.Specification mf n _ <- specs]