Import Tree qualified, getting rid of the silly Oc prefix on all the types
This commit is contained in:
Adam Sampson
parent
792728b7aa
commit
acb785e85b
334
fco/Parse.hs
334
fco/Parse.hs
|
|
@ -8,7 +8,7 @@ import qualified Text.ParserCombinators.Parsec.Token as P
|
|||
import Text.ParserCombinators.Parsec.Language (emptyDef)
|
||||
import qualified IO
|
||||
|
||||
import Tree
|
||||
import qualified Tree as N
|
||||
|
||||
-- -------------------------------------------------------------
|
||||
|
||||
|
|
@ -212,11 +212,11 @@ eol = symbol "@"
|
|||
-- The way productions should work is that each production should only consume input if it's sure that it's unambiguous.
|
||||
|
||||
abbreviation
|
||||
= try (do { n <- name ; sIS ; v <- variable ; sColon ; eol ; return $ OcIs n v })
|
||||
<|> try (do { s <- specifier ; n <- name ; sIS ; v <- variable ; sColon ; eol ; return $ OcIsType s n v })
|
||||
= try (do { n <- name ; sIS ; v <- variable ; sColon ; eol ; return $ N.Is n v })
|
||||
<|> try (do { s <- specifier ; n <- name ; sIS ; v <- variable ; sColon ; eol ; return $ N.IsType s n v })
|
||||
<|> do { sVAL ;
|
||||
try (do { n <- name ; sIS ; e <- expression ; sColon ; eol ; return $ OcValIs n e })
|
||||
<|> do { s <- specifier ; n <- name ; sIS ; e <- expression ; sColon ; eol ; return $ OcValIsType s n e } }
|
||||
try (do { n <- name ; sIS ; e <- expression ; sColon ; eol ; return $ N.ValIs n e })
|
||||
<|> do { s <- specifier ; n <- name ; sIS ; e <- expression ; sColon ; eol ; return $ N.ValIsType s n e } }
|
||||
<?> "abbreviation"
|
||||
|
||||
actual
|
||||
|
|
@ -226,28 +226,28 @@ actual
|
|||
<?> "actual"
|
||||
|
||||
allocation
|
||||
= do { sPLACE ; n <- name ; sAT ; e <- expression ; sColon ; eol ; return $ OcPlace n e }
|
||||
= do { sPLACE ; n <- name ; sAT ; e <- expression ; sColon ; eol ; return $ N.Place n e }
|
||||
<?> "allocation"
|
||||
|
||||
alternation
|
||||
= do { sALT ;
|
||||
do { eol ; indent ; as <- many1 alternative ; outdent ; return $ OcAlt as }
|
||||
<|> do { r <- replicator ; eol ; indent ; a <- alternative ; outdent ; return $ OcAltRep r a } }
|
||||
do { eol ; indent ; as <- many1 alternative ; outdent ; return $ N.Alt as }
|
||||
<|> do { r <- replicator ; eol ; indent ; a <- alternative ; outdent ; return $ N.AltRep r a } }
|
||||
<|> do { sPRI ; sALT ;
|
||||
do { eol ; indent ; as <- many1 alternative ; outdent ; return $ OcPriAlt as }
|
||||
<|> do { r <- replicator ; eol ; indent ; a <- alternative ; outdent ; return $ OcPriAltRep r a } }
|
||||
do { eol ; indent ; as <- many1 alternative ; outdent ; return $ N.PriAlt as }
|
||||
<|> do { r <- replicator ; eol ; indent ; a <- alternative ; outdent ; return $ N.PriAltRep r a } }
|
||||
<?> "alternation"
|
||||
|
||||
alternative
|
||||
= guardedAlternative
|
||||
<|> alternation
|
||||
<|> try (do { b <- boolean ; sAmp ; c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ OcInCaseGuard b c vs })
|
||||
<|> try (do { c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ OcInCase c vs })
|
||||
<|> do { s <- specification ; a <- alternative ; return $ OcDecl s a }
|
||||
<|> try (do { b <- boolean ; sAmp ; c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ N.InCaseGuard b c vs })
|
||||
<|> try (do { c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ N.InCase c vs })
|
||||
<|> do { s <- specification ; a <- alternative ; return $ N.Decl s a }
|
||||
<?> "alternative"
|
||||
|
||||
assignment
|
||||
= do { vs <- variableList ; sAssign ; es <- expressionList ; eol ; return $ OcAssign vs es }
|
||||
= do { vs <- variableList ; sAssign ; es <- expressionList ; eol ; return $ N.Assign vs es }
|
||||
<?> "assignment"
|
||||
|
||||
base
|
||||
|
|
@ -259,7 +259,7 @@ boolean
|
|||
<?> "boolean"
|
||||
|
||||
byte
|
||||
= lexeme (do { char '\'' ; s <- character ; char '\'' ; return $ OcLitByte s })
|
||||
= lexeme (do { char '\'' ; s <- character ; char '\'' ; return $ N.LitByte s })
|
||||
<?> "byte"
|
||||
|
||||
caseExpression
|
||||
|
|
@ -267,26 +267,26 @@ caseExpression
|
|||
<?> "caseExpression"
|
||||
|
||||
caseInput
|
||||
= do { c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ OcInCase c vs }
|
||||
= do { c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ N.InCase c vs }
|
||||
<?> "caseInput"
|
||||
|
||||
-- This is also used for timers and ports, since the syntax is identical (and
|
||||
-- the parser really can't tell at this stage which is which).
|
||||
channel
|
||||
= do { v <- channel' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl OcSub v es }
|
||||
= do { v <- channel' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl N.Sub v es }
|
||||
<?> "channel"
|
||||
|
||||
channel'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ OcSubFromFor n e f })
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sRight ; return $ OcSubFrom n e })
|
||||
<|> do { sLeft ; n <- channel ; sFOR ; e <- expression ; sRight ; return $ OcSubFor n e }
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ N.SubFromFor n e f })
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sRight ; return $ N.SubFrom n e })
|
||||
<|> do { sLeft ; n <- channel ; sFOR ; e <- expression ; sRight ; return $ N.SubFor n e }
|
||||
<?> "channel'"
|
||||
|
||||
-- FIXME should probably make CHAN INT work, since that'd be trivial...
|
||||
channelType
|
||||
= do { sCHAN ; sOF ; p <- protocol ; return $ OcChanOf p }
|
||||
<|> try (do { sLeft ; s <- expression ; sRight ; t <- channelType ; return $ OcArray s t })
|
||||
= do { sCHAN ; sOF ; p <- protocol ; return $ N.ChanOf p }
|
||||
<|> try (do { sLeft ; s <- expression ; sRight ; t <- channelType ; return $ N.Array s t })
|
||||
<?> "channelType"
|
||||
|
||||
-- FIXME this isn't at all the right way to return the character!
|
||||
|
|
@ -300,18 +300,18 @@ character
|
|||
occamChoice
|
||||
= guardedChoice
|
||||
<|> conditional
|
||||
<|> do { s <- try specification ; c <- occamChoice ; return $ OcDecl s c }
|
||||
<|> do { s <- try specification ; c <- occamChoice ; return $ N.Decl s c }
|
||||
<?> "choice"
|
||||
|
||||
conditional
|
||||
= do { sIF ;
|
||||
do { eol ; indent ; cs <- many1 occamChoice ; outdent ; return $ OcIf cs }
|
||||
<|> do { r <- replicator ; eol ; indent ; c <- occamChoice ; outdent ; return $ OcIfRep r c } }
|
||||
do { eol ; indent ; cs <- many1 occamChoice ; outdent ; return $ N.If cs }
|
||||
<|> do { r <- replicator ; eol ; indent ; c <- occamChoice ; outdent ; return $ N.IfRep r c } }
|
||||
<?> "conditional"
|
||||
|
||||
conversion
|
||||
= do t <- dataType
|
||||
do { sROUND ; o <- operand ; return $ OcRound t o } <|> do { sTRUNC ; o <- operand ; return $ OcTrunc t o } <|> do { o <- operand ; return $ OcConv t o }
|
||||
do { sROUND ; o <- operand ; return $ N.Round t o } <|> do { sTRUNC ; o <- operand ; return $ N.Trunc t o } <|> do { o <- operand ; return $ N.Conv t o }
|
||||
<?> "conversion"
|
||||
|
||||
occamCount
|
||||
|
|
@ -319,15 +319,15 @@ occamCount
|
|||
<?> "count"
|
||||
|
||||
dataType
|
||||
= do { sBOOL ; return $ OcBool }
|
||||
<|> do { sBYTE ; return $ OcByte }
|
||||
<|> do { sINT ; return $ OcInt }
|
||||
<|> do { sINT16 ; return $ OcInt16 }
|
||||
<|> do { sINT32 ; return $ OcInt32 }
|
||||
<|> do { sINT64 ; return $ OcInt64 }
|
||||
<|> do { sREAL32 ; return $ OcReal32 }
|
||||
<|> do { sREAL64 ; return $ OcReal64 }
|
||||
<|> try (do { sLeft ; s <- expression ; sRight ; t <- dataType ; return $ OcArray s t })
|
||||
= do { sBOOL ; return $ N.Bool }
|
||||
<|> do { sBYTE ; return $ N.Byte }
|
||||
<|> do { sINT ; return $ N.Int }
|
||||
<|> do { sINT16 ; return $ N.Int16 }
|
||||
<|> do { sINT32 ; return $ N.Int32 }
|
||||
<|> do { sINT64 ; return $ N.Int64 }
|
||||
<|> do { sREAL32 ; return $ N.Real32 }
|
||||
<|> do { sREAL64 ; return $ N.Real64 }
|
||||
<|> try (do { sLeft ; s <- expression ; sRight ; t <- dataType ; return $ N.Array s t })
|
||||
<|> name
|
||||
<?> "data type"
|
||||
|
||||
|
|
@ -338,28 +338,28 @@ declType
|
|||
<|> portType
|
||||
|
||||
-- FIXME this originally had four lines like this, one for each of the above;
|
||||
-- it might be nicer to generate a different Node for each type of declaration
|
||||
-- it might be nicer to generate a different N.Node for each type of declaration
|
||||
declaration
|
||||
= do { d <- declType ; ns <- sepBy1 name sComma ; sColon ; eol ; return $ OcVars d ns }
|
||||
= do { d <- declType ; ns <- sepBy1 name sComma ; sColon ; eol ; return $ N.Vars d ns }
|
||||
<?> "declaration"
|
||||
|
||||
definition
|
||||
= do { sDATA ; sTYPE ; n <- name ;
|
||||
do {sIS ; t <- dataType ; sColon ; eol ; return $ OcDataType n t }
|
||||
<|> do { eol ; indent ; t <- structuredType ; outdent ; sColon ; eol ; return $ OcDataType n t } }
|
||||
do {sIS ; t <- dataType ; sColon ; eol ; return $ N.DataType n t }
|
||||
<|> do { eol ; indent ; t <- structuredType ; outdent ; sColon ; eol ; return $ N.DataType n t } }
|
||||
<|> do { sPROTOCOL ; n <- name ;
|
||||
do { sIS ; p <- sequentialProtocol ; sColon ; eol ; return $ OcProtocol n p }
|
||||
<|> do { eol ; indent ; sCASE ; eol ; indent ; ps <- many1 taggedProtocol ; outdent ; outdent ; sColon ; eol ; return $ OcTaggedProtocol n ps } }
|
||||
<|> do { sPROC ; n <- name ; fs <- formalList ; eol ; indent ; p <- process ; outdent ; sColon ; eol ; return $ OcProc n fs p }
|
||||
do { sIS ; p <- sequentialProtocol ; sColon ; eol ; return $ N.Protocol n p }
|
||||
<|> do { eol ; indent ; sCASE ; eol ; indent ; ps <- many1 taggedProtocol ; outdent ; outdent ; sColon ; eol ; return $ N.TaggedProtocol n ps } }
|
||||
<|> do { sPROC ; n <- name ; fs <- formalList ; eol ; indent ; p <- process ; outdent ; sColon ; eol ; return $ N.Proc n fs p }
|
||||
<|> try (do { rs <- sepBy1 dataType sComma ; (n, fs) <- functionHeader ;
|
||||
do { sIS ; el <- expressionList ; sColon ; eol ; return $ OcFuncIs n rs fs el }
|
||||
<|> do { eol ; indent ; vp <- valueProcess ; outdent ; sColon ; eol ; return $ OcFunc n rs fs vp } })
|
||||
do { sIS ; el <- expressionList ; sColon ; eol ; return $ N.FuncIs n rs fs el }
|
||||
<|> do { eol ; indent ; vp <- valueProcess ; outdent ; sColon ; eol ; return $ N.Func n rs fs vp } })
|
||||
<|> try (do { s <- specifier ; n <- name ;
|
||||
do { sRETYPES ; v <- variable ; sColon ; eol ; return $ OcRetypes s n v }
|
||||
<|> do { try sRESHAPES ; v <- variable ; sColon ; eol ; return $ OcReshapes s n v } })
|
||||
do { sRETYPES ; v <- variable ; sColon ; eol ; return $ N.Retypes s n v }
|
||||
<|> do { try sRESHAPES ; v <- variable ; sColon ; eol ; return $ N.Reshapes s n v } })
|
||||
<|> do { sVAL ; s <- specifier ; n <- name ;
|
||||
do { sRETYPES ; v <- variable ; sColon ; eol ; return $ OcValRetypes s n v }
|
||||
<|> do { sRESHAPES ; v <- variable ; sColon ; eol ; return $ OcValReshapes s n v } }
|
||||
do { sRETYPES ; v <- variable ; sColon ; eol ; return $ N.ValRetypes s n v }
|
||||
<|> do { sRESHAPES ; v <- variable ; sColon ; eol ; return $ N.ValReshapes s n v } }
|
||||
<?> "definition"
|
||||
|
||||
digits
|
||||
|
|
@ -367,49 +367,49 @@ digits
|
|||
<?> "digits"
|
||||
|
||||
dyadicOperator
|
||||
= do { reservedOp "+" ; return $ OcAdd }
|
||||
<|> do { reservedOp "-" ; return $ OcSubtr }
|
||||
<|> do { reservedOp "*" ; return $ OcMul }
|
||||
<|> do { reservedOp "/" ; return $ OcDiv }
|
||||
<|> do { reservedOp "\\" ; return $ OcRem }
|
||||
<|> do { sREM ; return $ OcRem }
|
||||
<|> do { sPLUS ; return $ OcPlus }
|
||||
<|> do { sMINUS ; return $ OcMinus }
|
||||
<|> do { sTIMES ; return $ OcTimes }
|
||||
<|> do { reservedOp "/\\" ; return $ OcBitAnd }
|
||||
<|> do { reservedOp "\\/" ; return $ OcBitOr }
|
||||
<|> do { reservedOp "><" ; return $ OcBitXor }
|
||||
<|> do { sBITAND ; return $ OcBitAnd }
|
||||
<|> do { sBITOR ; return $ OcBitOr }
|
||||
<|> do { sAND ; return $ OcAnd }
|
||||
<|> do { sOR ; return $ OcOr }
|
||||
<|> do { reservedOp "=" ; return $ OcEq }
|
||||
<|> do { reservedOp "<>" ; return $ OcNEq }
|
||||
<|> do { reservedOp "<" ; return $ OcLess }
|
||||
<|> do { reservedOp ">" ; return $ OcMore }
|
||||
<|> do { reservedOp "<=" ; return $ OcLessEq }
|
||||
<|> do { reservedOp ">=" ; return $ OcMoreEq }
|
||||
<|> do { sAFTER ; return $ OcAfter }
|
||||
= do { reservedOp "+" ; return $ N.Add }
|
||||
<|> do { reservedOp "-" ; return $ N.Subtr }
|
||||
<|> do { reservedOp "*" ; return $ N.Mul }
|
||||
<|> do { reservedOp "/" ; return $ N.Div }
|
||||
<|> do { reservedOp "\\" ; return $ N.Rem }
|
||||
<|> do { sREM ; return $ N.Rem }
|
||||
<|> do { sPLUS ; return $ N.Plus }
|
||||
<|> do { sMINUS ; return $ N.Minus }
|
||||
<|> do { sTIMES ; return $ N.Times }
|
||||
<|> do { reservedOp "/\\" ; return $ N.BitAnd }
|
||||
<|> do { reservedOp "\\/" ; return $ N.BitOr }
|
||||
<|> do { reservedOp "><" ; return $ N.BitXor }
|
||||
<|> do { sBITAND ; return $ N.BitAnd }
|
||||
<|> do { sBITOR ; return $ N.BitOr }
|
||||
<|> do { sAND ; return $ N.And }
|
||||
<|> do { sOR ; return $ N.Or }
|
||||
<|> do { reservedOp "=" ; return $ N.Eq }
|
||||
<|> do { reservedOp "<>" ; return $ N.NEq }
|
||||
<|> do { reservedOp "<" ; return $ N.Less }
|
||||
<|> do { reservedOp ">" ; return $ N.More }
|
||||
<|> do { reservedOp "<=" ; return $ N.LessEq }
|
||||
<|> do { reservedOp ">=" ; return $ N.MoreEq }
|
||||
<|> do { sAFTER ; return $ N.After }
|
||||
<?> "dyadicOperator"
|
||||
|
||||
occamExponent
|
||||
= try (do { c <- oneOf "+-" ; d <- digits ; return $ c : d })
|
||||
<?> "exponent"
|
||||
|
||||
expression :: Parser Node
|
||||
expression :: Parser N.Node
|
||||
expression
|
||||
= try (do { o <- monadicOperator ; v <- operand ; return $ o v })
|
||||
<|> do { a <- sMOSTPOS ; t <- dataType ; return $ OcMostPos t }
|
||||
<|> do { a <- sMOSTNEG ; t <- dataType ; return $ OcMostNeg t }
|
||||
<|> do { a <- sSIZE ; t <- dataType ; return $ OcSize t }
|
||||
<|> do { a <- sMOSTPOS ; t <- dataType ; return $ N.MostPos t }
|
||||
<|> do { a <- sMOSTNEG ; t <- dataType ; return $ N.MostNeg t }
|
||||
<|> do { a <- sSIZE ; t <- dataType ; return $ N.Size t }
|
||||
<|> try (do { a <- operand ; o <- dyadicOperator ; b <- operand ; return $ o a b })
|
||||
<|> try conversion
|
||||
<|> operand
|
||||
<?> "expression"
|
||||
|
||||
expressionList
|
||||
= try (do { n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ OcCall n as })
|
||||
<|> do { es <- sepBy1 expression sComma ; return $ OcExpList es }
|
||||
= try (do { n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ N.Call n as })
|
||||
<|> do { es <- sepBy1 expression sComma ; return $ N.ExpList es }
|
||||
-- XXX value process
|
||||
<?> "expressionList"
|
||||
|
||||
|
|
@ -423,20 +423,20 @@ formalList
|
|||
= do { sLeftR ; fs <- sepBy formalArg sComma ; sRightR ; return $ markTypes fs }
|
||||
<?> "formalList"
|
||||
where
|
||||
formalArg :: Parser (Maybe Node, Node)
|
||||
formalArg = try (do { sVAL ; s <- specifier ; n <- name ; return $ (Just (OcVal s), n) })
|
||||
formalArg :: Parser (Maybe N.Node, N.Node)
|
||||
formalArg = try (do { sVAL ; s <- specifier ; n <- name ; return $ (Just (N.Val s), n) })
|
||||
<|> try (do { s <- specifier ; n <- name ; return $ (Just s, n) })
|
||||
<|> try (do { n <- name ; return $ (Nothing, n) })
|
||||
|
||||
markTypes :: [(Maybe Node, Node)] -> [Node]
|
||||
markTypes :: [(Maybe N.Node, N.Node)] -> [N.Node]
|
||||
markTypes [] = []
|
||||
markTypes ((Nothing, _):_) = error "Formal list must start with a type"
|
||||
markTypes ((Just ft,fn):is) = (OcFormal ft fn) : markRest ft is
|
||||
markTypes ((Just ft,fn):is) = (N.Formal ft fn) : markRest ft is
|
||||
|
||||
markRest :: Node -> [(Maybe Node, Node)] -> [Node]
|
||||
markRest :: N.Node -> [(Maybe N.Node, N.Node)] -> [N.Node]
|
||||
markRest _ [] = []
|
||||
markRest t ((Nothing, n):is) = (OcFormal t n) : markRest t is
|
||||
markRest _ ((Just t, n):is) = (OcFormal t n) : markRest t is
|
||||
markRest t ((Nothing, n):is) = (N.Formal t n) : markRest t is
|
||||
markRest _ ((Just t, n):is) = (N.Formal t n) : markRest t is
|
||||
|
||||
functionHeader
|
||||
= do { sFUNCTION ; n <- name ; fs <- formalList ; return $ (n, fs) }
|
||||
|
|
@ -444,20 +444,20 @@ functionHeader
|
|||
|
||||
guard
|
||||
= try input
|
||||
<|> try (do { b <- boolean ; sAmp ; i <- input ; return $ OcGuarded b i })
|
||||
<|> try (do { b <- boolean ; sAmp ; sSKIP ; eol ; return $ OcGuarded b OcSkip })
|
||||
<|> try (do { b <- boolean ; sAmp ; i <- input ; return $ N.Guarded b i })
|
||||
<|> try (do { b <- boolean ; sAmp ; sSKIP ; eol ; return $ N.Guarded b N.Skip })
|
||||
<?> "guard"
|
||||
|
||||
guardedAlternative
|
||||
= do { g <- guard ; indent ; p <- process ; outdent ; return $ OcGuarded g p }
|
||||
= do { g <- guard ; indent ; p <- process ; outdent ; return $ N.Guarded g p }
|
||||
<?> "guardedAlternative"
|
||||
|
||||
guardedChoice
|
||||
= do { b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ OcGuarded b p }
|
||||
= do { b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ N.Guarded b p }
|
||||
<?> "guardedChoice"
|
||||
|
||||
hexDigits
|
||||
= do { d <- many1 hexDigit ; return $ OcLitHex d }
|
||||
= do { d <- many1 hexDigit ; return $ N.LitHex d }
|
||||
<?> "hexDigits"
|
||||
|
||||
-- XXX how does the syntax handle multiline regular CASE inputs?
|
||||
|
|
@ -468,18 +468,18 @@ hexDigits
|
|||
input
|
||||
= do c <- channel
|
||||
sQuest
|
||||
(do { sCASE ; tl <- taggedList ; eol ; return $ OcInTag c tl }
|
||||
<|> do { sAFTER ; e <- expression ; eol ; return $ OcInAfter c e }
|
||||
<|> do { is <- sepBy1 inputItem sSemi ; eol ; return $ OcIn c is })
|
||||
(do { sCASE ; tl <- taggedList ; eol ; return $ N.InTag c tl }
|
||||
<|> do { sAFTER ; e <- expression ; eol ; return $ N.InAfter c e }
|
||||
<|> do { is <- sepBy1 inputItem sSemi ; eol ; return $ N.In c is })
|
||||
<?> "input"
|
||||
|
||||
inputItem
|
||||
= try (do { v <- variable ; sColons ; w <- variable ; return $ OcCounted v w })
|
||||
= try (do { v <- variable ; sColons ; w <- variable ; return $ N.Counted v w })
|
||||
<|> variable
|
||||
<?> "inputItem"
|
||||
|
||||
integer
|
||||
= try (do { d <- lexeme digits ; return $ OcLitInt d })
|
||||
= try (do { d <- lexeme digits ; return $ N.LitInt d })
|
||||
<|> do { char '#' ; d <- lexeme hexDigits ; return $ d }
|
||||
<?> "integer"
|
||||
|
||||
|
|
@ -487,35 +487,35 @@ literal
|
|||
= try real
|
||||
<|> try integer
|
||||
<|> try byte
|
||||
<|> try (do { v <- real ; sLeftR ; t <- dataType ; sRightR ; return $ OcTypedLit t v })
|
||||
<|> try (do { v <- integer ; sLeftR ; t <- dataType ; sRightR ; return $ OcTypedLit t v })
|
||||
<|> try (do { v <- byte ; sLeftR ; t <- dataType ; sRightR ; return $ OcTypedLit t v })
|
||||
<|> try (do { sTRUE ; return $ OcTrue })
|
||||
<|> do { sFALSE ; return $ OcFalse }
|
||||
<|> try (do { v <- real ; sLeftR ; t <- dataType ; sRightR ; return $ N.TypedLit t v })
|
||||
<|> try (do { v <- integer ; sLeftR ; t <- dataType ; sRightR ; return $ N.TypedLit t v })
|
||||
<|> try (do { v <- byte ; sLeftR ; t <- dataType ; sRightR ; return $ N.TypedLit t v })
|
||||
<|> try (do { sTRUE ; return $ N.True })
|
||||
<|> do { sFALSE ; return $ N.False }
|
||||
<?> "literal"
|
||||
|
||||
loop
|
||||
= do { sWHILE ; b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ OcWhile b p }
|
||||
= do { sWHILE ; b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ N.While b p }
|
||||
|
||||
monadicOperator
|
||||
= do { reservedOp "-" ; return $ OcMonSub }
|
||||
<|> do { sMINUS ; return $ OcMonSub }
|
||||
<|> do { reservedOp "~" ; return $ OcMonBitNot }
|
||||
<|> do { sBITNOT ; return $ OcMonBitNot }
|
||||
<|> do { sNOT ; return $ OcMonNot }
|
||||
<|> do { sSIZE ; return $ OcSize }
|
||||
= do { reservedOp "-" ; return $ N.MonSub }
|
||||
<|> do { sMINUS ; return $ N.MonSub }
|
||||
<|> do { reservedOp "~" ; return $ N.MonBitNot }
|
||||
<|> do { sBITNOT ; return $ N.MonBitNot }
|
||||
<|> do { sNOT ; return $ N.MonNot }
|
||||
<|> do { sSIZE ; return $ N.Size }
|
||||
<?> "monadicOperator"
|
||||
|
||||
name
|
||||
= do { s <- identifier ; return $ OcName s }
|
||||
= do { s <- identifier ; return $ N.Name s }
|
||||
<?> "name"
|
||||
|
||||
occamString
|
||||
= lexeme (do { char '"' ; s <- many (noneOf "\"") ; char '"' ; return $ OcLitString s })
|
||||
= lexeme (do { char '"' ; s <- many (noneOf "\"") ; char '"' ; return $ N.LitString s })
|
||||
<?> "string"
|
||||
|
||||
operand
|
||||
= do { v <- operand' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl OcSub v es }
|
||||
= do { v <- operand' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl N.Sub v es }
|
||||
<?> "operand"
|
||||
|
||||
operand'
|
||||
|
|
@ -524,16 +524,16 @@ operand'
|
|||
<|> try table
|
||||
<|> try (do { sLeftR ; e <- expression ; sRightR ; return e })
|
||||
-- XXX value process
|
||||
<|> try (do { n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ OcCall n as })
|
||||
<|> try (do { sBYTESIN ; sLeftR ; o <- operand ; sRightR ; return $ OcBytesIn o })
|
||||
<|> try (do { sBYTESIN ; sLeftR ; o <- dataType ; sRightR ; return $ OcBytesIn o })
|
||||
<|> try (do { sOFFSETOF ; sLeftR ; n <- name ; sComma ; f <- fieldName ; sRightR ; return $ OcOffsetOf n f })
|
||||
<|> try (do { n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ N.Call n as })
|
||||
<|> try (do { sBYTESIN ; sLeftR ; o <- operand ; sRightR ; return $ N.BytesIn o })
|
||||
<|> try (do { sBYTESIN ; sLeftR ; o <- dataType ; sRightR ; return $ N.BytesIn o })
|
||||
<|> try (do { sOFFSETOF ; sLeftR ; n <- name ; sComma ; f <- fieldName ; sRightR ; return $ N.OffsetOf n f })
|
||||
<?> "operand'"
|
||||
|
||||
occamOption
|
||||
= try (do { ces <- sepBy caseExpression sComma ; eol ; indent ; p <- process ; outdent ; return $ OcCaseExps ces p })
|
||||
<|> try (do { sELSE ; eol ; indent ; p <- process ; outdent ; return $ OcElse p })
|
||||
<|> do { s <- specification ; o <- occamOption ; return $ OcDecl s o }
|
||||
= try (do { ces <- sepBy caseExpression sComma ; eol ; indent ; p <- process ; outdent ; return $ N.CaseExps ces p })
|
||||
<|> try (do { sELSE ; eol ; indent ; p <- process ; outdent ; return $ N.Else p })
|
||||
<|> do { s <- specification ; o <- occamOption ; return $ N.Decl s o }
|
||||
<?> "option"
|
||||
|
||||
-- XXX This can't tell at parse time in "c ! x; y" whether x is a variable or a tag...
|
||||
|
|
@ -542,43 +542,43 @@ occamOption
|
|||
output
|
||||
= do c <- channel
|
||||
sBang
|
||||
(do { sCASE ; t <- tag ; sSemi ; os <- sepBy1 outputItem sSemi ; eol ; return $ OcOutCase c t os }
|
||||
<|> do { sCASE ; t <- tag ; eol ; return $ OcOutCase c t [] }
|
||||
<|> do { os <- sepBy1 outputItem sSemi ; eol ; return $ OcOut c os })
|
||||
(do { sCASE ; t <- tag ; sSemi ; os <- sepBy1 outputItem sSemi ; eol ; return $ N.OutCase c t os }
|
||||
<|> do { sCASE ; t <- tag ; eol ; return $ N.OutCase c t [] }
|
||||
<|> do { os <- sepBy1 outputItem sSemi ; eol ; return $ N.Out c os })
|
||||
<?> "output"
|
||||
|
||||
outputItem
|
||||
= try (do { a <- expression ; sColons ; b <- expression ; return $ OcCounted a b })
|
||||
= try (do { a <- expression ; sColons ; b <- expression ; return $ N.Counted a b })
|
||||
<|> expression
|
||||
<?> "outputItem"
|
||||
|
||||
parallel
|
||||
= do { sPAR ; do { eol ; indent ; ps <- many1 process ; outdent ; return $ OcPar ps } <|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ OcParRep r p } }
|
||||
<|> do { sPRI ; sPAR ; do { eol ; indent ; ps <- many1 process ; outdent ; return $ OcPriPar ps } <|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ OcPriParRep r p } }
|
||||
= do { sPAR ; do { eol ; indent ; ps <- many1 process ; outdent ; return $ N.Par ps } <|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ N.ParRep r p } }
|
||||
<|> do { sPRI ; sPAR ; do { eol ; indent ; ps <- many1 process ; outdent ; return $ N.PriPar ps } <|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ N.PriParRep r p } }
|
||||
<|> placedpar
|
||||
<?> "parallel"
|
||||
|
||||
-- XXX PROCESSOR as a process isn't really legal, surely?
|
||||
placedpar
|
||||
= do { sPLACED ; sPAR ; do { eol ; indent ; ps <- many1 placedpar ; outdent ; return $ OcPlacedPar ps } <|> do { r <- replicator ; eol ; indent ; p <- placedpar ; outdent ; return $ OcPlacedParRep r p } }
|
||||
<|> do { sPROCESSOR ; e <- expression ; eol ; indent ; p <- process ; outdent ; return $ OcProcessor e p }
|
||||
= do { sPLACED ; sPAR ; do { eol ; indent ; ps <- many1 placedpar ; outdent ; return $ N.PlacedPar ps } <|> do { r <- replicator ; eol ; indent ; p <- placedpar ; outdent ; return $ N.PlacedParRep r p } }
|
||||
<|> do { sPROCESSOR ; e <- expression ; eol ; indent ; p <- process ; outdent ; return $ N.Processor e p }
|
||||
<?> "placedpar"
|
||||
|
||||
portType
|
||||
= do { sPORT ; sOF ; p <- protocol ; return $ OcPortOf p }
|
||||
<|> do { try sLeft ; s <- try expression ; try sRight ; t <- portType ; return $ OcArray s t }
|
||||
= do { sPORT ; sOF ; p <- protocol ; return $ N.PortOf p }
|
||||
<|> do { try sLeft ; s <- try expression ; try sRight ; t <- portType ; return $ N.Array s t }
|
||||
<?> "portType"
|
||||
|
||||
procInstance
|
||||
= do { n <- name ; sLeftR ; as <- sepBy actual sComma ; sRightR ; eol ; return $ OcProcCall n as }
|
||||
= do { n <- name ; sLeftR ; as <- sepBy actual sComma ; sRightR ; eol ; return $ N.ProcCall n as }
|
||||
<?> "procInstance"
|
||||
|
||||
process
|
||||
= try assignment
|
||||
<|> try input
|
||||
<|> try output
|
||||
<|> do { sSKIP ; eol ; return $ OcSkip }
|
||||
<|> do { sSTOP ; eol ; return $ OcStop }
|
||||
<|> do { sSKIP ; eol ; return $ N.Skip }
|
||||
<|> do { sSTOP ; eol ; return $ N.Stop }
|
||||
<|> occamSequence
|
||||
<|> conditional
|
||||
<|> selection
|
||||
|
|
@ -587,9 +587,9 @@ process
|
|||
<|> alternation
|
||||
<|> try caseInput
|
||||
<|> try procInstance
|
||||
<|> do { sMainMarker ; eol ; return $ OcMainProcess }
|
||||
<|> do { a <- allocation ; p <- process ; return $ OcDecl a p }
|
||||
<|> do { s <- specification ; p <- process ; return $ OcDecl s p }
|
||||
<|> do { sMainMarker ; eol ; return $ N.MainProcess }
|
||||
<|> do { a <- allocation ; p <- process ; return $ N.Decl a p }
|
||||
<|> do { s <- specification ; p <- process ; return $ N.Decl s p }
|
||||
<?> "process"
|
||||
|
||||
protocol
|
||||
|
|
@ -598,16 +598,16 @@ protocol
|
|||
<?> "protocol"
|
||||
|
||||
real
|
||||
= try (do { l <- digits ; char '.' ; r <- digits ; char 'e' ; e <- lexeme occamExponent ; return $ OcLitReal (l ++ "." ++ r ++ "e" ++ e) })
|
||||
<|> do { l <- digits ; char '.' ; r <- lexeme digits ; return $ OcLitReal (l ++ "." ++ r) }
|
||||
= try (do { l <- digits ; char '.' ; r <- digits ; char 'e' ; e <- lexeme occamExponent ; return $ N.LitReal (l ++ "." ++ r ++ "e" ++ e) })
|
||||
<|> do { l <- digits ; char '.' ; r <- lexeme digits ; return $ N.LitReal (l ++ "." ++ r) }
|
||||
<?> "real"
|
||||
|
||||
replicator
|
||||
= do { n <- name ; sEq ; b <- base ; sFOR ; c <- occamCount ; return $ OcFor n b c }
|
||||
= do { n <- name ; sEq ; b <- base ; sFOR ; c <- occamCount ; return $ N.For n b c }
|
||||
<?> "replicator"
|
||||
|
||||
selection
|
||||
= do { sCASE ; s <- selector ; eol ; indent ; os <- many1 occamOption ; outdent ; return $ OcCase s os }
|
||||
= do { sCASE ; s <- selector ; eol ; indent ; os <- many1 occamOption ; outdent ; return $ N.Case s os }
|
||||
<?> "selection"
|
||||
|
||||
selector
|
||||
|
|
@ -616,8 +616,8 @@ selector
|
|||
|
||||
occamSequence
|
||||
= do sSEQ
|
||||
(do { eol ; indent ; ps <- many1 process ; outdent ; return $ OcSeq ps }
|
||||
<|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ OcSeqRep r p })
|
||||
(do { eol ; indent ; ps <- many1 process ; outdent ; return $ N.Seq ps }
|
||||
<|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ N.SeqRep r p })
|
||||
<?> "sequence"
|
||||
|
||||
sequentialProtocol
|
||||
|
|
@ -625,9 +625,9 @@ sequentialProtocol
|
|||
<?> "sequentialProtocol"
|
||||
|
||||
simpleProtocol
|
||||
= try (do { l <- dataType ; sColons ; sLeft ; sRight ; r <- dataType ; return $ OcCounted l r })
|
||||
= try (do { l <- dataType ; sColons ; sLeft ; sRight ; r <- dataType ; return $ N.Counted l r })
|
||||
<|> dataType
|
||||
<|> do { sANY ; return $ OcAny }
|
||||
<|> do { sANY ; return $ N.Any }
|
||||
<?> "simpleProtocol"
|
||||
|
||||
specification
|
||||
|
|
@ -636,39 +636,39 @@ specification
|
|||
<|> definition
|
||||
<?> "specification"
|
||||
|
||||
specifier :: Parser Node
|
||||
specifier :: Parser N.Node
|
||||
specifier
|
||||
= try dataType
|
||||
<|> try channelType
|
||||
<|> try timerType
|
||||
<|> try portType
|
||||
<|> try (do { sLeft ; sRight ; s <- specifier ; return $ OcArrayUnsized s })
|
||||
<|> do { sLeft ; e <- expression ; sRight ; s <- specifier ; return $ OcArray e s }
|
||||
<|> try (do { sLeft ; sRight ; s <- specifier ; return $ N.ArrayUnsized s })
|
||||
<|> do { sLeft ; e <- expression ; sRight ; s <- specifier ; return $ N.Array e s }
|
||||
<?> "specifier"
|
||||
|
||||
structuredType
|
||||
= try (do { sRECORD ; eol ; indent ; fs <- many1 structuredTypeField ; outdent ; return $ OcRecord fs })
|
||||
<|> do { sPACKED ; sRECORD ; eol ; indent ; fs <- many1 structuredTypeField ; outdent ; return $ OcPackedRecord fs }
|
||||
= try (do { sRECORD ; eol ; indent ; fs <- many1 structuredTypeField ; outdent ; return $ N.Record fs })
|
||||
<|> do { sPACKED ; sRECORD ; eol ; indent ; fs <- many1 structuredTypeField ; outdent ; return $ N.PackedRecord fs }
|
||||
<?> "structuredType"
|
||||
|
||||
-- FIXME this should use the same type-folding code as proc/func definitions
|
||||
structuredTypeField
|
||||
= do { t <- dataType ; fs <- many1 fieldName ; sColon ; eol ; return $ OcFields t fs }
|
||||
= do { t <- dataType ; fs <- many1 fieldName ; sColon ; eol ; return $ N.Fields t fs }
|
||||
<?> "structuredTypeField"
|
||||
|
||||
-- i.e. array literal
|
||||
table
|
||||
= do { v <- table' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl OcSub v es }
|
||||
= do { v <- table' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl N.Sub v es }
|
||||
<?> "table"
|
||||
|
||||
table'
|
||||
= try occamString
|
||||
<|> try (do { s <- occamString ; sLeftR ; n <- name ; sRightR ; return $ OcTypedLit n s })
|
||||
<|> try (do { s <- occamString ; sLeftR ; n <- name ; sRightR ; return $ N.TypedLit n s })
|
||||
<|> do { sLeft ;
|
||||
try (do { es <- sepBy1 expression sComma ; sRight ; return $ OcLitArray es })
|
||||
<|> try (do { n <- table ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ OcSubFromFor n e f })
|
||||
<|> try (do { n <- table ; sFROM ; e <- expression ; sRight ; return $ OcSubFrom n e })
|
||||
<|> do { n <- table ; sFOR ; e <- expression ; sRight ; return $ OcSubFor n e } }
|
||||
try (do { es <- sepBy1 expression sComma ; sRight ; return $ N.LitArray es })
|
||||
<|> try (do { n <- table ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ N.SubFromFor n e f })
|
||||
<|> try (do { n <- table ; sFROM ; e <- expression ; sRight ; return $ N.SubFrom n e })
|
||||
<|> do { n <- table ; sFOR ; e <- expression ; sRight ; return $ N.SubFor n e } }
|
||||
<?> "table'"
|
||||
|
||||
tag
|
||||
|
|
@ -676,32 +676,32 @@ tag
|
|||
<?> "tag"
|
||||
|
||||
taggedList
|
||||
= try (do { t <- tag ; sSemi ; is <- sepBy1 inputItem sSemi ; return $ OcTag t is })
|
||||
<|> do { t <- tag ; return $ OcTag t [] }
|
||||
= try (do { t <- tag ; sSemi ; is <- sepBy1 inputItem sSemi ; return $ N.Tag t is })
|
||||
<|> do { t <- tag ; return $ N.Tag t [] }
|
||||
<?> "taggedList"
|
||||
|
||||
taggedProtocol
|
||||
= try (do { t <- tag ; eol ; return $ OcTag t [] })
|
||||
<|> try (do { t <- tag ; sSemi ; sp <- sequentialProtocol ; eol ; return $ OcTag t sp })
|
||||
= try (do { t <- tag ; eol ; return $ N.Tag t [] })
|
||||
<|> try (do { t <- tag ; sSemi ; sp <- sequentialProtocol ; eol ; return $ N.Tag t sp })
|
||||
|
||||
timerType
|
||||
= do { sTIMER ; return $ OcTimer }
|
||||
<|> do { try sLeft ; s <- try expression ; try sRight ; t <- timerType ; return $ OcArray s t }
|
||||
= do { sTIMER ; return $ N.Timer }
|
||||
<|> do { try sLeft ; s <- try expression ; try sRight ; t <- timerType ; return $ N.Array s t }
|
||||
<?> "timerType"
|
||||
|
||||
valueProcess
|
||||
= try (do { sVALOF ; eol ; indent ; p <- process ; sRESULT ; el <- expressionList ; eol ; outdent ; return $ OcValOf p el })
|
||||
<|> do { s <- specification ; v <- valueProcess ; return $ OcDecl s v }
|
||||
= try (do { sVALOF ; eol ; indent ; p <- process ; sRESULT ; el <- expressionList ; eol ; outdent ; return $ N.ValOf p el })
|
||||
<|> do { s <- specification ; v <- valueProcess ; return $ N.Decl s v }
|
||||
|
||||
variable
|
||||
= do { v <- variable' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl OcSub v es }
|
||||
= do { v <- variable' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl N.Sub v es }
|
||||
<?> "variable"
|
||||
|
||||
variable'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ OcSubFromFor n e f })
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sRight ; return $ OcSubFrom n e })
|
||||
<|> do { sLeft ; n <- variable ; sFOR ; e <- expression ; sRight ; return $ OcSubFor n e }
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ N.SubFromFor n e f })
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sRight ; return $ N.SubFrom n e })
|
||||
<|> do { sLeft ; n <- variable ; sFOR ; e <- expression ; sRight ; return $ N.SubFor n e }
|
||||
<?> "variable'"
|
||||
|
||||
variableList
|
||||
|
|
@ -709,8 +709,8 @@ variableList
|
|||
<?> "variableList"
|
||||
|
||||
variant
|
||||
= try (do { t <- taggedList ; eol ; indent ; p <- process ; outdent ; return $ OcVariant t p })
|
||||
<|> do { s <- specification ; v <- variant ; return $ OcDecl s v }
|
||||
= try (do { t <- taggedList ; eol ; indent ; p <- process ; outdent ; return $ N.Variant t p })
|
||||
<|> do { s <- specification ; v <- variant ; return $ N.Decl s v }
|
||||
<?> "variant"
|
||||
|
||||
-- -------------------------------------------------------------
|
||||
|
|
@ -777,7 +777,7 @@ readSource fn = do
|
|||
|
||||
-- -------------------------------------------------------------
|
||||
|
||||
parseSource :: String -> Node
|
||||
parseSource :: String -> N.Node
|
||||
parseSource prep
|
||||
= case (parse sourceFile "occam" prep) of
|
||||
Left err -> error ("Parsing error: " ++ (show err))
|
||||
|
|
|
|||
12
fco/Pass.hs
12
fco/Pass.hs
|
|
@ -2,12 +2,12 @@
|
|||
|
||||
module Pass where
|
||||
|
||||
import Tree
|
||||
import qualified Tree as N
|
||||
import Control.Monad.State
|
||||
|
||||
type Progress = (String -> IO ())
|
||||
|
||||
type ITransform st = Node -> State st Node
|
||||
type ITransform st = N.Node -> State st N.Node
|
||||
-- This is actually a fraction of a pass: an operation upon the tree.
|
||||
-- The arguments are:
|
||||
-- - "next": the next pass to try if this one doesn't match;
|
||||
|
|
@ -15,7 +15,7 @@ type ITransform st = Node -> State st Node
|
|||
-- - the input node.
|
||||
type Transform st = ITransform st -> ITransform st -> ITransform st
|
||||
|
||||
runTransforms :: st -> [Transform st] -> Node -> Node
|
||||
runTransforms :: st -> [Transform st] -> N.Node -> N.Node
|
||||
runTransforms initState passes node = evalState (top node) initState
|
||||
where
|
||||
fail :: ITransform st
|
||||
|
|
@ -29,19 +29,19 @@ runTransforms initState passes node = evalState (top node) initState
|
|||
|
||||
top = head passList
|
||||
|
||||
type Pass = Node -> Node
|
||||
type Pass = N.Node -> N.Node
|
||||
|
||||
makePass :: st -> Transform st -> [Transform st] -> Pass
|
||||
makePass initState t bases = runTransforms initState (t : bases)
|
||||
|
||||
data Phase = Phase String [(String, Pass)]
|
||||
|
||||
runPhase :: Phase -> Node -> Progress -> IO Node
|
||||
runPhase :: Phase -> N.Node -> Progress -> IO N.Node
|
||||
runPhase (Phase name passes) n progress = do
|
||||
progress $ "Phase: " ++ name
|
||||
runPhase' (reverse passes) n
|
||||
where
|
||||
runPhase' :: [(String, Pass)] -> Node -> IO Node
|
||||
runPhase' :: [(String, Pass)] -> N.Node -> IO N.Node
|
||||
runPhase' [] n = do return n
|
||||
runPhase' ((name, pass):passes) n = do
|
||||
rest <- runPhase' passes n
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
module PhaseIntermediate (phaseIntermediate) where
|
||||
|
||||
import Tree
|
||||
import qualified Tree as N
|
||||
import Pass
|
||||
import BaseTransforms
|
||||
import Control.Monad.State
|
||||
|
|
@ -17,55 +17,55 @@ phaseIntermediate
|
|||
-- , ("Unique identifiers", makePass (0, Map.empty) uniqueIdentifiers bases)
|
||||
])
|
||||
|
||||
nestDecls :: [(Node, Node)] -> Node -> Node
|
||||
nestDecls l n = foldl (\a b -> b a) n [IntDecl n d | (OcName n, d) <- l]
|
||||
nestDecls :: [(N.Node, N.Node)] -> N.Node -> N.Node
|
||||
nestDecls l n = foldl (\a b -> b a) n [N.IntDecl n d | (N.Name n, d) <- l]
|
||||
|
||||
markDecls :: Transform ()
|
||||
markDecls next top node
|
||||
= case node of
|
||||
OcDecl (OcProc nn@(OcName n) args code) body -> do
|
||||
N.Decl (N.Proc nn@(N.Name n) args code) body -> do
|
||||
body' <- top body
|
||||
code' <- top code
|
||||
let pdecl = nestDecls [(n, d) | d@(OcFormal _ n) <- args] (OcProc nn args code')
|
||||
return $ IntDecl n pdecl body'
|
||||
OcDecl (OcFunc nn@(OcName n) args rets code) body -> do
|
||||
let pdecl = nestDecls [(n, d) | d@(N.Formal _ n) <- args] (N.Proc nn args code')
|
||||
return $ N.IntDecl n pdecl body'
|
||||
N.Decl (N.Func nn@(N.Name n) args rets code) body -> do
|
||||
error "blah"
|
||||
body' <- top body
|
||||
code' <- top code
|
||||
let pdecl = nestDecls [(n, d) | d@(OcFormal _ n) <- args] (OcFunc nn args rets code')
|
||||
return $ IntDecl n pdecl body'
|
||||
let pdecl = nestDecls [(n, d) | d@(N.Formal _ n) <- args] (N.Func nn args rets code')
|
||||
return $ N.IntDecl n pdecl body'
|
||||
-- FIXME same for functions
|
||||
OcDecl d body -> do
|
||||
N.Decl d body -> do
|
||||
body' <- top body
|
||||
return $ case d of
|
||||
OcVars t ns -> nestDecls [(n, t) | n <- ns] body'
|
||||
OcIs (OcName n) _ -> IntDecl n d body'
|
||||
OcIsType (OcName n) _ _ -> IntDecl n d body'
|
||||
OcValIs (OcName n) _ -> IntDecl n d body'
|
||||
OcValIsType (OcName n) _ _ -> IntDecl n d body'
|
||||
OcDataType (OcName n) _ -> IntDecl n d body'
|
||||
OcProtocol (OcName n) _ -> IntDecl n d body'
|
||||
OcFuncIs (OcName n) _ _ _ -> IntDecl n d body'
|
||||
OcRetypes (OcName n) _ _ -> IntDecl n d body'
|
||||
OcValRetypes (OcName n) _ _ -> IntDecl n d body'
|
||||
OcReshapes (OcName n) _ _ -> IntDecl n d body'
|
||||
OcValReshapes (OcName n) _ _ -> IntDecl n d body'
|
||||
N.Vars t ns -> nestDecls [(n, t) | n <- ns] body'
|
||||
N.Is (N.Name n) _ -> N.IntDecl n d body'
|
||||
N.IsType (N.Name n) _ _ -> N.IntDecl n d body'
|
||||
N.ValIs (N.Name n) _ -> N.IntDecl n d body'
|
||||
N.ValIsType (N.Name n) _ _ -> N.IntDecl n d body'
|
||||
N.DataType (N.Name n) _ -> N.IntDecl n d body'
|
||||
N.Protocol (N.Name n) _ -> N.IntDecl n d body'
|
||||
N.FuncIs (N.Name n) _ _ _ -> N.IntDecl n d body'
|
||||
N.Retypes (N.Name n) _ _ -> N.IntDecl n d body'
|
||||
N.ValRetypes (N.Name n) _ _ -> N.IntDecl n d body'
|
||||
N.Reshapes (N.Name n) _ _ -> N.IntDecl n d body'
|
||||
N.ValReshapes (N.Name n) _ _ -> N.IntDecl n d body'
|
||||
_ -> error ("Unhandled type of declaration: " ++ (show d))
|
||||
_ -> next node
|
||||
|
||||
uniqueIdentifiers :: Transform (Int, Map.Map String String)
|
||||
uniqueIdentifiers next top node
|
||||
= case node of
|
||||
IntDecl name def body -> do
|
||||
N.IntDecl name def body -> do
|
||||
(n, ids) <- get
|
||||
let newname = name ++ "_" ++ (show n)
|
||||
put (n + 1, Map.insert name newname ids)
|
||||
def' <- top def
|
||||
body' <- top body
|
||||
modify (\(n, _) -> (n, ids))
|
||||
return $ IntDecl newname def' body'
|
||||
OcName s -> do
|
||||
return $ N.IntDecl newname def' body'
|
||||
N.Name s -> do
|
||||
(_, ids) <- get
|
||||
return $ if Map.member s ids then OcName (Map.findWithDefault "" s ids) else error ("Unknown identifier: " ++ s)
|
||||
return $ if Map.member s ids then N.Name (Map.findWithDefault "" s ids) else error ("Unknown identifier: " ++ s)
|
||||
_ -> next node
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
module PhaseSource (phaseSource) where
|
||||
|
||||
import Tree
|
||||
import qualified Tree as N
|
||||
import Pass
|
||||
import BaseTransforms
|
||||
import Control.Monad.State
|
||||
|
|
@ -19,13 +19,13 @@ phaseSource
|
|||
simplify :: Transform ()
|
||||
simplify next top node
|
||||
= case node of
|
||||
-- FIXME rewrite stuff like OcFuncIs -> OcFunc
|
||||
-- FIXME rewrite stuff like N.FuncIs -> N.Func
|
||||
-- FIXME could we even rewrite procs and functions to the same thing?
|
||||
_ -> next node
|
||||
|
||||
cifyIdentifiers :: Transform ()
|
||||
cifyIdentifiers next top node
|
||||
= case node of
|
||||
OcName n -> return $ OcName [if c == '.' then '_' else c | c <- n]
|
||||
N.Name n -> return $ N.Name [if c == '.' then '_' else c | c <- n]
|
||||
_ -> next node
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
module SExpression where
|
||||
|
||||
import List
|
||||
import Tree
|
||||
import qualified Tree as N
|
||||
|
||||
data SExp = Item String | List [SExp]
|
||||
|
||||
|
|
@ -11,129 +11,129 @@ instance Show SExp where
|
|||
show (Item s) = s
|
||||
show (List is) = "(" ++ (concat $ intersperse " " $ map show is) ++ ")"
|
||||
|
||||
nodeToSExp :: Node -> SExp
|
||||
nodeToSExp :: N.Node -> SExp
|
||||
nodeToSExp node
|
||||
= case node of
|
||||
OcDecl a b -> wrap2 ":" (top a) (top b)
|
||||
OcAlt a -> wrapl "alt" (map top a)
|
||||
OcAltRep a b -> wrap2 "alt-rep" (top a) (top b)
|
||||
OcPriAlt a -> wrapl "pri-alt" (map top a)
|
||||
OcPriAltRep a b -> wrap2 "pri-alt-rep" (top a) (top b)
|
||||
OcIn a b -> wrapl1 "?" (top a) (map top b)
|
||||
OcVariant a b -> wrap2 "variant" (top a) (top b)
|
||||
OcInCase a b -> wrapl1 "?case" (top a) (map top b)
|
||||
OcInCaseGuard a b c -> wrapl2 "?case-guarded" (top a) (top b) (map top c)
|
||||
OcInTag a b -> wrap2 "?case-tag" (top a) (top b)
|
||||
OcInAfter a b -> wrap2 "?after" (top a) (top b)
|
||||
OcOut a b -> wrapl1 "!" (top a) (map top b)
|
||||
OcOutCase a b c -> wrapl2 "!case" (top a) (top b) (map top c)
|
||||
OcExpList a -> wrapl "exp-list" (map top a)
|
||||
OcAssign a b -> wrap2 ":=" (List $ map top a) (top b)
|
||||
OcIf a -> wrapl "if" (map top a)
|
||||
OcIfRep a b -> wrap2 "if-rep" (top a) (top b)
|
||||
OcWhile a b -> wrap2 "while" (top a) (top b)
|
||||
OcPar a -> wrapl "par" (map top a)
|
||||
OcParRep a b -> wrap2 "par-rep" (top a) (top b)
|
||||
OcPriPar a -> wrapl "pri-par" (map top a)
|
||||
OcPriParRep a b -> wrap2 "pri-par-rep" (top a) (top b)
|
||||
OcPlacedPar a -> wrapl "placed-par" (map top a)
|
||||
OcPlacedParRep a b -> wrap2 "placed-par-rep" (top a) (top b)
|
||||
OcProcessor a b -> wrap2 "processor" (top a) (top b)
|
||||
OcSkip -> Item "skip"
|
||||
OcStop -> Item "stop"
|
||||
OcCase a b -> wrapl1 "case" (top a) (map top b)
|
||||
OcSeq a -> wrapl "seq" (map top a)
|
||||
OcSeqRep a b -> wrap2 "seq-rep" (top a) (top b)
|
||||
OcProcCall a b -> wrapl1 "proc-call" (top a) (map top b)
|
||||
OcMainProcess -> Item "main"
|
||||
OcVars a b -> wrapl1 "vars" (top a) (map top b)
|
||||
OcIs a b -> wrap2 "is" (top a) (top b)
|
||||
OcIsType a b c -> wrap3 "is-type" (top a) (top b) (top c)
|
||||
OcValIs a b -> wrap2 "val-is" (top a) (top b)
|
||||
OcValIsType a b c -> wrap3 "val-is-type" (top a) (top b) (top c)
|
||||
OcPlace a b -> wrap2 "place-at" (top a) (top b)
|
||||
OcDataType a b -> wrap2 "data-type" (top a) (top b)
|
||||
OcRecord a -> wrapl "record" (map top a)
|
||||
OcPackedRecord a -> wrapl "packed-record" (map top a)
|
||||
OcFields a b -> wrapl1 "fields" (top a) (map top b)
|
||||
OcProtocol a b -> wrapl1 "protocol" (top a) (map top b)
|
||||
OcTaggedProtocol a b -> wrapl1 "protocol-tagged" (top a) (map top b)
|
||||
OcTag a b -> wrapl1 "tag" (top a) (map top b)
|
||||
OcFormal a b -> wrap2 "formal" (top a) (top b)
|
||||
OcProc a b c -> wrap3 "proc" (top a) (List $ map top b) (top c)
|
||||
OcFunc a b c d -> wrap4 "function" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
OcFuncIs a b c d -> wrap4 "function-is" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
OcRetypes a b c -> wrap3 "retypes" (top a) (top b) (top c)
|
||||
OcValRetypes a b c -> wrap3 "val-retypes" (top a) (top b) (top c)
|
||||
OcReshapes a b c -> wrap3 "reshapes" (top a) (top b) (top c)
|
||||
OcValReshapes a b c -> wrap3 "val-reshapes" (top a) (top b) (top c)
|
||||
OcValOf a b -> wrap2 "valof" (top a) (top b)
|
||||
OcSub a b -> wrap2 "sub" (top a) (top b)
|
||||
OcSubFromFor a b c -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
OcSubFrom a b -> wrap2 "sub-from" (top a) (top b)
|
||||
OcSubFor a b -> wrap2 "sub-for" (top a) (top b)
|
||||
OcCaseExps a b -> wrap2 "case-exps" (List $ map top a) (top b)
|
||||
OcElse a -> wrap "else" (top a)
|
||||
OcFor a b c -> wrap3 "for" (top a) (top b) (top c)
|
||||
OcConv a b -> wrap2 "conv" (top a) (top b)
|
||||
OcRound a b -> wrap2 "round" (top a) (top b)
|
||||
OcTrunc a b -> wrap2 "trunc" (top a) (top b)
|
||||
OcAdd a b -> wrap2 "+" (top a) (top b)
|
||||
OcSubtr a b -> wrap2 "-" (top a) (top b)
|
||||
OcMul a b -> wrap2 "*" (top a) (top b)
|
||||
OcDiv a b -> wrap2 "/" (top a) (top b)
|
||||
OcRem a b -> wrap2 "mod" (top a) (top b)
|
||||
OcPlus a b -> wrap2 "plus" (top a) (top b)
|
||||
OcMinus a b -> wrap2 "minus" (top a) (top b)
|
||||
OcTimes a b -> wrap2 "times" (top a) (top b)
|
||||
OcBitAnd a b -> wrap2 "bitand" (top a) (top b)
|
||||
OcBitOr a b -> wrap2 "bitor" (top a) (top b)
|
||||
OcBitXor a b -> wrap2 "bitxor" (top a) (top b)
|
||||
OcAnd a b -> wrap2 "and" (top a) (top b)
|
||||
OcOr a b -> wrap2 "or" (top a) (top b)
|
||||
OcEq a b -> wrap2 "=" (top a) (top b)
|
||||
OcNEq a b -> wrap2 "<>" (top a) (top b)
|
||||
OcLess a b -> wrap2 "<" (top a) (top b)
|
||||
OcMore a b -> wrap2 ">" (top a) (top b)
|
||||
OcLessEq a b -> wrap2 "<=" (top a) (top b)
|
||||
OcMoreEq a b -> wrap2 ">=" (top a) (top b)
|
||||
OcAfter a b -> wrap2 "after" (top a) (top b)
|
||||
OcMonSub a -> wrap "-" (top a)
|
||||
OcMonBitNot a -> wrap "bitnot" (top a)
|
||||
OcMonNot a -> wrap "not" (top a)
|
||||
OcMostPos a -> wrap "mostpos" (top a)
|
||||
OcMostNeg a -> wrap "mostneg" (top a)
|
||||
OcSize a -> wrap "size" (top a)
|
||||
OcCall a b -> wrapl1 "call" (top a) (map top b)
|
||||
OcBytesIn a -> wrap "bytesin" (top a)
|
||||
OcOffsetOf a b -> wrap2 "offsetof" (top a) (top b)
|
||||
OcGuarded a b -> wrap2 "guarded" (top a) (top b)
|
||||
OcVal a -> wrap "val" (top a)
|
||||
OcChanOf a -> wrap "chan" (top a)
|
||||
OcPortOf a -> wrap "port" (top a)
|
||||
OcTimer -> Item "timer"
|
||||
OcArray a b -> wrap2 "array" (top a) (top b)
|
||||
OcArrayUnsized a -> wrap "array-unsized" (top a)
|
||||
OcCounted a b -> wrap2 "::" (top a) (top b)
|
||||
OcBool -> Item "bool"
|
||||
OcByte -> Item "byte"
|
||||
OcInt -> Item "int"
|
||||
OcInt16 -> Item "int16"
|
||||
OcInt32 -> Item "int32"
|
||||
OcInt64 -> Item "int64"
|
||||
OcReal32 -> Item "real32"
|
||||
OcReal64 -> Item "real64"
|
||||
OcAny -> Item "any"
|
||||
OcTypedLit a b -> wrap2 "typed-literal" (top a) (top b)
|
||||
OcLitReal a -> wrap "real-literal" (Item a)
|
||||
OcLitInt a -> wrap "integer-literal" (Item a)
|
||||
OcLitHex a -> wrap "hex-literal" (Item a)
|
||||
OcLitByte a -> wrap "byte-literal" (Item ("'" ++ a ++ "'"))
|
||||
OcLitString a -> wrap "string-literal" (Item ("\"" ++ a ++ "\""))
|
||||
OcLitArray a -> wrapl "array-literal" (map top a)
|
||||
OcTrue -> Item "true"
|
||||
OcFalse -> Item "false"
|
||||
OcName a -> wrap "name" (Item a)
|
||||
N.Decl a b -> wrap2 ":" (top a) (top b)
|
||||
N.Alt a -> wrapl "alt" (map top a)
|
||||
N.AltRep a b -> wrap2 "alt-rep" (top a) (top b)
|
||||
N.PriAlt a -> wrapl "pri-alt" (map top a)
|
||||
N.PriAltRep a b -> wrap2 "pri-alt-rep" (top a) (top b)
|
||||
N.In a b -> wrapl1 "?" (top a) (map top b)
|
||||
N.Variant a b -> wrap2 "variant" (top a) (top b)
|
||||
N.InCase a b -> wrapl1 "?case" (top a) (map top b)
|
||||
N.InCaseGuard a b c -> wrapl2 "?case-guarded" (top a) (top b) (map top c)
|
||||
N.InTag a b -> wrap2 "?case-tag" (top a) (top b)
|
||||
N.InAfter a b -> wrap2 "?after" (top a) (top b)
|
||||
N.Out a b -> wrapl1 "!" (top a) (map top b)
|
||||
N.OutCase a b c -> wrapl2 "!case" (top a) (top b) (map top c)
|
||||
N.ExpList a -> wrapl "exp-list" (map top a)
|
||||
N.Assign a b -> wrap2 ":=" (List $ map top a) (top b)
|
||||
N.If a -> wrapl "if" (map top a)
|
||||
N.IfRep a b -> wrap2 "if-rep" (top a) (top b)
|
||||
N.While a b -> wrap2 "while" (top a) (top b)
|
||||
N.Par a -> wrapl "par" (map top a)
|
||||
N.ParRep a b -> wrap2 "par-rep" (top a) (top b)
|
||||
N.PriPar a -> wrapl "pri-par" (map top a)
|
||||
N.PriParRep a b -> wrap2 "pri-par-rep" (top a) (top b)
|
||||
N.PlacedPar a -> wrapl "placed-par" (map top a)
|
||||
N.PlacedParRep a b -> wrap2 "placed-par-rep" (top a) (top b)
|
||||
N.Processor a b -> wrap2 "processor" (top a) (top b)
|
||||
N.Skip -> Item "skip"
|
||||
N.Stop -> Item "stop"
|
||||
N.Case a b -> wrapl1 "case" (top a) (map top b)
|
||||
N.Seq a -> wrapl "seq" (map top a)
|
||||
N.SeqRep a b -> wrap2 "seq-rep" (top a) (top b)
|
||||
N.ProcCall a b -> wrapl1 "proc-call" (top a) (map top b)
|
||||
N.MainProcess -> Item "main"
|
||||
N.Vars a b -> wrapl1 "vars" (top a) (map top b)
|
||||
N.Is a b -> wrap2 "is" (top a) (top b)
|
||||
N.IsType a b c -> wrap3 "is-type" (top a) (top b) (top c)
|
||||
N.ValIs a b -> wrap2 "val-is" (top a) (top b)
|
||||
N.ValIsType a b c -> wrap3 "val-is-type" (top a) (top b) (top c)
|
||||
N.Place a b -> wrap2 "place-at" (top a) (top b)
|
||||
N.DataType a b -> wrap2 "data-type" (top a) (top b)
|
||||
N.Record a -> wrapl "record" (map top a)
|
||||
N.PackedRecord a -> wrapl "packed-record" (map top a)
|
||||
N.Fields a b -> wrapl1 "fields" (top a) (map top b)
|
||||
N.Protocol a b -> wrapl1 "protocol" (top a) (map top b)
|
||||
N.TaggedProtocol a b -> wrapl1 "protocol-tagged" (top a) (map top b)
|
||||
N.Tag a b -> wrapl1 "tag" (top a) (map top b)
|
||||
N.Formal a b -> wrap2 "formal" (top a) (top b)
|
||||
N.Proc a b c -> wrap3 "proc" (top a) (List $ map top b) (top c)
|
||||
N.Func a b c d -> wrap4 "function" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
N.FuncIs a b c d -> wrap4 "function-is" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
N.Retypes a b c -> wrap3 "retypes" (top a) (top b) (top c)
|
||||
N.ValRetypes a b c -> wrap3 "val-retypes" (top a) (top b) (top c)
|
||||
N.Reshapes a b c -> wrap3 "reshapes" (top a) (top b) (top c)
|
||||
N.ValReshapes a b c -> wrap3 "val-reshapes" (top a) (top b) (top c)
|
||||
N.ValOf a b -> wrap2 "valof" (top a) (top b)
|
||||
N.Sub a b -> wrap2 "sub" (top a) (top b)
|
||||
N.SubFromFor a b c -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
N.SubFrom a b -> wrap2 "sub-from" (top a) (top b)
|
||||
N.SubFor a b -> wrap2 "sub-for" (top a) (top b)
|
||||
N.CaseExps a b -> wrap2 "case-exps" (List $ map top a) (top b)
|
||||
N.Else a -> wrap "else" (top a)
|
||||
N.For a b c -> wrap3 "for" (top a) (top b) (top c)
|
||||
N.Conv a b -> wrap2 "conv" (top a) (top b)
|
||||
N.Round a b -> wrap2 "round" (top a) (top b)
|
||||
N.Trunc a b -> wrap2 "trunc" (top a) (top b)
|
||||
N.Add a b -> wrap2 "+" (top a) (top b)
|
||||
N.Subtr a b -> wrap2 "-" (top a) (top b)
|
||||
N.Mul a b -> wrap2 "*" (top a) (top b)
|
||||
N.Div a b -> wrap2 "/" (top a) (top b)
|
||||
N.Rem a b -> wrap2 "mod" (top a) (top b)
|
||||
N.Plus a b -> wrap2 "plus" (top a) (top b)
|
||||
N.Minus a b -> wrap2 "minus" (top a) (top b)
|
||||
N.Times a b -> wrap2 "times" (top a) (top b)
|
||||
N.BitAnd a b -> wrap2 "bitand" (top a) (top b)
|
||||
N.BitOr a b -> wrap2 "bitor" (top a) (top b)
|
||||
N.BitXor a b -> wrap2 "bitxor" (top a) (top b)
|
||||
N.And a b -> wrap2 "and" (top a) (top b)
|
||||
N.Or a b -> wrap2 "or" (top a) (top b)
|
||||
N.Eq a b -> wrap2 "=" (top a) (top b)
|
||||
N.NEq a b -> wrap2 "<>" (top a) (top b)
|
||||
N.Less a b -> wrap2 "<" (top a) (top b)
|
||||
N.More a b -> wrap2 ">" (top a) (top b)
|
||||
N.LessEq a b -> wrap2 "<=" (top a) (top b)
|
||||
N.MoreEq a b -> wrap2 ">=" (top a) (top b)
|
||||
N.After a b -> wrap2 "after" (top a) (top b)
|
||||
N.MonSub a -> wrap "-" (top a)
|
||||
N.MonBitNot a -> wrap "bitnot" (top a)
|
||||
N.MonNot a -> wrap "not" (top a)
|
||||
N.MostPos a -> wrap "mostpos" (top a)
|
||||
N.MostNeg a -> wrap "mostneg" (top a)
|
||||
N.Size a -> wrap "size" (top a)
|
||||
N.Call a b -> wrapl1 "call" (top a) (map top b)
|
||||
N.BytesIn a -> wrap "bytesin" (top a)
|
||||
N.OffsetOf a b -> wrap2 "offsetof" (top a) (top b)
|
||||
N.Guarded a b -> wrap2 "guarded" (top a) (top b)
|
||||
N.Val a -> wrap "val" (top a)
|
||||
N.ChanOf a -> wrap "chan" (top a)
|
||||
N.PortOf a -> wrap "port" (top a)
|
||||
N.Timer -> Item "timer"
|
||||
N.Array a b -> wrap2 "array" (top a) (top b)
|
||||
N.ArrayUnsized a -> wrap "array-unsized" (top a)
|
||||
N.Counted a b -> wrap2 "::" (top a) (top b)
|
||||
N.Bool -> Item "bool"
|
||||
N.Byte -> Item "byte"
|
||||
N.Int -> Item "int"
|
||||
N.Int16 -> Item "int16"
|
||||
N.Int32 -> Item "int32"
|
||||
N.Int64 -> Item "int64"
|
||||
N.Real32 -> Item "real32"
|
||||
N.Real64 -> Item "real64"
|
||||
N.Any -> Item "any"
|
||||
N.TypedLit a b -> wrap2 "typed-literal" (top a) (top b)
|
||||
N.LitReal a -> wrap "real-literal" (Item a)
|
||||
N.LitInt a -> wrap "integer-literal" (Item a)
|
||||
N.LitHex a -> wrap "hex-literal" (Item a)
|
||||
N.LitByte a -> wrap "byte-literal" (Item ("'" ++ a ++ "'"))
|
||||
N.LitString a -> wrap "string-literal" (Item ("\"" ++ a ++ "\""))
|
||||
N.LitArray a -> wrapl "array-literal" (map top a)
|
||||
N.True -> Item "true"
|
||||
N.False -> Item "false"
|
||||
N.Name a -> wrap "name" (Item a)
|
||||
_ -> error $ "Unsupported node: " ++ (show node)
|
||||
where top = nodeToSExp
|
||||
wrap name arg = List [Item name, arg]
|
||||
|
|
@ -144,129 +144,129 @@ nodeToSExp node
|
|||
wrapl1 name arg1 args = List ((Item name) : arg1 : args)
|
||||
wrapl2 name arg1 arg2 args = List ((Item name) : arg1 : arg2 : args)
|
||||
|
||||
nodeToSOccam :: Node -> SExp
|
||||
nodeToSOccam :: N.Node -> SExp
|
||||
nodeToSOccam node
|
||||
= case node of
|
||||
OcDecl a b -> wrap2 ":" (top a) (top b)
|
||||
OcAlt a -> wrapl "alt" (map top a)
|
||||
OcAltRep a b -> wrap2 "alt" (top a) (top b)
|
||||
OcPriAlt a -> wrapl "pri-alt" (map top a)
|
||||
OcPriAltRep a b -> wrap2 "pri-alt" (top a) (top b)
|
||||
OcIn a b -> wrapl1 "?" (top a) (map top b)
|
||||
OcVariant a b -> l2 (top a) (top b)
|
||||
OcInCase a b -> wrapl1 "?case" (top a) (map top b)
|
||||
OcInCaseGuard a b c -> wrapl2 "?case-guarded" (top a) (top b) (map top c)
|
||||
OcInTag a b -> wrap2 "?case" (top a) (top b)
|
||||
OcInAfter a b -> wrap2 "?after" (top a) (top b)
|
||||
OcOut a b -> wrapl1 "!" (top a) (map top b)
|
||||
OcOutCase a b c -> wrapl2 "!case" (top a) (top b) (map top c)
|
||||
OcExpList a -> List (map top a)
|
||||
OcAssign a b -> wrap2 ":=" (List $ map top a) (top b)
|
||||
OcIf a -> wrapl "if" (map top a)
|
||||
OcIfRep a b -> wrap2 "if" (top a) (top b)
|
||||
OcWhile a b -> wrap2 "while" (top a) (top b)
|
||||
OcPar a -> wrapl "par" (map top a)
|
||||
OcParRep a b -> wrap2 "par" (top a) (top b)
|
||||
OcPriPar a -> wrapl "pri-par" (map top a)
|
||||
OcPriParRep a b -> wrap2 "pri-par" (top a) (top b)
|
||||
OcPlacedPar a -> wrapl "placed-par" (map top a)
|
||||
OcPlacedParRep a b -> wrap2 "placed-par" (top a) (top b)
|
||||
OcProcessor a b -> wrap2 "processor" (top a) (top b)
|
||||
OcSkip -> Item "skip"
|
||||
OcStop -> Item "stop"
|
||||
OcCase a b -> wrapl1 "case" (top a) (map top b)
|
||||
OcSeq a -> wrapl "seq" (map top a)
|
||||
OcSeqRep a b -> wrap2 "seq" (top a) (top b)
|
||||
OcProcCall a b -> List ((top a) : (map top b))
|
||||
OcMainProcess -> Item "main"
|
||||
OcVars a b -> List ((top a) : (map top b))
|
||||
OcIs a b -> wrap2 "is" (top a) (top b)
|
||||
OcIsType a b c -> wrap3 "is" (top a) (top b) (top c)
|
||||
OcValIs a b -> wrap2 "val-is" (top a) (top b)
|
||||
OcValIsType a b c -> wrap3 "val-is" (top a) (top b) (top c)
|
||||
OcPlace a b -> wrap2 "place-at" (top a) (top b)
|
||||
OcDataType a b -> wrap2 "data-type" (top a) (top b)
|
||||
OcRecord a -> wrapl "record" (map top a)
|
||||
OcPackedRecord a -> wrapl "packed-record" (map top a)
|
||||
OcFields a b -> List ((top a) : (map top b))
|
||||
OcProtocol a b -> wrapl1 "protocol" (top a) (map top b)
|
||||
OcTaggedProtocol a b -> wrapl1 "protocol" (top a) (map top b)
|
||||
OcTag a b -> List ((top a) : (map top b))
|
||||
OcFormal a b -> l2 (top a) (top b)
|
||||
OcProc a b c -> wrap3 "proc" (top a) (List $ map top b) (top c)
|
||||
OcFunc a b c d -> wrap4 "function" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
OcFuncIs a b c d -> wrap4 "function-is" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
OcRetypes a b c -> wrap3 "retypes" (top a) (top b) (top c)
|
||||
OcValRetypes a b c -> wrap3 "val-retypes" (top a) (top b) (top c)
|
||||
OcReshapes a b c -> wrap3 "reshapes" (top a) (top b) (top c)
|
||||
OcValReshapes a b c -> wrap3 "val-reshapes" (top a) (top b) (top c)
|
||||
OcValOf a b -> wrap2 "valof" (top a) (top b)
|
||||
OcSub a b -> wrap2 "sub" (top a) (top b)
|
||||
OcSubFromFor a b c -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
OcSubFrom a b -> wrap2 "sub-from" (top a) (top b)
|
||||
OcSubFor a b -> wrap2 "sub-for" (top a) (top b)
|
||||
OcCaseExps a b -> l2 (List $ map top a) (top b)
|
||||
OcElse a -> wrap "else" (top a)
|
||||
OcFor a b c -> wrap3 "for" (top a) (top b) (top c)
|
||||
OcConv a b -> wrap2 "conv" (top a) (top b)
|
||||
OcRound a b -> wrap2 "round" (top a) (top b)
|
||||
OcTrunc a b -> wrap2 "trunc" (top a) (top b)
|
||||
OcAdd a b -> wrap2 "+" (top a) (top b)
|
||||
OcSubtr a b -> wrap2 "-" (top a) (top b)
|
||||
OcMul a b -> wrap2 "*" (top a) (top b)
|
||||
OcDiv a b -> wrap2 "/" (top a) (top b)
|
||||
OcRem a b -> wrap2 "mod" (top a) (top b)
|
||||
OcPlus a b -> wrap2 "plus" (top a) (top b)
|
||||
OcMinus a b -> wrap2 "minus" (top a) (top b)
|
||||
OcTimes a b -> wrap2 "times" (top a) (top b)
|
||||
OcBitAnd a b -> wrap2 "bitand" (top a) (top b)
|
||||
OcBitOr a b -> wrap2 "bitor" (top a) (top b)
|
||||
OcBitXor a b -> wrap2 "bitxor" (top a) (top b)
|
||||
OcAnd a b -> wrap2 "and" (top a) (top b)
|
||||
OcOr a b -> wrap2 "or" (top a) (top b)
|
||||
OcEq a b -> wrap2 "=" (top a) (top b)
|
||||
OcNEq a b -> wrap2 "<>" (top a) (top b)
|
||||
OcLess a b -> wrap2 "<" (top a) (top b)
|
||||
OcMore a b -> wrap2 ">" (top a) (top b)
|
||||
OcLessEq a b -> wrap2 "<=" (top a) (top b)
|
||||
OcMoreEq a b -> wrap2 ">=" (top a) (top b)
|
||||
OcAfter a b -> wrap2 "after" (top a) (top b)
|
||||
OcMonSub a -> wrap "-" (top a)
|
||||
OcMonBitNot a -> wrap "bitnot" (top a)
|
||||
OcMonNot a -> wrap "not" (top a)
|
||||
OcMostPos a -> wrap "mostpos" (top a)
|
||||
OcMostNeg a -> wrap "mostneg" (top a)
|
||||
OcSize a -> wrap "size" (top a)
|
||||
OcCall a b -> wrapl1 "call" (top a) (map top b)
|
||||
OcBytesIn a -> wrap "bytesin" (top a)
|
||||
OcOffsetOf a b -> wrap2 "offsetof" (top a) (top b)
|
||||
OcGuarded a b -> wrap2 "guarded" (top a) (top b)
|
||||
OcVal a -> wrap "val" (top a)
|
||||
OcChanOf a -> wrap "chan" (top a)
|
||||
OcPortOf a -> wrap "port" (top a)
|
||||
OcTimer -> Item "timer"
|
||||
OcArray a b -> wrap2 "array" (top a) (top b)
|
||||
OcArrayUnsized a -> wrap "array" (top a)
|
||||
OcCounted a b -> wrap2 "::" (top a) (top b)
|
||||
OcBool -> Item "bool"
|
||||
OcByte -> Item "byte"
|
||||
OcInt -> Item "int"
|
||||
OcInt16 -> Item "int16"
|
||||
OcInt32 -> Item "int32"
|
||||
OcInt64 -> Item "int64"
|
||||
OcReal32 -> Item "real32"
|
||||
OcReal64 -> Item "real64"
|
||||
OcAny -> Item "any"
|
||||
OcTypedLit a b -> l2 (top a) (top b)
|
||||
OcLitReal a -> Item a
|
||||
OcLitInt a -> Item a
|
||||
OcLitHex a -> Item a
|
||||
OcLitByte a -> Item ("'" ++ a ++ "'")
|
||||
OcLitString a -> Item ("\"" ++ a ++ "\"")
|
||||
OcLitArray a -> List (map top a)
|
||||
OcTrue -> Item "true"
|
||||
OcFalse -> Item "false"
|
||||
OcName a -> Item a
|
||||
N.Decl a b -> wrap2 ":" (top a) (top b)
|
||||
N.Alt a -> wrapl "alt" (map top a)
|
||||
N.AltRep a b -> wrap2 "alt" (top a) (top b)
|
||||
N.PriAlt a -> wrapl "pri-alt" (map top a)
|
||||
N.PriAltRep a b -> wrap2 "pri-alt" (top a) (top b)
|
||||
N.In a b -> wrapl1 "?" (top a) (map top b)
|
||||
N.Variant a b -> l2 (top a) (top b)
|
||||
N.InCase a b -> wrapl1 "?case" (top a) (map top b)
|
||||
N.InCaseGuard a b c -> wrapl2 "?case-guarded" (top a) (top b) (map top c)
|
||||
N.InTag a b -> wrap2 "?case" (top a) (top b)
|
||||
N.InAfter a b -> wrap2 "?after" (top a) (top b)
|
||||
N.Out a b -> wrapl1 "!" (top a) (map top b)
|
||||
N.OutCase a b c -> wrapl2 "!case" (top a) (top b) (map top c)
|
||||
N.ExpList a -> List (map top a)
|
||||
N.Assign a b -> wrap2 ":=" (List $ map top a) (top b)
|
||||
N.If a -> wrapl "if" (map top a)
|
||||
N.IfRep a b -> wrap2 "if" (top a) (top b)
|
||||
N.While a b -> wrap2 "while" (top a) (top b)
|
||||
N.Par a -> wrapl "par" (map top a)
|
||||
N.ParRep a b -> wrap2 "par" (top a) (top b)
|
||||
N.PriPar a -> wrapl "pri-par" (map top a)
|
||||
N.PriParRep a b -> wrap2 "pri-par" (top a) (top b)
|
||||
N.PlacedPar a -> wrapl "placed-par" (map top a)
|
||||
N.PlacedParRep a b -> wrap2 "placed-par" (top a) (top b)
|
||||
N.Processor a b -> wrap2 "processor" (top a) (top b)
|
||||
N.Skip -> Item "skip"
|
||||
N.Stop -> Item "stop"
|
||||
N.Case a b -> wrapl1 "case" (top a) (map top b)
|
||||
N.Seq a -> wrapl "seq" (map top a)
|
||||
N.SeqRep a b -> wrap2 "seq" (top a) (top b)
|
||||
N.ProcCall a b -> List ((top a) : (map top b))
|
||||
N.MainProcess -> Item "main"
|
||||
N.Vars a b -> List ((top a) : (map top b))
|
||||
N.Is a b -> wrap2 "is" (top a) (top b)
|
||||
N.IsType a b c -> wrap3 "is" (top a) (top b) (top c)
|
||||
N.ValIs a b -> wrap2 "val-is" (top a) (top b)
|
||||
N.ValIsType a b c -> wrap3 "val-is" (top a) (top b) (top c)
|
||||
N.Place a b -> wrap2 "place-at" (top a) (top b)
|
||||
N.DataType a b -> wrap2 "data-type" (top a) (top b)
|
||||
N.Record a -> wrapl "record" (map top a)
|
||||
N.PackedRecord a -> wrapl "packed-record" (map top a)
|
||||
N.Fields a b -> List ((top a) : (map top b))
|
||||
N.Protocol a b -> wrapl1 "protocol" (top a) (map top b)
|
||||
N.TaggedProtocol a b -> wrapl1 "protocol" (top a) (map top b)
|
||||
N.Tag a b -> List ((top a) : (map top b))
|
||||
N.Formal a b -> l2 (top a) (top b)
|
||||
N.Proc a b c -> wrap3 "proc" (top a) (List $ map top b) (top c)
|
||||
N.Func a b c d -> wrap4 "function" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
N.FuncIs a b c d -> wrap4 "function-is" (top a) (List $ map top b) (List $ map top c) (top d)
|
||||
N.Retypes a b c -> wrap3 "retypes" (top a) (top b) (top c)
|
||||
N.ValRetypes a b c -> wrap3 "val-retypes" (top a) (top b) (top c)
|
||||
N.Reshapes a b c -> wrap3 "reshapes" (top a) (top b) (top c)
|
||||
N.ValReshapes a b c -> wrap3 "val-reshapes" (top a) (top b) (top c)
|
||||
N.ValOf a b -> wrap2 "valof" (top a) (top b)
|
||||
N.Sub a b -> wrap2 "sub" (top a) (top b)
|
||||
N.SubFromFor a b c -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
N.SubFrom a b -> wrap2 "sub-from" (top a) (top b)
|
||||
N.SubFor a b -> wrap2 "sub-for" (top a) (top b)
|
||||
N.CaseExps a b -> l2 (List $ map top a) (top b)
|
||||
N.Else a -> wrap "else" (top a)
|
||||
N.For a b c -> wrap3 "for" (top a) (top b) (top c)
|
||||
N.Conv a b -> wrap2 "conv" (top a) (top b)
|
||||
N.Round a b -> wrap2 "round" (top a) (top b)
|
||||
N.Trunc a b -> wrap2 "trunc" (top a) (top b)
|
||||
N.Add a b -> wrap2 "+" (top a) (top b)
|
||||
N.Subtr a b -> wrap2 "-" (top a) (top b)
|
||||
N.Mul a b -> wrap2 "*" (top a) (top b)
|
||||
N.Div a b -> wrap2 "/" (top a) (top b)
|
||||
N.Rem a b -> wrap2 "mod" (top a) (top b)
|
||||
N.Plus a b -> wrap2 "plus" (top a) (top b)
|
||||
N.Minus a b -> wrap2 "minus" (top a) (top b)
|
||||
N.Times a b -> wrap2 "times" (top a) (top b)
|
||||
N.BitAnd a b -> wrap2 "bitand" (top a) (top b)
|
||||
N.BitOr a b -> wrap2 "bitor" (top a) (top b)
|
||||
N.BitXor a b -> wrap2 "bitxor" (top a) (top b)
|
||||
N.And a b -> wrap2 "and" (top a) (top b)
|
||||
N.Or a b -> wrap2 "or" (top a) (top b)
|
||||
N.Eq a b -> wrap2 "=" (top a) (top b)
|
||||
N.NEq a b -> wrap2 "<>" (top a) (top b)
|
||||
N.Less a b -> wrap2 "<" (top a) (top b)
|
||||
N.More a b -> wrap2 ">" (top a) (top b)
|
||||
N.LessEq a b -> wrap2 "<=" (top a) (top b)
|
||||
N.MoreEq a b -> wrap2 ">=" (top a) (top b)
|
||||
N.After a b -> wrap2 "after" (top a) (top b)
|
||||
N.MonSub a -> wrap "-" (top a)
|
||||
N.MonBitNot a -> wrap "bitnot" (top a)
|
||||
N.MonNot a -> wrap "not" (top a)
|
||||
N.MostPos a -> wrap "mostpos" (top a)
|
||||
N.MostNeg a -> wrap "mostneg" (top a)
|
||||
N.Size a -> wrap "size" (top a)
|
||||
N.Call a b -> wrapl1 "call" (top a) (map top b)
|
||||
N.BytesIn a -> wrap "bytesin" (top a)
|
||||
N.OffsetOf a b -> wrap2 "offsetof" (top a) (top b)
|
||||
N.Guarded a b -> wrap2 "guarded" (top a) (top b)
|
||||
N.Val a -> wrap "val" (top a)
|
||||
N.ChanOf a -> wrap "chan" (top a)
|
||||
N.PortOf a -> wrap "port" (top a)
|
||||
N.Timer -> Item "timer"
|
||||
N.Array a b -> wrap2 "array" (top a) (top b)
|
||||
N.ArrayUnsized a -> wrap "array" (top a)
|
||||
N.Counted a b -> wrap2 "::" (top a) (top b)
|
||||
N.Bool -> Item "bool"
|
||||
N.Byte -> Item "byte"
|
||||
N.Int -> Item "int"
|
||||
N.Int16 -> Item "int16"
|
||||
N.Int32 -> Item "int32"
|
||||
N.Int64 -> Item "int64"
|
||||
N.Real32 -> Item "real32"
|
||||
N.Real64 -> Item "real64"
|
||||
N.Any -> Item "any"
|
||||
N.TypedLit a b -> l2 (top a) (top b)
|
||||
N.LitReal a -> Item a
|
||||
N.LitInt a -> Item a
|
||||
N.LitHex a -> Item a
|
||||
N.LitByte a -> Item ("'" ++ a ++ "'")
|
||||
N.LitString a -> Item ("\"" ++ a ++ "\"")
|
||||
N.LitArray a -> List (map top a)
|
||||
N.True -> Item "true"
|
||||
N.False -> Item "false"
|
||||
N.Name a -> Item a
|
||||
_ -> error $ "Unsupported node: " ++ (show node)
|
||||
where top = nodeToSOccam
|
||||
wrap name arg = List [Item name, arg]
|
||||
|
|
|
|||
248
fco/Tree.hs
248
fco/Tree.hs
|
|
@ -1,141 +1,143 @@
|
|||
-- Tree datatype and operations
|
||||
-- This is intended to be imported qualified:
|
||||
-- import qualified Tree as N
|
||||
|
||||
module Tree where
|
||||
|
||||
data Node =
|
||||
-- {{{ BEGIN baseTransformOc
|
||||
OcDecl Node Node
|
||||
| OcAlt [Node]
|
||||
| OcAltRep Node Node
|
||||
| OcPriAlt [Node]
|
||||
| OcPriAltRep Node Node
|
||||
| OcIn Node [Node]
|
||||
-- e.g. OcInCase (OcName "c") [OcVariant .., OcVariant ..]
|
||||
| OcVariant Node Node
|
||||
| OcInCase Node [Node]
|
||||
| OcInCaseGuard Node Node [Node]
|
||||
-- FIXME can turn into OcInCase ... (OcVariant .. OcSkip)
|
||||
| OcInTag Node Node
|
||||
| OcOut Node [Node]
|
||||
| OcOutCase Node Node [Node]
|
||||
| OcExpList [Node]
|
||||
| OcAssign [Node] Node
|
||||
| OcIf [Node]
|
||||
| OcIfRep Node Node
|
||||
| OcInAfter Node Node
|
||||
| OcWhile Node Node
|
||||
| OcPar [Node]
|
||||
| OcParRep Node Node
|
||||
| OcPriPar [Node]
|
||||
| OcPriParRep Node Node
|
||||
| OcPlacedPar [Node]
|
||||
| OcPlacedParRep Node Node
|
||||
| OcProcessor Node Node
|
||||
| OcSkip
|
||||
| OcStop
|
||||
| OcCase Node [Node]
|
||||
| OcSeq [Node]
|
||||
| OcSeqRep Node Node
|
||||
| OcProcCall Node [Node]
|
||||
| OcMainProcess
|
||||
Decl Node Node
|
||||
| Alt [Node]
|
||||
| AltRep Node Node
|
||||
| PriAlt [Node]
|
||||
| PriAltRep Node Node
|
||||
| In Node [Node]
|
||||
-- e.g. InCase (Name "c") [Variant .., Variant ..]
|
||||
| Variant Node Node
|
||||
| InCase Node [Node]
|
||||
| InCaseGuard Node Node [Node]
|
||||
-- FIXME can turn into InCase ... (Variant .. Skip)
|
||||
| InTag Node Node
|
||||
| Out Node [Node]
|
||||
| OutCase Node Node [Node]
|
||||
| ExpList [Node]
|
||||
| Assign [Node] Node
|
||||
| If [Node]
|
||||
| IfRep Node Node
|
||||
| InAfter Node Node
|
||||
| While Node Node
|
||||
| Par [Node]
|
||||
| ParRep Node Node
|
||||
| PriPar [Node]
|
||||
| PriParRep Node Node
|
||||
| PlacedPar [Node]
|
||||
| PlacedParRep Node Node
|
||||
| Processor Node Node
|
||||
| Skip
|
||||
| Stop
|
||||
| Case Node [Node]
|
||||
| Seq [Node]
|
||||
| SeqRep Node Node
|
||||
| ProcCall Node [Node]
|
||||
| MainProcess
|
||||
|
||||
| OcVars Node [Node]
|
||||
| OcIs Node Node
|
||||
| OcIsType Node Node Node
|
||||
| OcValIs Node Node
|
||||
| OcValIsType Node Node Node
|
||||
| OcPlace Node Node
|
||||
| Vars Node [Node]
|
||||
| Is Node Node
|
||||
| IsType Node Node Node
|
||||
| ValIs Node Node
|
||||
| ValIsType Node Node Node
|
||||
| Place Node Node
|
||||
|
||||
| OcDataType Node Node
|
||||
| OcRecord [Node]
|
||||
| OcPackedRecord [Node]
|
||||
| OcFields Node [Node]
|
||||
| OcProtocol Node [Node]
|
||||
| OcTaggedProtocol Node [Node]
|
||||
| OcTag Node [Node]
|
||||
-- e.g. OcProc (OcName "out.string") [OcFormal OcInt (OcName "x"), OcFormal OcBool (OcName "y")]
|
||||
| OcFormal Node Node
|
||||
| OcProc Node [Node] Node
|
||||
| OcFunc Node [Node] [Node] Node
|
||||
| OcFuncIs Node [Node] [Node] Node
|
||||
| OcRetypes Node Node Node
|
||||
| OcValRetypes Node Node Node
|
||||
| OcReshapes Node Node Node
|
||||
| OcValReshapes Node Node Node
|
||||
| OcValOf Node Node
|
||||
| DataType Node Node
|
||||
| Record [Node]
|
||||
| PackedRecord [Node]
|
||||
| Fields Node [Node]
|
||||
| Protocol Node [Node]
|
||||
| TaggedProtocol Node [Node]
|
||||
| Tag Node [Node]
|
||||
-- e.g. Proc (Name "out.string") [Formal Int (Name "x"), Formal Bool (Name "y")]
|
||||
| Formal Node Node
|
||||
| Proc Node [Node] Node
|
||||
| Func Node [Node] [Node] Node
|
||||
| FuncIs Node [Node] [Node] Node
|
||||
| Retypes Node Node Node
|
||||
| ValRetypes Node Node Node
|
||||
| Reshapes Node Node Node
|
||||
| ValReshapes Node Node Node
|
||||
| ValOf Node Node
|
||||
|
||||
| OcSub Node Node
|
||||
| OcSubFromFor Node Node Node
|
||||
| OcSubFrom Node Node
|
||||
| OcSubFor Node Node
|
||||
| Sub Node Node
|
||||
| SubFromFor Node Node Node
|
||||
| SubFrom Node Node
|
||||
| SubFor Node Node
|
||||
|
||||
| OcCaseExps [Node] Node
|
||||
| OcElse Node
|
||||
| CaseExps [Node] Node
|
||||
| Else Node
|
||||
|
||||
| OcFor Node Node Node
|
||||
| For Node Node Node
|
||||
|
||||
| OcConv Node Node
|
||||
| OcRound Node Node
|
||||
| OcTrunc Node Node
|
||||
| OcAdd Node Node
|
||||
| OcSubtr Node Node
|
||||
| OcMul Node Node
|
||||
| OcDiv Node Node
|
||||
| OcRem Node Node
|
||||
| OcPlus Node Node
|
||||
| OcMinus Node Node
|
||||
| OcTimes Node Node
|
||||
| OcBitAnd Node Node
|
||||
| OcBitOr Node Node
|
||||
| OcBitXor Node Node
|
||||
| OcAnd Node Node
|
||||
| OcOr Node Node
|
||||
| OcEq Node Node
|
||||
| OcNEq Node Node
|
||||
| OcLess Node Node
|
||||
| OcMore Node Node
|
||||
| OcLessEq Node Node
|
||||
| OcMoreEq Node Node
|
||||
| OcAfter Node Node
|
||||
| OcMonSub Node
|
||||
| OcMonBitNot Node
|
||||
| OcMonNot Node
|
||||
| OcMostPos Node
|
||||
| OcMostNeg Node
|
||||
| OcSize Node
|
||||
| OcCall Node [Node]
|
||||
| OcBytesIn Node
|
||||
| OcOffsetOf Node Node
|
||||
| Conv Node Node
|
||||
| Round Node Node
|
||||
| Trunc Node Node
|
||||
| Add Node Node
|
||||
| Subtr Node Node
|
||||
| Mul Node Node
|
||||
| Div Node Node
|
||||
| Rem Node Node
|
||||
| Plus Node Node
|
||||
| Minus Node Node
|
||||
| Times Node Node
|
||||
| BitAnd Node Node
|
||||
| BitOr Node Node
|
||||
| BitXor Node Node
|
||||
| And Node Node
|
||||
| Or Node Node
|
||||
| Eq Node Node
|
||||
| NEq Node Node
|
||||
| Less Node Node
|
||||
| More Node Node
|
||||
| LessEq Node Node
|
||||
| MoreEq Node Node
|
||||
| After Node Node
|
||||
| MonSub Node
|
||||
| MonBitNot Node
|
||||
| MonNot Node
|
||||
| MostPos Node
|
||||
| MostNeg Node
|
||||
| Size Node
|
||||
| Call Node [Node]
|
||||
| BytesIn Node
|
||||
| OffsetOf Node Node
|
||||
|
||||
| OcGuarded Node Node
|
||||
| Guarded Node Node
|
||||
|
||||
| OcVal Node
|
||||
| OcChanOf Node
|
||||
| OcPortOf Node
|
||||
| OcTimer
|
||||
| OcArray Node Node
|
||||
| OcArrayUnsized Node
|
||||
| OcCounted Node Node
|
||||
| OcBool
|
||||
| OcByte
|
||||
| OcInt
|
||||
| OcInt16
|
||||
| OcInt32
|
||||
| OcInt64
|
||||
| OcReal32
|
||||
| OcReal64
|
||||
| OcAny
|
||||
| Val Node
|
||||
| ChanOf Node
|
||||
| PortOf Node
|
||||
| Timer
|
||||
| Array Node Node
|
||||
| ArrayUnsized Node
|
||||
| Counted Node Node
|
||||
| Bool
|
||||
| Byte
|
||||
| Int
|
||||
| Int16
|
||||
| Int32
|
||||
| Int64
|
||||
| Real32
|
||||
| Real64
|
||||
| Any
|
||||
|
||||
| OcTypedLit Node Node
|
||||
| OcLitReal String
|
||||
| OcLitInt String
|
||||
| OcLitHex String
|
||||
| OcLitByte String
|
||||
| OcLitString String
|
||||
| OcLitArray [Node]
|
||||
| OcTrue
|
||||
| OcFalse
|
||||
| OcName String
|
||||
| TypedLit Node Node
|
||||
| LitReal String
|
||||
| LitInt String
|
||||
| LitHex String
|
||||
| LitByte String
|
||||
| LitString String
|
||||
| LitArray [Node]
|
||||
| True
|
||||
| False
|
||||
| Name String
|
||||
-- }}} END
|
||||
|
||||
-- {{{ BEGIN baseTransformInt
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ def update_def(func, f, newf):
|
|||
s = s.replace("| ", "")
|
||||
|
||||
fields = s.split()
|
||||
name = fields[0]
|
||||
name = "N." + fields[0]
|
||||
args = fields[1:]
|
||||
|
||||
lhs = []
|
||||
|
|
@ -64,7 +64,7 @@ def main():
|
|||
|
||||
module BaseTransforms where
|
||||
|
||||
import Tree
|
||||
import qualified Tree as N
|
||||
import Pass
|
||||
import Control.Monad
|
||||
""")
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user