More work.
This commit is contained in:
Adam Sampson
parent
38dbed77c4
commit
70a818cf32
171
fco/Parse.hs
171
fco/Parse.hs
|
|
@ -24,7 +24,7 @@ occamStyle
|
|||
, P.identLetter = alphaNum <|> char '.'
|
||||
, P.opStart = oneOf "+-/*"
|
||||
, P.reservedOpNames= []
|
||||
, P.reservedNames = ["CHAN", "OF", "BOOL", "BYTE", "INT", "INT16", "INT32", "INT64", "REAL32", "REAL64", "ANY", "FROM", "FOR", "VAL", "IS", "PLACE", "AT", "ALT", "PRI", "SKIP", "CASE", "ROUND", "TRUNC", "MOSTPOS", "MOSTNEG", "SIZE", "BYTESIN", "OFFSETOF", "TRUE", "FALSE", "MINUS", "BITNOT", "NOT", "SIZE", "AFTER"]
|
||||
, P.reservedNames = ["CHAN", "OF", "BOOL", "BYTE", "INT", "INT16", "INT32", "INT64", "REAL32", "REAL64", "ANY", "FROM", "FOR", "VAL", "IS", "PLACE", "AT", "ALT", "PRI", "SKIP", "STOP", "CASE", "ROUND", "TRUNC", "MOSTPOS", "MOSTNEG", "SIZE", "BYTESIN", "OFFSETOF", "TRUE", "FALSE", "MINUS", "BITNOT", "NOT", "SIZE", "AFTER", "DATA", "TYPE", "PROTOCOL", "PROC", "RETYPES", "RESHAPES", "FUNCTION", "VALOF", "RESULT", "RECORD", "PACKED"]
|
||||
, P.caseSensitive = True
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,8 @@ sPLACE = reserved "PLACE"
|
|||
sAT = reserved "AT"
|
||||
sALT = reserved "ALT"
|
||||
sPRI = reserved "PRI"
|
||||
sSKIP = reserved "AT"
|
||||
sSKIP = reserved "SKIP"
|
||||
sSTOP = reserved "STOP"
|
||||
sCASE = reserved "CASE"
|
||||
sROUND = reserved "ROUND"
|
||||
sTRUNC = reserved "TRUNC"
|
||||
|
|
@ -76,6 +77,17 @@ sOFFSETOF = reserved "OFFSETOF"
|
|||
sTRUE = reserved "TRUE"
|
||||
sFALSE = reserved "FALSE"
|
||||
sAFTER = reserved "AFTER"
|
||||
sDATA = reserved "DATA"
|
||||
sTYPE = reserved "TYPE"
|
||||
sPROTOCOL = reserved "PROTOCOL"
|
||||
sPROC = reserved "PROC"
|
||||
sRETYPES = reserved "RETYPES"
|
||||
sRESHAPES = reserved "RESHAPES"
|
||||
sFUNCTION = reserved "FUNCTION"
|
||||
sVALOF = reserved "VALOF"
|
||||
sRESULT = reserved "RESULT"
|
||||
sRECORD = reserved "RECORD"
|
||||
sPACKED = reserved "PACKED"
|
||||
|
||||
sIn = symbol "{"
|
||||
sOut = symbol "}"
|
||||
|
|
@ -95,6 +107,7 @@ abbreviation
|
|||
<|> try (do { s <- specifier ; n <- name ; sIS ; v <- timer ; sColon ; return $ List [Item "is", s, n, v] })
|
||||
<|> try (do { n <- name ; sIS ; v <- port ; sColon ; return $ List [Item "is", n, v] })
|
||||
<|> do { s <- specifier ; n <- name ; sIS ; v <- port ; sColon ; return $ List [Item "is", s, n, v] }
|
||||
<?> "abbreviation"
|
||||
|
||||
actual
|
||||
= try variable
|
||||
|
|
@ -102,62 +115,77 @@ actual
|
|||
<|> try timer
|
||||
<|> try port
|
||||
<|> expression
|
||||
<?> "actual"
|
||||
|
||||
allocation
|
||||
= do { sPLACE ; n <- name ; sAT ; e <- expression ; return $ List [Item "place-at", n, e] }
|
||||
<?> "allocation"
|
||||
|
||||
alternation
|
||||
= try (do { sALT ; sIn ; as <- many1 alternative ; sOut ; return $ List ([Item "alt"] ++ as) })
|
||||
<|> try (do { sALT ; r <- replicator ; sIn ; a <- alternative ; sOut ; return $ List ([Item "alt", r, a]) })
|
||||
<|> try (do { sPRI ; sALT ; sIn ; as <- many1 alternative ; sOut ; return $ List ([Item "pri-alt"] ++ as) })
|
||||
<|> do { sPRI ; sALT ; r <- replicator ; sIn ; a <- alternative ; sOut ; return $ List ([Item "pri-alt", r, a]) }
|
||||
<?> "alternation"
|
||||
|
||||
alternative
|
||||
= try guardedAlternative
|
||||
<|> try alternation
|
||||
-- XXX case variants
|
||||
<|> try (do { c <- channel ; sQuest ; sCASE ; sIn ; vs <- many1 variant ; sOut ; return $ List ([Item "?case", c] ++ vs) })
|
||||
<|> try (do { b <- boolean ; sAmp ; c <- channel ; sQuest ; sCASE ; sIn ; vs <- many1 variant ; sOut ; return $ List ([Item "?case-guarded", b, c] ++ vs) })
|
||||
<|> do { s <- specification ; a <- alternative ; return $ List [Item ":", s, a] }
|
||||
<?> "alternative"
|
||||
|
||||
assignment
|
||||
= do { vs <- variableList ; sAssign ; es <- expressionList ; return $ List [Item ":=", vs, es] }
|
||||
<?> "assignment"
|
||||
|
||||
base
|
||||
= expression
|
||||
<?> "base"
|
||||
|
||||
boolean
|
||||
= expression
|
||||
<?> "boolean"
|
||||
|
||||
byte
|
||||
= do { char '\'' ; c <- character ; char '\'' ; return c }
|
||||
<?> "byte"
|
||||
|
||||
channel
|
||||
= do { v <- channel' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\ v e -> List [Item "sub", v, e]) v es }
|
||||
<?> "channel"
|
||||
|
||||
channel'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ List [Item "sub-from-for", n, e, f] })
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sRight ; return $ List [Item "sub-from", n, e] })
|
||||
<|> do { sLeft ; n <- channel ; sFOR ; e <- expression ; sRight ; return $ List [Item "sub-for", n, e] }
|
||||
<?> "channel'"
|
||||
|
||||
channelType
|
||||
= try (do { reserved "CHAN" ; reserved "OF" ; p <- protocol ; return $ List [Item "chan-of", p] })
|
||||
<|> do { sLeft ; s <- expression ; sRight ; t <- channelType ; return $ List [Item "array", s, t] }
|
||||
<?> "channelType"
|
||||
|
||||
-- XXX wrong
|
||||
character
|
||||
= do { l <- letter ; return $ Item [l] }
|
||||
<?> "character"
|
||||
|
||||
conversion
|
||||
= try (do { t <- dataType ; o <- operand ; return $ List [Item "conv", t, o] })
|
||||
<|> try (do { t <- dataType ; sROUND ; o <- operand ; return $ List [Item "round", t, o] })
|
||||
<|> do { t <- dataType ; sTRUNC ; o <- operand ; return $ List [Item "trunc", t, o] }
|
||||
<?> "conversion"
|
||||
|
||||
occamCount
|
||||
= expression
|
||||
<?> "count"
|
||||
|
||||
dataType
|
||||
= do { try (reserved "BOOL") ; return $ Item "bool" }
|
||||
<|> do { try (reserved "BYTE") ; return $ Item "bool" }
|
||||
<|> do { try (reserved "BYTE") ; return $ Item "byte" }
|
||||
<|> do { try (reserved "INT") ; return $ Item "int" }
|
||||
<|> do { try (reserved "INT16") ; return $ Item "int16" }
|
||||
<|> do { try (reserved "INT32") ; return $ Item "int32" }
|
||||
|
|
@ -175,12 +203,33 @@ declaration
|
|||
<|> try (do { d <- portType ; n <- name ; sColon ; return $ List [d, n] })
|
||||
<?> "declaration"
|
||||
|
||||
definition
|
||||
= try (do { sDATA ; sTYPE ; n <- name ; sIS ; t <- dataType ; sColon ; return $ List [Item "data-type", n, t] })
|
||||
<|> try (do { sDATA ; sTYPE ; n <- name ; sIn ; t <- structuredType ; sOut ; sColon ; return $ List [Item "data-type", n, t] })
|
||||
<|> try (do { sPROTOCOL ; n <- name ; sIS ; p <- simpleProtocol ; sColon ; return $ List [Item "protocol", n, p] })
|
||||
<|> try (do { sPROTOCOL ; n <- name ; sIS ; p <- sequentialProtocol ; sColon ; return $ List [Item "protocol", n, p] })
|
||||
<|> try (do { sPROTOCOL ; n <- name ; sIn ; sCASE ; sIn ; ps <- many1 taggedProtocol ; sOut ; sOut ; sColon ; return $ List [Item "protocol", n, List ps] })
|
||||
<|> try (do { sPROC ; n <- name ; fs <- formalList ; sIn ; p <- process ; sOut ; sColon ; return $ List [Item "proc", n, fs, p] })
|
||||
<|> try (do { rs <- sepBy1 dataType sComma ; (n, fs) <- functionHeader ; sIn ; vp <- valueProcess ; sOut ; sColon ; return $ List [Item "fun", List rs, n, fs, vp] })
|
||||
<|> try (do { rs <- sepBy1 dataType sComma ; (n, fs) <- functionHeader ; sIS ; el <- expressionList ; sColon ; return $ List [Item "fun-is", List rs, n, fs, el] })
|
||||
<|> try (do { s <- specifier ; n <- name ; sRETYPES ; v <- variable ; sColon ; return $ List [Item "retypes", s, n, v] })
|
||||
<|> try (do { sVAL ; s <- specifier ; n <- name ; sRETYPES ; v <- variable ; sColon ; return $ List [Item "val-retypes", s, n, v] })
|
||||
<|> try (do { s <- specifier ; n <- name ; sRETYPES ; v <- channel ; sColon ; return $ List [Item "retypes", s, n, v] })
|
||||
<|> try (do { s <- specifier ; n <- name ; sRETYPES ; v <- port ; sColon ; return $ List [Item "retypes", s, n, v] })
|
||||
<|> try (do { s <- specifier ; n <- name ; sRESHAPES ; v <- variable ; sColon ; return $ List [Item "reshapes", s, n, v] })
|
||||
<|> try (do { sVAL ; s <- specifier ; n <- name ; sRESHAPES ; v <- variable ; sColon ; return $ List [Item "val-reshapes", s, n, v] })
|
||||
<|> try (do { s <- specifier ; n <- name ; sRESHAPES ; v <- channel ; sColon ; return $ List [Item "reshapes", s, n, v] })
|
||||
<|> do { s <- specifier ; n <- name ; sRESHAPES ; v <- port ; sColon ; return $ List [Item "reshapes", s, n, v] }
|
||||
<?> "definition"
|
||||
|
||||
delayedInput
|
||||
= try (do { c <- channel ; sQuest ; sAFTER ; e <- expression ; return $ List [Item "?after", c, e] })
|
||||
<?> "delayedInput"
|
||||
|
||||
-- NB does not return an SExp
|
||||
digits
|
||||
= many1 digit
|
||||
<?> "digits"
|
||||
|
||||
dyadicOperator
|
||||
= try (do { reserved "+" ; return $ Item "+" })
|
||||
|
|
@ -206,6 +255,10 @@ dyadicOperator
|
|||
<|> try (do { reserved ">=" ; return $ Item ">=" })
|
||||
<|> try (do { reserved "<=" ; return $ Item "<=" })
|
||||
<|> try (do { sAFTER ; return $ Item "after" })
|
||||
<?> "dyadicOperator"
|
||||
|
||||
occamExponent
|
||||
= try (do { c <- oneOf "+-" ; d <- digits ; return $ c : d })
|
||||
|
||||
expression
|
||||
= try (do { o <- monadicOperator ; v <- operand ; return $ List [o, v] })
|
||||
|
|
@ -215,25 +268,50 @@ expression
|
|||
<|> try (do { a <- sSIZE ; t <- dataType ; return $ List [Item "size", t] })
|
||||
<|> try conversion
|
||||
<|> operand
|
||||
<?> "expression"
|
||||
|
||||
expressionList
|
||||
= try (do { es <- sepBy1 expression sSemi ; return $ List es })
|
||||
= try (do { es <- sepBy1 expression sComma ; return $ List es })
|
||||
<|> try (do { n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ List ([Item "call", n] ++ as) })
|
||||
-- XXX value process
|
||||
<?> "expressionList"
|
||||
|
||||
fieldName
|
||||
= name
|
||||
<?> "fieldName"
|
||||
|
||||
-- This is rather different from the grammar.
|
||||
formalList
|
||||
= do { sLeftR ; fs <- sepBy formalArg sComma ; sRightR ; return $ List (map List (reverse (reduce (reverse fs) []))) }
|
||||
where
|
||||
formalArg :: Parser ([[SExp]] -> [[SExp]])
|
||||
formalArg = try (do { sVAL ; s <- specifier ; n <- name ; return $ addToList [Item "val", s] n })
|
||||
<|> try (do { s <- specifier ; n <- name ; return $ addToList [s] n })
|
||||
<|> try (do { n <- name ; return $ addToList [] n })
|
||||
|
||||
addToList :: [SExp] -> SExp -> [[SExp]] -> [[SExp]]
|
||||
addToList [] n (l:ls) = (l ++ [n]) : ls
|
||||
addToList s n ls = (s ++ [n]) : ls
|
||||
|
||||
reduce [] x = x
|
||||
reduce (f:fs) x = f (reduce fs x)
|
||||
|
||||
functionHeader
|
||||
= do { sFUNCTION ; n <- name ; fs <- formalList ; return $ (n, fs) }
|
||||
|
||||
guard
|
||||
= try input
|
||||
<|> try (do { b <- boolean ; sAmp ; i <- input ; return $ List [Item "guarded", b, i] })
|
||||
<|> try (do { b <- boolean ; sAmp ; sSKIP ; return $ List [Item "guarded", b, Item "skip"] })
|
||||
<?> "guard"
|
||||
|
||||
guardedAlternative
|
||||
= do { g <- guard ; sIn ; p <- process ; sOut ; return $ List [g, p] }
|
||||
<?> "guardedAlternative"
|
||||
|
||||
hexDigits
|
||||
= do { d <- many1 hexDigit ; return $ Item d }
|
||||
<?> "hexDigits"
|
||||
|
||||
input
|
||||
= try (do { c <- channel ; sQuest ; is <- sepBy1 inputItem sSemi ; return $ List ([Item "?", c] ++ is) })
|
||||
|
|
@ -241,24 +319,28 @@ input
|
|||
<|> timerInput
|
||||
<|> delayedInput
|
||||
<|> do { p <- port ; sQuest ; v <- variable ; return $ List [Item "?", p, v] }
|
||||
<?> "input"
|
||||
|
||||
inputItem
|
||||
= try (do { v <- variable ; sColons ; w <- variable ; return $ List [Item "::", v, w] })
|
||||
<|> variable
|
||||
<?> "inputItem"
|
||||
|
||||
integer
|
||||
= try (do { d <- lexeme digits ; return $ Item d })
|
||||
<|> do { char '#' ; d <- lexeme hexDigits ; return $ Item ("#" ++ case d of Item ds -> ds) }
|
||||
<?> "integer"
|
||||
|
||||
literal
|
||||
= try integer
|
||||
= try real
|
||||
<|> try integer
|
||||
<|> try byte
|
||||
<|> try real
|
||||
<|> try (do { v <- real ; sLeftR ; t <- dataType ; sRightR ; return $ List [t, v] })
|
||||
<|> try (do { v <- integer ; sLeftR ; t <- dataType ; sRightR ; return $ List [t, v] })
|
||||
<|> try (do { v <- byte ; sLeftR ; t <- dataType ; sRightR ; return $ List [t, v] })
|
||||
<|> try (do { v <- real ; sLeftR ; t <- dataType ; sRightR ; return $ List [t, v] })
|
||||
<|> try (do { sTRUE ; return $ Item "true" })
|
||||
<|> do { sFALSE ; return $ Item "false" }
|
||||
<?> "literal"
|
||||
|
||||
monadicOperator
|
||||
= try (do { reserved "-" ; return $ Item "-" })
|
||||
|
|
@ -267,15 +349,19 @@ monadicOperator
|
|||
<|> try (do { reserved "BITNOT" ; return $ Item "bitnot" })
|
||||
<|> try (do { reserved "NOT" ; return $ Item "not" })
|
||||
<|> do { reserved "SIZE" ; return $ Item "size" }
|
||||
<?> "monadicOperator"
|
||||
|
||||
name
|
||||
= do { s <- identifier ; return $ Item s }
|
||||
<?> "name"
|
||||
|
||||
occamString
|
||||
= do { char '"' ; s <- many (noneOf "\"") ; char '"' ; return $ Item ("\"" ++ s ++ "\"") }
|
||||
<?> "string"
|
||||
|
||||
operand
|
||||
= do { v <- operand' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\ v e -> List [Item "sub", v, e]) v es }
|
||||
<?> "operand"
|
||||
|
||||
operand'
|
||||
= try variable
|
||||
|
|
@ -287,60 +373,77 @@ operand'
|
|||
<|> try (do { sBYTESIN ; sLeftR ; o <- operand ; sRightR ; return $ List [Item "bytesin", o] })
|
||||
<|> try (do { sBYTESIN ; sLeftR ; o <- dataType ; sRightR ; return $ List [Item "bytesin", o] })
|
||||
<|> try (do { sOFFSETOF ; sLeftR ; n <- name ; sComma ; f <- fieldName ; sRightR ; return $ List [Item "offsetof", n, f] })
|
||||
<?> "operand'"
|
||||
|
||||
output
|
||||
= try (do { c <- channel ; sBang ; os <- sepBy1 outputItem sSemi ; return $ List ([Item "!", c] ++ os) })
|
||||
<|> try (do { c <- channel ; sBang ; t <- tag ; sSemi ; os <- sepBy1 outputItem sSemi ; return $ List ([Item "!", c, t] ++ os) })
|
||||
<|> try (do { c <- channel ; sBang ; t <- tag ; return $ List [Item "!", c, t] })
|
||||
<|> do { p <- port ; sBang ; e <- expression ; return $ List [Item "!", p, e] }
|
||||
<?> "output"
|
||||
|
||||
outputItem
|
||||
= try (do { a <- expression ; sColons ; b <- expression ; return $ List [Item "::", a, b] })
|
||||
<|> expression
|
||||
<?> "outputItem"
|
||||
|
||||
port
|
||||
= do { v <- port' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\ v e -> List [Item "sub", v, e]) v es }
|
||||
<?> "port"
|
||||
|
||||
port'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- port ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ List [Item "sub-from-for", n, e, f] })
|
||||
<|> try (do { sLeft ; n <- port ; sFROM ; e <- expression ; sRight ; return $ List [Item "sub-from", n, e] })
|
||||
<|> do { sLeft ; n <- port ; sFOR ; e <- expression ; sRight ; return $ List [Item "sub-for", n, e] }
|
||||
<?> "port'"
|
||||
|
||||
portType
|
||||
= try (do { reserved "PORT" ; reserved "OF" ; p <- protocol ; return $ List [Item "port-of", p] })
|
||||
<|> do { sLeft ; s <- expression ; sRight ; t <- portType ; return $ List [Item "array", s, t] }
|
||||
<?> "portType"
|
||||
|
||||
process
|
||||
= try assignment
|
||||
<|> try input
|
||||
<|> try output
|
||||
--XXX lots more
|
||||
<|> try (do { reserved "SKIP" ; return $ Item "skip" })
|
||||
<|> try (do { reserved "STOP" ; return $ Item "stop" })
|
||||
<|> try (do { sSKIP ; return $ Item "skip" })
|
||||
<|> try (do { sSTOP ; return $ Item "stop" })
|
||||
<|> try alternation
|
||||
<|> try (do { s <- specification ; p <- process ; return $ List [Item ":", s, p] })
|
||||
<|> do { a <- allocation ; p <- process ; return $ List [Item ":", a, p] }
|
||||
<?> "process"
|
||||
|
||||
protocol
|
||||
= try name
|
||||
<|> simpleProtocol
|
||||
<?> "protocol"
|
||||
|
||||
real
|
||||
= try (do { l <- digits ; char '.' ; r <- digits ; char 'e' ; e <- lexeme occamExponent ; return $ Item (l ++ "." ++ r ++ "e" ++ e) })
|
||||
<|> do { l <- digits ; char '.' ; r <- lexeme digits ; return $ Item (l ++ "." ++ r) }
|
||||
<?> "real"
|
||||
|
||||
replicator
|
||||
= do { n <- name ; sEq ; b <- base ; sFOR ; c <- occamCount ; return $ List [Item "for", n, b, c] }
|
||||
<?> "replicator"
|
||||
|
||||
sequentialProtocol
|
||||
= do { l <- sepBy1 simpleProtocol sSemi ; return $ List l }
|
||||
<?> "sequentialProtocol"
|
||||
|
||||
simpleProtocol
|
||||
= try dataType
|
||||
<|> try (do { try (reserved "ANY") ; return $ Item "any" })
|
||||
<|> do { l <- dataType ; sColons ; r <- dataType ; return $ List [Item "::", l, r] }
|
||||
<?> "simpleProtocol"
|
||||
|
||||
specification
|
||||
= try declaration
|
||||
<|> try abbreviation
|
||||
-- <|> definition
|
||||
<|> definition
|
||||
<?> "specification"
|
||||
|
||||
specifier
|
||||
= try dataType
|
||||
|
|
@ -349,10 +452,19 @@ specifier
|
|||
<|> try portType
|
||||
<|> try (do { sLeft ; sRight ; s <- specifier ; return $ List [Item "array", s] })
|
||||
<|> do { sLeft ; e <- expression ; sRight ; s <- specifier ; return $ List [Item "array", e, s] }
|
||||
<?> "specifier"
|
||||
|
||||
structuredType
|
||||
= try (do { sRECORD ; sIn ; fs <- many1 structuredTypeField ; sOut ; return $ List ([Item "record"] ++ fs) })
|
||||
<|> do { sPACKED ; sRECORD ; sIn ; fs <- many1 structuredTypeField ; sOut ; return $ List ([Item "packed-record"] ++ fs) }
|
||||
|
||||
structuredTypeField
|
||||
= do { t <- dataType ; fs <- many1 fieldName ; sColon ; return $ List (t : fs) }
|
||||
|
||||
-- XXX (<name> <string>) not (<string> <name>) in case 2 for consistency with literal
|
||||
table
|
||||
= do { v <- table' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\ v e -> List [Item "sub", v, e]) v es }
|
||||
<?> "table"
|
||||
|
||||
table'
|
||||
= try occamString
|
||||
|
|
@ -361,45 +473,64 @@ table'
|
|||
<|> try (do { sLeft ; n <- table ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ List [Item "sub-from-for", n, e, f] })
|
||||
<|> try (do { sLeft ; n <- table ; sFROM ; e <- expression ; sRight ; return $ List [Item "sub-from", n, e] })
|
||||
<|> try (do { sLeft ; n <- table ; sFOR ; e <- expression ; sRight ; return $ List [Item "sub-for", n, e] })
|
||||
<?> "table'"
|
||||
|
||||
tag
|
||||
= name
|
||||
<?> "tag"
|
||||
|
||||
taggedList
|
||||
= try (do { t <- tag ; sSemi ; is <- sepBy1 inputItem sSemi ; return $ List ([t] ++ is) })
|
||||
<|> do { t <- tag ; return $ List [t] }
|
||||
<?> "taggedList"
|
||||
|
||||
taggedProtocol
|
||||
= try (do { t <- tag ; return $ List [t] })
|
||||
<|> do { t <- tag ; sSemi ; is <- sepBy1 inputItem sSemi ; return $ List ([t] ++ is) }
|
||||
<|> try (do { t <- tag ; sp <- sequentialProtocol ; return $ List (t : case sp of List ps -> ps) })
|
||||
|
||||
timer
|
||||
= do { v <- timer' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\ v e -> List [Item "sub", v, e]) v es }
|
||||
<?> "timer"
|
||||
|
||||
timer'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- timer ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ List [Item "sub-from-for", n, e, f] })
|
||||
<|> try (do { sLeft ; n <- timer ; sFROM ; e <- expression ; sRight ; return $ List [Item "sub-from", n, e] })
|
||||
<|> do { sLeft ; n <- timer ; sFOR ; e <- expression ; sRight ; return $ List [Item "sub-for", n, e] }
|
||||
<?> "timer'"
|
||||
|
||||
timerInput
|
||||
= try (do { c <- channel ; sQuest ; v <- variable ; return $ List [Item "?", c, v] })
|
||||
<?> "timerInput"
|
||||
|
||||
timerType
|
||||
= try (do { reserved "TIMER" ; return $ Item "timer" })
|
||||
<|> do { sLeft ; s <- expression ; sRight ; t <- timerType ; return $ List [Item "array", s, t] }
|
||||
<?> "timerType"
|
||||
|
||||
real
|
||||
= try (do { l <- digits ; char '.' ; r <- lexeme digits ; return $ Item (l ++ "." ++ r) })
|
||||
<|> do { l <- digits ; char '.' ; r <- digits ; char 'e' ; e <- lexeme digits ; return $ Item (l ++ "." ++ r ++ "e" ++ e) }
|
||||
valueProcess
|
||||
= try (do { sVALOF ; sIn ; p <- process ; sRESULT ; el <- expressionList ; sOut ; return $ List [Item "valof", p, el] })
|
||||
<|> do { s <- specification ; v <- valueProcess ; return $ List [Item ":", s, v] }
|
||||
|
||||
variable
|
||||
= do { v <- variable' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\ v e -> List [Item "sub", v, e]) v es }
|
||||
<?> "variable"
|
||||
|
||||
variable'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ List [Item "sub-from-for", n, e, f] })
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sRight ; return $ List [Item "sub-from", n, e] })
|
||||
<|> do { sLeft ; n <- variable ; sFOR ; e <- expression ; sRight ; return $ List [Item "sub-for", n, e] }
|
||||
<?> "variable'"
|
||||
|
||||
variableList
|
||||
= do { vs <- sepBy1 variable sSemi ; return $ List vs }
|
||||
= do { vs <- sepBy1 variable sComma ; return $ List vs }
|
||||
<?> "variableList"
|
||||
|
||||
variant
|
||||
= try (do { t <- taggedList ; sIn ; p <- process ; sOut ; return $ List [t, p] })
|
||||
<|> do { s <- specification ; v <- variant ; return $ List [Item ":", s, v] }
|
||||
<?> "variant"
|
||||
|
||||
-- -------------------------------------------------------------
|
||||
|
||||
|
|
@ -440,7 +571,13 @@ ex = [
|
|||
" STOP",
|
||||
" ALT i = 0 FOR n",
|
||||
" c[i] ? v",
|
||||
" oc ! v"
|
||||
" oc ! v",
|
||||
" tc ? CASE",
|
||||
" One",
|
||||
" SKIP",
|
||||
" BOOL b:",
|
||||
" Two ; b",
|
||||
" SKIP"
|
||||
]
|
||||
|
||||
flat = putStr $ show $ flatten ex
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user