Added lexing, parsing and type-checking support for FORKING and FORK

common/ShowCode.hs

@@ -241,7 +241,6 @@ instance ShowOccam A.Type where
   showOccamM A.Any = tell ["ANY"]
   showOccamM (A.Timer _) = tell ["TIMER"]
   showOccamM A.Time = tell ["TIME"]
-  showOccamM A.Infer = tell ["inferred-type"]
   showOccamM (A.UnknownVarType _ en)
     = do tell ["(inferred type for: "]
          either showName (tell . (:[]) . show) en
@@ -472,6 +471,8 @@ instance ShowOccam A.Specification where
     = showOccamLine $ (maybeVal am) >> showOccamM t >> space >> showName n >> tell [" IS "] >> showOccamM v >> colon
   showOccamM (A.Specification _ n (A.DataType _ t))
     = showOccamLine $ tell ["DATA TYPE "] >> showName n >> tell [" IS "] >> showOccamM t >> colon
+  showOccamM (A.Specification _ n (A.Forking _))
+    = showOccamLine $ tell ["FORKING --"] >> showName n
   showOccamM (A.Specification _ n (A.RecordType _ attr fields))
     = do (showOccamLine $ tell ["DATA TYPE "] >> showName n)
          occamIndent
@@ -624,6 +625,9 @@ instance ShowOccam A.Process where
   --TODO gettime and wait ?
   
   showOccamM (A.ProcCall _ n params) = showOccamLine $ showName n >> tell [" ( "] >> showWithCommas params >> tell [" ) "]
+  showOccamM (A.Fork _ Nothing p) = showOccamLine $ tell ["FORK "] >> showOccamM p
+  showOccamM (A.Fork _ (Just n) p) = showOccamLine $ tell ["FORK "] >> showOccamM p
+    >> tell [" --"] >> showName n
   showOccamM (A.IntrinsicProcCall _ n params) = showOccamLine $ tell [n, " ( "] >> showWithCommas params >> tell [" ) "]
   showOccamM (A.While _ e p) = (showOccamLine $ tell ["WHILE "] >> showOccamM e) >> occamIndent >> showOccamM p >> occamOutdent
   showOccamM (A.Case _ e s) = (showOccamLine $ tell ["CASE "] >> showOccamM e) >> occamBlock (showOccamM s)

common/Types.hs

@@ -127,6 +127,7 @@ typeOfSpec' st
                    A.List t' -> return $ Just (t', error "typeOfSpec'")
                    A.Array _ t' -> return $ Just (t', error "typeOfSpec'")
                    _ -> return Nothing
+            A.Forking m -> return $ Just (A.Barrier, const $ A.Forking m)
             _ -> return Nothing
 
 typeOfSpec :: (CSMR m, Die m) => A.SpecType -> m (Maybe A.Type)

frontends/LexOccam.x

@@ -60,7 +60,7 @@ $vertSpace = [\r\n]
           | "CASE" | "CHAN" | "CLAIM" | "CLONE"
           | "DATA" | "DEFINED"
           | "ELSE"
-          | "FALSE" | "FOR" | "FROM" | "FUNCTION"
+          | "FALSE" | "FOR" | "FORK" | "FORKING" | "FROM" | "FUNCTION"
           | "IF" | "IN" | "INITIAL" | "INLINE" | "INT" | "INT16" | "INT32" | "INT64"
           | "IS"
           | "MINUS" | "MOBILE" | "MOSTNEG" | "MOSTPOS"

frontends/OccamTypes.hs

@@ -1414,6 +1414,7 @@ checkSpecTypes = checkDepthM doSpecType
     doSpecType :: Check A.SpecType
     doSpecType (A.Place _ e) = checkExpressionInt e
     doSpecType (A.Declaration _ _) = ok
+    doSpecType (A.Forking _) = ok
     doSpecType (A.Is m am t (A.ActualVariable v))
         =  do tv <- astTypeOf v
               checkType (findMeta v) t tv
@@ -1564,6 +1565,7 @@ checkProcesses = checkDepthM doProcess
     doProcess (A.ProcCall m n as)
         =  do fs <- checkProc m n
               checkActuals m n fs as
+    doProcess (A.Fork _ _ p) = doProcess p
     doProcess (A.IntrinsicProcCall m n as)
         = case lookup n intrinsicProcs of
             Just args ->

frontends/ParseOccam.hs

@@ -140,14 +140,13 @@ sSemi = reserved ";"
 
 sAFTER, sALT, sAND, sANY, sAT, sBITAND, sBITNOT, sBITOR, sBOOL, sBYTE,
   sBYTESIN, sCASE, sCHAN, sCLAIM, sCLONE, sDATA, sDEFINED, sELSE, sFALSE,
-  sFOR, sFROM, sFUNCTION, sIF, sINLINE, sIN, sINITIAL, sINT, sINT16, sINT32,
-  sINT64, sIS, sMINUS, sMOBILE, sMOSTNEG, sMOSTPOS, sNOT, sOF, sOFFSETOF, sOR,
-  sPACKED, sPAR, sPLACE, sPLACED, sPLUS, sPORT, sPRI, sPROC, sPROCESSOR,
-  sPROTOCOL, sREAL32, sREAL64, sRECORD, sREC_RECURSIVE, sREM, sRESHAPES,
-  sRESULT, sRETYPES, sROUND, sSEQ, sSHARED, sSIZE, sSKIP, sSTEP, sSTOP,
-  sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, sWHILE, sWORKSPACE,
-  sVECSPACE
-    :: OccParser ()
+  sFOR, sFORK, sFORKING, sFROM, sFUNCTION, sIF, sINLINE, sIN, sINITIAL, sINT,
+  sINT16, sINT32, sINT64, sIS, sMINUS, sMOBILE, sMOSTNEG, sMOSTPOS, sNOT, sOF,
+  sOFFSETOF, sOR, sPACKED, sPAR, sPLACE, sPLACED, sPLUS, sPORT, sPRI, sPROC,
+  sPROCESSOR, sPROTOCOL, sREAL32, sREAL64, sRECORD, sREC_RECURSIVE, sREM,
+  sRESHAPES, sRESULT, sRETYPES, sROUND, sSEQ, sSHARED, sSIZE, sSKIP, sSTEP,
+  sSTOP, sTIMER, sTIMES, sTRUE, sTRUNC, sTYPE, sVAL, sVALOF, sWHILE,
+  sWORKSPACE, sVECSPACE :: OccParser ()
 
 sAFTER = reserved "AFTER"
 sALT = reserved "ALT"
@@ -169,6 +168,8 @@ sDEFINED = reserved "DEFINED"
 sELSE = reserved "ELSE"
 sFALSE = reserved "FALSE"
 sFOR = reserved "FOR"
+sFORK = reserved "FORK"
+sFORKING = reserved "FORKING"
 sFROM = reserved "FROM"
 sFUNCTION = reserved "FUNCTION"
 sIF = reserved "IF"
@@ -1545,6 +1546,29 @@ process
     <|> intrinsicProc
     <|> handleSpecs (allocation <|> specification <|> claimSpec) process
                     (\m s p -> A.Seq m (A.Spec m s (A.Only m p)))
+    <|> do m <- md
+           sFORKING
+           eol
+           indent
+           p <- process
+           outdent
+           n <- makeNonce m "fork" >>* A.Name m
+           let spec = A.Specification m n $ A.Forking m
+           let nd = A.NameDef {
+            A.ndMeta = m,
+            A.ndName = A.nameName n,
+            A.ndOrigName = "FORKING",
+            A.ndSpecType = A.Forking m,
+            A.ndAbbrevMode = A.Original,
+            A.ndNameSource = A.NameNonce,
+            A.ndPlacement = A.Unplaced
+            }
+           defineName n nd
+           return $ A.Seq m $ A.Spec m spec $ A.Only m p
+    <|> do m <- md
+           sFORK
+           p <- procInstance
+           return $ A.Fork m Nothing p
     <?> "process"
 
 claimSpec :: OccParser ([NameSpec], OccParser ())