From 5f9d0c6429ae0ba6efc876181a60b098380ad41b Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Sun, 22 Mar 2009 22:49:49 +0000 Subject: [PATCH] Added various keywords, AST elements and parser bits related to channel bundles, claim blocks and shared channels --- data/AST.hs | 5 ++++ data/CompState.hs | 2 +- frontends/LexOccam.x | 4 +-- frontends/ParseOccam.hs | 60 +++++++++++++++++++++++++++++++++-------- 4 files changed, 57 insertions(+), 14 deletions(-) diff --git a/data/AST.hs b/data/AST.hs index 8c9a0d5..8dc6b38 100644 --- a/data/AST.hs +++ b/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. diff --git a/data/CompState.hs b/data/CompState.hs index 1d6234c..41cd3a3 100644 --- a/data/CompState.hs +++ b/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) diff --git a/frontends/LexOccam.x b/frontends/LexOccam.x index 6bd9508..feded8a 100644 --- a/frontends/LexOccam.x +++ b/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" diff --git a/frontends/ParseOccam.hs b/frontends/ParseOccam.hs index afbb922..09e62a9 100644 --- a/frontends/ParseOccam.hs +++ b/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 (:=)