Added various keywords, AST elements and parser bits related to channel bundles, claim blocks and shared channels

data/AST.hs

@@ -124,6 +124,8 @@ data Type =
   | List Type
   -- | A user-defined data type.
   | UserDataType Name
+  -- | An end of a channel bundle
+  | ChanDataType Direction ShareMode Name
   -- | A record type.
   | Record Name
   -- | A user-defined protocol.
@@ -491,6 +493,8 @@ data SpecType =
   -- | Declare a new record type.
   -- The list is the fields of the record.
   | RecordType Meta RecordAttr [(Name, Type)]
+  -- | Declares a mobile channel bundle.
+  | ChanBundleType Meta RecMode [(Name, Type)]
   -- | Declare a simple protocol.
   -- The list contains the types of the items.
   | Protocol Meta [Type]
@@ -581,6 +585,7 @@ data Process =
   -- This may go away in the future, since which @PROC@s are intrinsics depends
   -- on the backend.
   | IntrinsicProcCall Meta String [Actual]
+  | Claim Meta Variable Process
   deriving (Show, Eq, Typeable, Data)
 
 -- | The top level of the AST: a sequence of definitions.

data/CompState.hs

@@ -61,7 +61,7 @@ data PreprocDef =
 -- particular context; in later passes you can look at how the name is actually
 -- defined, which is more useful.
 data NameType =
-  ChannelName | DataTypeName | FunctionName | FieldName | PortName
+  ChannelName | ChanBundleName | DataTypeName | FunctionName | FieldName | PortName
   | ProcName | ProtocolName | RecordName | TagName | TimerName | VariableName
   deriving (Show, Eq, Typeable, Data)
 

frontends/LexOccam.x

@@ -53,7 +53,7 @@ $vertSpace = [\r\n]
           | "|"
           | "AFTER" | "ALT" | "AND" | "ANY" | "AT"
           | "BITAND" | "BITNOT" | "BITOR" | "BOOL" | "BYTE" | "BYTESIN"
-          | "CASE" | "CHAN" | "CLONE"
+          | "CASE" | "CHAN" | "CLAIM" | "CLONE"
           | "DATA" | "DEFINED"
           | "ELSE"
           | "FALSE" | "FOR" | "FROM" | "FUNCTION"
@@ -66,7 +66,7 @@ $vertSpace = [\r\n]
           | "PRI" | "PROC" | "PROCESSOR" | "PROTOCOL"
           | "REAL32" | "REAL64" | "REC" | "RECORD" | "RECURSIVE" | "REM" | "RESHAPES"
           | "RESULT" | "RETYPES" | "ROUND"
-          | "SEQ" | "SIZE" | "SKIP" | "STEP" | "STOP"
+          | "SEQ" | "SHARED" | "SIZE" | "SKIP" | "STEP" | "STOP"
           | "TIMER" | "TIMES" | "TRUE" | "TRUNC" | "TYPE"
           | "VAL" | "VALOF"
           | "WHILE" | "WORKSPACE"

frontends/ParseOccam.hs

@@ -110,14 +110,16 @@ sRightR = reserved ")"
 sSemi = reserved ";"
 --}}}
 --{{{ keywords
+
 sAFTER, sALT, sAND, sANY, sAT, sBITAND, sBITNOT, sBITOR, sBOOL, sBYTE,
-  sBYTESIN, sCASE, sCHAN, 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, sSIZE, sSKIP, sSTEP, sSTOP, sTIMER, sTIMES, sTRUE,
-  sTRUNC, sTYPE, sVAL, sVALOF, sWHILE, sWORKSPACE, sVECSPACE
+  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 ()
 
 sAFTER = reserved "AFTER"
@@ -133,6 +135,7 @@ sBYTE = reserved "BYTE"
 sBYTESIN = reserved "BYTESIN"
 sCASE = reserved "CASE"
 sCHAN = reserved "CHAN"
+sCLAIM = reserved "CLAIM"
 sCLONE = reserved "CLONE"
 sDATA = reserved "DATA"
 sDEFINED = reserved "DEFINED"
@@ -178,6 +181,7 @@ sRESULT = reserved "RESULT"
 sRETYPES = reserved "RETYPES"
 sROUND = reserved "ROUND"
 sSEQ = reserved "SEQ"
+sSHARED = reserved "SHARED"
 sSIZE = reserved "SIZE"
 sSKIP = reserved "SKIP"
 sSTEP = reserved "STEP"
@@ -464,11 +468,12 @@ name nt
 newName :: NameType -> OccParser A.Name
 newName nt = anyName nt
 
-channelName, dataTypeName, functionName, portName, procName, protocolName,
+channelName, chanBundleName, dataTypeName, functionName, portName, procName, protocolName,
   recordName, timerName, variableName
     :: OccParser A.Name
 
 channelName = name ChannelName
+chanBundleName = name ChanBundleName
 dataTypeName = name DataTypeName
 functionName = name FunctionName
 portName = name PortName
@@ -478,12 +483,13 @@ recordName = name RecordName
 timerName = name TimerName
 variableName = name VariableName
 
-newChannelName, newDataTypeName, newFunctionName, newPortName,
+newChannelName, newChanBundleName, newDataTypeName, newFunctionName, newPortName,
   newProcName, newProtocolName, newRecordName, newTimerName,
   newVariableName
     :: OccParser A.Name
 
 newChannelName = newName ChannelName
+newChanBundleName = newName ChanBundleName
 newDataTypeName = newName DataTypeName
 newFunctionName = newName FunctionName
 newPortName = newName PortName
@@ -539,6 +545,8 @@ dataType
     -- Mobile arrays can lack dimensions:
     <|> do { tryXV sMOBILE (specArrayType dataType) >>* A.Mobile }
     <|> do { tryXV sMOBILE dataType >>* A.Mobile }
+    <|> do { (n, dir) <- tryVV chanBundleName direction; return $ A.ChanDataType dir A.Unshared n }
+    <|> do { (n, dir) <- tryXVV sSHARED chanBundleName direction; return $ A.ChanDataType dir A.Shared n }
     <|> do { n <- try dataTypeName; return $ A.UserDataType n }
     <|> do { n <- try recordName; return $ A.Record n }
     <?> "data type"
@@ -872,6 +880,7 @@ channel
 channel' :: OccParser A.Variable
 channel'
     =   do { m <- md; n <- try channelName; return $ A.Variable m n }
+    <|> do { m <- md; n <- try variableName; return $ A.Variable m n }
     <|> maybeSliced directedChannel A.SubscriptedVariable
     <?> "channel'"
 
@@ -1094,8 +1103,26 @@ definition
     =   do m <- md
            sDATA
            sTYPE
-           do { n <- tryVX newDataTypeName sIS; t <- dataType; sColon; eol; return (A.Specification m n (A.DataType m t), DataTypeName) }
-             <|> do { n <- newRecordName; eol; indent; rec <- structuredType; outdent; sColon; eol; return (A.Specification m n rec, RecordName) }
+           do { n <- tryVX newDataTypeName sIS; t <- dataType; sColon; eol;
+                  return (A.Specification m n (A.DataType m t), DataTypeName) }
+             <|> do { n <- newRecordName; eol; indent; rec <- structuredType; outdent; sColon; eol;
+                  return (A.Specification m n rec, RecordName) }
+    <|> do m <- md
+           rec <- recMode sCHAN >>* fst
+           sTYPE
+           n <- newChanBundleName
+           eol
+           indent
+           sMOBILE
+           sRECORD
+           eol
+           indent
+           fs <- many1 chanInBundle
+           outdent
+           outdent
+           sColon
+           eol
+           return (A.Specification m n $ A.ChanBundleType m rec fs, ChanBundleName)
     <|> do m <- md
            sPROTOCOL
            n <- newProtocolName
@@ -1138,6 +1165,15 @@ definition
                 return (A.Specification m n' $ A.Function m (sm, rm) rs fs' (Left vp), FunctionName) }
     <|> retypesAbbrev
     <?> "definition"
+  where
+    chanInBundle :: OccParser (A.Name, A.Type)
+    chanInBundle = do sCHAN
+                      t <- protocol
+                      n <- newFieldName
+                      dir <- direction
+                      sColon
+                      eol
+                      return (n, A.ChanEnd dir (A.ChanAttributes A.Unshared A.Unshared) t)
 
 retypesAbbrev :: OccParser NameSpec
 retypesAbbrev
@@ -1360,6 +1396,8 @@ process
     <|> handleSpecs (allocation <|> specification) process
                     (\m s p -> A.Seq m (A.Spec m s (A.Only m p)))
     <|> (pragma >> process)
+    <|> do {m <- md; sCLAIM; v <- variable; eol; indent; p <- process; outdent;
+             return $ A.Claim m v p }
     <?> "process"
 
 --{{{ assignment (:=)