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

@@ -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

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"

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,
+  sPORT, sPRI, sPROC, sPROCESSOR, sPROTOCOL, sREAL32, sREAL64, sRECORD,
-  sRESHAPES, sRESULT, sRETYPES, sROUND, sSEQ, sSIZE, sSKIP, sSTEP, sSTOP,
+  sREC_RECURSIVE, sREM, sRESHAPES, sRESULT, sRETYPES, sROUND, sSEQ, sSIZE,
-  sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, sWHILE, sWORKSPACE,
+  sSKIP, sSTEP, sSTOP, sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF,
-  sVECSPACE
+  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
+    =   do x <- tryXV sINLINE keyword
-           return A.InlineSpec
+           return (A.InlineSpec, x)
-    <|> do keyword
+    <|> do x <- keyword
-           return A.PlainSpec
+           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) }
+           let addScope body
-             <|> 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) }
+                 = 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"
 

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

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]