Tag parse tree nodes with source position metadata while parsing
This commit is contained in:
Adam Sampson
parent
d82e37c111
commit
5f697e8286
|
|
@ -56,7 +56,7 @@ main = do
|
|||
progress $ "}}}"
|
||||
|
||||
progress $ "{{{ Parser"
|
||||
let pt = parseSource preprocessed
|
||||
let pt = parseSource preprocessed fn
|
||||
progress $ pshow pt
|
||||
progress $ "}}}"
|
||||
|
||||
|
|
|
|||
|
|
@ -3,14 +3,15 @@ all: fco
|
|||
sources = \
|
||||
AST.hs \
|
||||
ASTPasses.hs \
|
||||
Main.hs \
|
||||
Metadata.hs \
|
||||
Parse.hs \
|
||||
Pass.hs \
|
||||
PrettyShow.hs \
|
||||
PT.hs \
|
||||
PTPasses.hs \
|
||||
SExpression.hs \
|
||||
PTToAST.hs \
|
||||
Main.hs
|
||||
PTToAST.hs
|
||||
|
||||
fco: $(sources)
|
||||
ghc -fglasgow-exts -o fco --make Main
|
||||
|
|
|
|||
12
fco/Metadata.hs
Normal file
12
fco/Metadata.hs
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
-- Metadata types
|
||||
|
||||
module Metadata where
|
||||
|
||||
import Data.Generics
|
||||
|
||||
type Meta = [Metadatum]
|
||||
|
||||
data Metadatum =
|
||||
SourcePos String Int Int
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
|
|
@ -5,8 +5,12 @@
|
|||
module PT where
|
||||
|
||||
import Data.Generics
|
||||
import Metadata
|
||||
|
||||
data Node =
|
||||
data Node = Node Meta NodeType
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data NodeType =
|
||||
Decl Node Node
|
||||
| Alt [Node]
|
||||
| AltRep Node Node
|
||||
|
|
|
|||
|
|
@ -6,14 +6,14 @@ import qualified PT as N
|
|||
import qualified AST as O
|
||||
|
||||
doName :: N.Node -> O.Name
|
||||
doName (N.Name s) = O.Name s
|
||||
doName (N.Node _ (N.Name s)) = O.Name s
|
||||
doName n = error $ "Can't do name: " ++ (show n)
|
||||
|
||||
doTag :: N.Node -> O.Tag
|
||||
doTag (N.Name s) = O.Tag s
|
||||
doTag (N.Node _ (N.Name s)) = O.Tag s
|
||||
|
||||
doType :: N.Node -> O.Type
|
||||
doType n = case n of
|
||||
doType n@(N.Node _ nt) = case nt of
|
||||
N.Bool -> O.Bool
|
||||
N.Byte -> O.Byte
|
||||
N.Int -> O.Int
|
||||
|
|
@ -33,14 +33,14 @@ doType n = case n of
|
|||
N.Val t -> O.Val (doType t)
|
||||
|
||||
doMonadicOp :: N.Node -> O.MonadicOp
|
||||
doMonadicOp n = case n of
|
||||
doMonadicOp n@(N.Node _ nt) = case nt of
|
||||
N.MonSub -> O.MonadicSubtr
|
||||
N.MonBitNot -> O.MonadicBitNot
|
||||
N.MonNot -> O.MonadicNot
|
||||
N.MonSize -> O.MonadicSize
|
||||
|
||||
doDyadicOp :: N.Node -> O.DyadicOp
|
||||
doDyadicOp n = case n of
|
||||
doDyadicOp n@(N.Node _ nt) = case nt of
|
||||
N.Add -> O.Add
|
||||
N.Subtr -> O.Subtr
|
||||
N.Mul -> O.Mul
|
||||
|
|
@ -63,14 +63,14 @@ doDyadicOp n = case n of
|
|||
N.After -> O.After
|
||||
|
||||
doSubscript :: N.Node -> O.Subscript
|
||||
doSubscript n = case n of
|
||||
doSubscript n@(N.Node _ nt) = case nt of
|
||||
N.SubPlain e -> O.Subscript (doExpression e)
|
||||
N.SubFromFor e f -> O.SubFromFor (doExpression e) (doExpression f)
|
||||
N.SubFrom e -> O.SubFrom (doExpression e)
|
||||
N.SubFor f -> O.SubFor (doExpression f)
|
||||
|
||||
doLiteral :: N.Node -> O.Literal
|
||||
doLiteral n = case n of
|
||||
doLiteral n@(N.Node _ nt) = case nt of
|
||||
N.TypedLit t l -> O.Literal (doType t) rep where (O.Literal _ rep) = doLiteral l
|
||||
N.LitReal s -> O.Literal O.Real32 (O.RealLiteral s)
|
||||
N.LitInt s -> O.Literal O.Int (O.IntLiteral s)
|
||||
|
|
@ -81,12 +81,12 @@ doLiteral n = case n of
|
|||
N.Sub s l -> O.SubscriptedLiteral (doSubscript s) (doLiteral l)
|
||||
|
||||
doVariable :: N.Node -> O.Variable
|
||||
doVariable n = case n of
|
||||
doVariable n@(N.Node _ nt) = case nt of
|
||||
N.Name _ -> O.Variable (doName n)
|
||||
N.Sub s v -> O.SubscriptedVariable (doSubscript s) (doVariable v)
|
||||
|
||||
doExpression :: N.Node -> O.Expression
|
||||
doExpression n = case n of
|
||||
doExpression n@(N.Node _ nt) = case nt of
|
||||
N.MonadicOp o a -> O.Monadic (doMonadicOp o) (doExpression a)
|
||||
N.DyadicOp o a b -> O.Dyadic (doDyadicOp o) (doExpression a) (doExpression b)
|
||||
N.MostPos t -> O.MostPos (doType t)
|
||||
|
|
@ -110,67 +110,67 @@ doExpression n = case n of
|
|||
otherwise -> O.ExprVariable (doVariable n)
|
||||
|
||||
doExpressionList :: N.Node -> O.ExpressionList
|
||||
doExpressionList n = case n of
|
||||
doExpressionList n@(N.Node _ nt) = case nt of
|
||||
N.Call f es -> O.FunctionCallList (doName f) (map doExpression es)
|
||||
N.ExpList es -> O.ExpressionList (map doExpression es)
|
||||
|
||||
doReplicator :: N.Node -> O.Replicator
|
||||
doReplicator n = case n of
|
||||
doReplicator n@(N.Node _ nt) = case nt of
|
||||
N.For v f t -> O.For (doName v) (doExpression f) (doExpression t)
|
||||
|
||||
doFields :: [N.Node] -> [(O.Type, O.Tag)]
|
||||
doFields ns = concat $ [[(doType t, doTag f) | f <- fs] | (N.Fields t fs) <- ns]
|
||||
doFields ns = concat $ [[(doType t, doTag f) | f <- fs] | (N.Node _ (N.Fields t fs)) <- ns]
|
||||
|
||||
doFormals :: [N.Node] -> [(O.Type, O.Name)]
|
||||
doFormals fs = concat $ [[(doType t, doName n) | n <- ns] | (N.Formals t ns) <- fs]
|
||||
doFormals fs = concat $ [[(doType t, doName n) | n <- ns] | (N.Node _ (N.Formals t ns)) <- fs]
|
||||
|
||||
doVariant :: N.Node -> O.Structured O.Variant
|
||||
doVariant n = case n of
|
||||
N.Variant (N.Tag t is) p -> O.Only $ O.Variant (doTag t) (map doInputItem is) (doProcess p)
|
||||
doVariant n@(N.Node _ nt) = case nt of
|
||||
N.Variant (N.Node _ (N.Tag t is)) p -> O.Only $ O.Variant (doTag t) (map doInputItem is) (doProcess p)
|
||||
N.Decl s v -> doSpecifications s O.Spec (doVariant v)
|
||||
|
||||
doChoice :: N.Node -> O.Structured O.Choice
|
||||
doChoice n = case n of
|
||||
doChoice n@(N.Node _ nt) = case nt of
|
||||
N.If cs -> O.Several $ map doChoice cs
|
||||
N.IfRep r c -> O.Rep (doReplicator r) (doChoice c)
|
||||
N.Choice b p -> O.Only $ O.Choice (doExpression b) (doProcess p)
|
||||
N.Decl s c -> doSpecifications s O.Spec (doChoice c)
|
||||
|
||||
doOption :: N.Node -> O.Structured O.Option
|
||||
doOption n = case n of
|
||||
doOption n@(N.Node _ nt) = case nt of
|
||||
N.CaseExps cs p -> O.Only $ O.Option (map doExpression cs) (doProcess p)
|
||||
N.Else p -> O.Only $ O.Else (doProcess p)
|
||||
N.Decl s o -> doSpecifications s O.Spec (doOption o)
|
||||
|
||||
doInputItem :: N.Node -> O.InputItem
|
||||
doInputItem n = case n of
|
||||
doInputItem n@(N.Node _ nt) = case nt of
|
||||
N.Counted c d -> O.InCounted (doVariable c) (doVariable d)
|
||||
otherwise -> O.InVariable (doVariable n)
|
||||
|
||||
doOutputItem :: N.Node -> O.OutputItem
|
||||
doOutputItem n = case n of
|
||||
doOutputItem n@(N.Node _ nt) = case nt of
|
||||
N.Counted c d -> O.OutCounted (doExpression c) (doExpression d)
|
||||
otherwise -> O.OutExpression (doExpression n)
|
||||
|
||||
doInputMode :: N.Node -> O.InputMode
|
||||
doInputMode n = case n of
|
||||
doInputMode n@(N.Node _ nt) = case nt of
|
||||
N.InSimple is -> O.InputSimple (map doInputItem is)
|
||||
N.InCase vs -> O.InputCase (O.Several $ map doVariant vs)
|
||||
N.InTag (N.Tag t is) -> O.InputCase (O.Only $ O.Variant (doTag t) (map doInputItem is) O.Skip)
|
||||
N.InTag (N.Node _ (N.Tag t is)) -> O.InputCase (O.Only $ O.Variant (doTag t) (map doInputItem is) O.Skip)
|
||||
N.InAfter e -> O.InputAfter (doExpression e)
|
||||
|
||||
doSimpleSpec :: N.Node -> O.Specification
|
||||
doSimpleSpec n = case n of
|
||||
doSimpleSpec n@(N.Node _ nt) = case nt of
|
||||
N.Is d v -> (doName d, O.Is O.Infer (doVariable v))
|
||||
N.IsType t d v -> (doName d, O.Is (doType t) (doVariable v))
|
||||
N.ValIs d e -> (doName d, O.ValIs O.Infer (doExpression e))
|
||||
N.ValIsType t d e -> (doName d, O.ValIs (doType t) (doExpression e))
|
||||
N.Place v e -> (doName v, O.Place (doExpression e))
|
||||
N.DataType n (N.Record fs) -> (doName n, O.DataTypeRecord False (doFields fs))
|
||||
N.DataType n (N.PackedRecord fs) -> (doName n, O.DataTypeRecord True (doFields fs))
|
||||
N.DataType n (N.Node _ (N.Record fs)) -> (doName n, O.DataTypeRecord False (doFields fs))
|
||||
N.DataType n (N.Node _ (N.PackedRecord fs)) -> (doName n, O.DataTypeRecord True (doFields fs))
|
||||
N.DataType n t -> (doName n, O.DataTypeIs (doType t))
|
||||
N.Protocol n is -> (doName n, O.ProtocolIs (map doType is))
|
||||
N.TaggedProtocol n ts -> (doName n, O.ProtocolCase [(doTag tn, map doType tts) | (N.Tag tn tts) <- ts])
|
||||
N.TaggedProtocol n ts -> (doName n, O.ProtocolCase [(doTag tn, map doType tts) | (N.Node _ (N.Tag tn tts)) <- ts])
|
||||
N.Proc n fs p -> (doName n, O.Proc (doFormals fs) (doProcess p))
|
||||
N.Func n rs fs vp -> (doName n, O.Function (map doType rs) (doFormals fs) (doValueProcess vp))
|
||||
N.FuncIs n rs fs el -> (doName n, O.Function (map doType rs) (doFormals fs) (O.ValOf O.Skip (doExpressionList el)))
|
||||
|
|
@ -180,24 +180,24 @@ doSimpleSpec n = case n of
|
|||
N.ValReshapes t d s -> (doName d, O.ValReshapes (doType t) (doVariable s))
|
||||
|
||||
doSpecifications :: N.Node -> (O.Specification -> a -> a) -> a -> a
|
||||
doSpecifications n comb arg = case n of
|
||||
doSpecifications n@(N.Node m nt) comb arg = case nt of
|
||||
N.Vars t [] -> arg
|
||||
N.Vars t (v:vs) -> comb (doName v, O.Declaration (doType t)) (doSpecifications (N.Vars t vs) comb arg)
|
||||
N.Vars t (v:vs) -> comb (doName v, O.Declaration (doType t)) (doSpecifications (N.Node m (N.Vars t vs)) comb arg)
|
||||
otherwise -> comb (doSimpleSpec n) arg
|
||||
|
||||
doAlternative :: N.Node -> O.Alternative
|
||||
doAlternative n = case n of
|
||||
N.Guard (N.In c m) p -> O.Alternative (doVariable c) (doInputMode m) (doProcess p)
|
||||
N.Guard (N.CondGuard b (N.In c m)) p -> O.AlternativeCond (doExpression b) (doVariable c) (doInputMode m) (doProcess p)
|
||||
N.Guard (N.CondGuard b N.Skip) p -> O.AlternativeSkip (doExpression b) (doProcess p)
|
||||
doAlternative n@(N.Node _ nt) = case nt of
|
||||
N.Guard (N.Node _ (N.In c m)) p -> O.Alternative (doVariable c) (doInputMode m) (doProcess p)
|
||||
N.Guard (N.Node _ (N.CondGuard b (N.Node _ (N.In c m)))) p -> O.AlternativeCond (doExpression b) (doVariable c) (doInputMode m) (doProcess p)
|
||||
N.Guard (N.Node _ (N.CondGuard b (N.Node _ N.Skip))) p -> O.AlternativeSkip (doExpression b) (doProcess p)
|
||||
-- ALT over "? CASE": the O.Skip that gets inserted here doesn't correspond
|
||||
-- to anything in real occam; it's just there to let us handle these the same
|
||||
-- way as the regular ALT inputs.
|
||||
N.In c m@(N.InCase _) -> O.Alternative (doVariable c) (doInputMode m) O.Skip
|
||||
N.CondGuard b (N.In c m@(N.InCase _)) -> O.AlternativeCond (doExpression b) (doVariable c) (doInputMode m) O.Skip
|
||||
N.In c m@(N.Node _ (N.InCase _)) -> O.Alternative (doVariable c) (doInputMode m) O.Skip
|
||||
N.CondGuard b (N.Node _ (N.In c m@(N.Node _ (N.InCase _)))) -> O.AlternativeCond (doExpression b) (doVariable c) (doInputMode m) O.Skip
|
||||
|
||||
doAlt :: N.Node -> O.Structured O.Alternative
|
||||
doAlt n = case n of
|
||||
doAlt n@(N.Node _ nt) = case nt of
|
||||
N.Alt ns -> O.Several $ map doAlt ns
|
||||
N.PriAlt ns -> O.Several $ map doAlt ns
|
||||
N.AltRep r n -> O.Rep (doReplicator r) (doAlt n)
|
||||
|
|
@ -206,19 +206,19 @@ doAlt n = case n of
|
|||
otherwise -> O.Only $ doAlternative n
|
||||
|
||||
doValueProcess :: N.Node -> O.ValueProcess
|
||||
doValueProcess n = case n of
|
||||
doValueProcess n@(N.Node _ nt) = case nt of
|
||||
N.Decl s n -> doSpecifications s O.ValOfSpec (doValueProcess n)
|
||||
N.ValOf p el -> O.ValOf (doProcess p) (doExpressionList el)
|
||||
|
||||
doPlacedPar :: N.Node -> O.Structured O.Process
|
||||
doPlacedPar n = case n of
|
||||
doPlacedPar n@(N.Node _ nt) = case nt of
|
||||
N.PlacedPar ps -> O.Several $ map doPlacedPar ps
|
||||
N.PlacedParRep r p -> O.Rep (doReplicator r) (doPlacedPar p)
|
||||
N.Processor e p -> O.Only $ O.Processor (doExpression e) (doProcess p)
|
||||
N.Decl s p -> doSpecifications s O.Spec (doPlacedPar p)
|
||||
|
||||
doProcess :: N.Node -> O.Process
|
||||
doProcess n = case n of
|
||||
doProcess n@(N.Node _ nt) = case nt of
|
||||
N.Decl s p -> doSpecifications s O.ProcSpec (doProcess p)
|
||||
N.Assign vs el -> O.Assign (map doVariable vs) (doExpressionList el)
|
||||
N.In c m -> O.Input (doVariable c) (doInputMode m)
|
||||
|
|
|
|||
385
fco/Parse.hs
385
fco/Parse.hs
|
|
@ -9,6 +9,17 @@ import Text.ParserCombinators.Parsec.Language (emptyDef)
|
|||
import qualified IO
|
||||
|
||||
import qualified PT as N
|
||||
import Metadata
|
||||
|
||||
-- -------------------------------------------------------------
|
||||
|
||||
md :: Parser Meta
|
||||
md = do
|
||||
pos <- getPosition
|
||||
return $ [SourcePos (sourceName pos) (sourceLine pos) (sourceColumn pos)]
|
||||
|
||||
nd :: Meta -> N.NodeType -> N.Node
|
||||
nd = N.Node
|
||||
|
||||
-- -------------------------------------------------------------
|
||||
|
||||
|
|
@ -212,11 +223,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 $ 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 $ N.ValIs n e })
|
||||
<|> do { s <- specifier ; n <- name ; sIS ; e <- expression ; sColon ; eol ; return $ N.ValIsType s n e } }
|
||||
= try (do { m <- md ; n <- name ; sIS ; v <- variable ; sColon ; eol ; return $ nd m $ N.Is n v })
|
||||
<|> try (do { m <- md ; s <- specifier ; n <- name ; sIS ; v <- variable ; sColon ; eol ; return $ nd m $ N.IsType s n v })
|
||||
<|> do { m <- md ; sVAL ;
|
||||
try (do { n <- name ; sIS ; e <- expression ; sColon ; eol ; return $ nd m $ N.ValIs n e })
|
||||
<|> do { s <- specifier ; n <- name ; sIS ; e <- expression ; sColon ; eol ; return $ nd m $ N.ValIsType s n e } }
|
||||
<?> "abbreviation"
|
||||
|
||||
actual
|
||||
|
|
@ -226,16 +237,16 @@ actual
|
|||
<?> "actual"
|
||||
|
||||
allocation
|
||||
= do { sPLACE ; n <- name ; sAT ; e <- expression ; sColon ; eol ; return $ N.Place n e }
|
||||
= do { m <- md ; sPLACE ; n <- name ; sAT ; e <- expression ; sColon ; eol ; return $ nd m $ N.Place n e }
|
||||
<?> "allocation"
|
||||
|
||||
alternation
|
||||
= do { sALT ;
|
||||
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 $ N.PriAlt as }
|
||||
<|> do { r <- replicator ; eol ; indent ; a <- alternative ; outdent ; return $ N.PriAltRep r a } }
|
||||
= do { m <- md ; sALT ;
|
||||
do { eol ; indent ; as <- many1 alternative ; outdent ; return $ nd m $ N.Alt as }
|
||||
<|> do { r <- replicator ; eol ; indent ; a <- alternative ; outdent ; return $ nd m $ N.AltRep r a } }
|
||||
<|> do { m <- md ; sPRI ; sALT ;
|
||||
do { eol ; indent ; as <- many1 alternative ; outdent ; return $ nd m $ N.PriAlt as }
|
||||
<|> do { r <- replicator ; eol ; indent ; a <- alternative ; outdent ; return $ nd m $ N.PriAltRep r a } }
|
||||
<?> "alternation"
|
||||
|
||||
-- The reason the CASE guards end up here is because they have to be handled
|
||||
|
|
@ -244,13 +255,13 @@ alternation
|
|||
alternative
|
||||
= guardedAlternative
|
||||
<|> alternation
|
||||
<|> try (do { b <- boolean ; sAmp ; c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ N.CondGuard b (N.In c (N.InCase vs)) })
|
||||
<|> try (do { c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ N.In c (N.InCase vs) })
|
||||
<|> do { s <- specification ; a <- alternative ; return $ N.Decl s a }
|
||||
<|> try (do { m <- md ; b <- boolean ; sAmp ; c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ nd m $ N.CondGuard b (nd m $ N.In c (nd m $ N.InCase vs)) })
|
||||
<|> try (do { m <- md ; c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ nd m $ N.In c (nd m $ N.InCase vs) })
|
||||
<|> do { m <- md ; s <- specification ; a <- alternative ; return $ nd m $ N.Decl s a }
|
||||
<?> "alternative"
|
||||
|
||||
assignment
|
||||
= do { vs <- variableList ; sAssign ; es <- expressionList ; eol ; return $ N.Assign vs es }
|
||||
= do { m <- md ; vs <- variableList ; sAssign ; es <- expressionList ; eol ; return $ nd m $ N.Assign vs es }
|
||||
<?> "assignment"
|
||||
|
||||
base
|
||||
|
|
@ -262,7 +273,7 @@ boolean
|
|||
<?> "boolean"
|
||||
|
||||
byte
|
||||
= lexeme (do { char '\'' ; s <- character ; char '\'' ; return $ N.LitByte s })
|
||||
= lexeme (do { m <- md ; char '\'' ; s <- character ; char '\'' ; return $ nd m $ N.LitByte s })
|
||||
<?> "byte"
|
||||
|
||||
caseExpression
|
||||
|
|
@ -270,26 +281,26 @@ caseExpression
|
|||
<?> "caseExpression"
|
||||
|
||||
caseInput
|
||||
= do { c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ N.In c (N.InCase vs) }
|
||||
= do { m <- md ; c <- channel ; sQuest ; sCASE ; eol ; indent ; vs <- many1 variant ; outdent ; return $ nd m $ N.In c (nd m $ N.InCase 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 (\e s -> N.Sub (N.SubPlain s) e) v es }
|
||||
= do { m <- md ; v <- channel' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\e s -> nd m $ N.Sub (nd m $ N.SubPlain s) e) v es }
|
||||
<?> "channel"
|
||||
|
||||
channel'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ N.Sub (N.SubFromFor e f) n })
|
||||
<|> try (do { sLeft ; n <- channel ; sFROM ; e <- expression ; sRight ; return $ N.Sub (N.SubFrom e) n })
|
||||
<|> do { sLeft ; n <- channel ; sFOR ; e <- expression ; sRight ; return $ N.Sub (N.SubFor e) n }
|
||||
<|> try (do { m <- md ; sLeft ; n <- channel ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFromFor e f) n })
|
||||
<|> try (do { m <- md ; sLeft ; n <- channel ; sFROM ; e <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFrom e) n })
|
||||
<|> do { m <- md ; sLeft ; n <- channel ; sFOR ; e <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFor e) n }
|
||||
<?> "channel'"
|
||||
|
||||
-- FIXME should probably make CHAN INT work, since that'd be trivial...
|
||||
channelType
|
||||
= do { sCHAN ; sOF ; p <- protocol ; return $ N.ChanOf p }
|
||||
<|> try (do { sLeft ; s <- expression ; sRight ; t <- channelType ; return $ N.Array s t })
|
||||
= do { m <- md ; sCHAN ; sOF ; p <- protocol ; return $ nd m $ N.ChanOf p }
|
||||
<|> try (do { m <- md ; sLeft ; s <- expression ; sRight ; t <- channelType ; return $ nd m $ N.Array s t })
|
||||
<?> "channelType"
|
||||
|
||||
-- FIXME this isn't at all the right way to return the character!
|
||||
|
|
@ -303,18 +314,19 @@ character
|
|||
occamChoice
|
||||
= guardedChoice
|
||||
<|> conditional
|
||||
<|> do { s <- try specification ; c <- occamChoice ; return $ N.Decl s c }
|
||||
<|> do { m <- md ; s <- try specification ; c <- occamChoice ; return $ nd m $ N.Decl s c }
|
||||
<?> "choice"
|
||||
|
||||
conditional
|
||||
= do { sIF ;
|
||||
do { eol ; indent ; cs <- many1 occamChoice ; outdent ; return $ N.If cs }
|
||||
<|> do { r <- replicator ; eol ; indent ; c <- occamChoice ; outdent ; return $ N.IfRep r c } }
|
||||
= do { m <- md ; sIF ;
|
||||
do { eol ; indent ; cs <- many1 occamChoice ; outdent ; return $ nd m $ N.If cs }
|
||||
<|> do { r <- replicator ; eol ; indent ; c <- occamChoice ; outdent ; return $ nd m $ N.IfRep r c } }
|
||||
<?> "conditional"
|
||||
|
||||
conversion
|
||||
= do t <- dataType
|
||||
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 }
|
||||
= do m <- md
|
||||
t <- dataType
|
||||
do { sROUND ; o <- operand ; return $ nd m $ N.Round t o } <|> do { sTRUNC ; o <- operand ; return $ nd m $ N.Trunc t o } <|> do { o <- operand ; return $ nd m $ N.Conv t o }
|
||||
<?> "conversion"
|
||||
|
||||
occamCount
|
||||
|
|
@ -322,15 +334,15 @@ occamCount
|
|||
<?> "count"
|
||||
|
||||
dataType
|
||||
= 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 })
|
||||
= do { m <- md ; sBOOL ; return $ nd m $ N.Bool }
|
||||
<|> do { m <- md ; sBYTE ; return $ nd m $ N.Byte }
|
||||
<|> do { m <- md ; sINT ; return $ nd m $ N.Int }
|
||||
<|> do { m <- md ; sINT16 ; return $ nd m $ N.Int16 }
|
||||
<|> do { m <- md ; sINT32 ; return $ nd m $ N.Int32 }
|
||||
<|> do { m <- md ; sINT64 ; return $ nd m $ N.Int64 }
|
||||
<|> do { m <- md ; sREAL32 ; return $ nd m $ N.Real32 }
|
||||
<|> do { m <- md ; sREAL64 ; return $ nd m $ N.Real64 }
|
||||
<|> try (do { m <- md ; sLeft ; s <- expression ; sRight ; t <- dataType ; return $ nd m $ N.Array s t })
|
||||
<|> name
|
||||
<?> "data type"
|
||||
|
||||
|
|
@ -341,28 +353,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 N.Node for each type of declaration
|
||||
-- it might be nicer to generate a different nd m $ N.Node for each type of declaration
|
||||
declaration
|
||||
= do { d <- declType ; ns <- sepBy1 name sComma ; sColon ; eol ; return $ N.Vars d ns }
|
||||
= do { m <- md ; d <- declType ; ns <- sepBy1 name sComma ; sColon ; eol ; return $ nd m $ N.Vars d ns }
|
||||
<?> "declaration"
|
||||
|
||||
definition
|
||||
= do { sDATA ; sTYPE ; n <- name ;
|
||||
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 $ 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 $ 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 $ 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 $ N.ValRetypes s n v }
|
||||
<|> do { sRESHAPES ; v <- variable ; sColon ; eol ; return $ N.ValReshapes s n v } }
|
||||
= do { m <- md ; sDATA ; sTYPE ; n <- name ;
|
||||
do {sIS ; t <- dataType ; sColon ; eol ; return $ nd m $ N.DataType n t }
|
||||
<|> do { eol ; indent ; t <- structuredType ; outdent ; sColon ; eol ; return $ nd m $ N.DataType n t } }
|
||||
<|> do { m <- md ; sPROTOCOL ; n <- name ;
|
||||
do { sIS ; p <- sequentialProtocol ; sColon ; eol ; return $ nd m $ N.Protocol n p }
|
||||
<|> do { eol ; indent ; sCASE ; eol ; indent ; ps <- many1 taggedProtocol ; outdent ; outdent ; sColon ; eol ; return $ nd m $ N.TaggedProtocol n ps } }
|
||||
<|> do { m <- md ; sPROC ; n <- name ; fs <- formalList ; eol ; indent ; p <- process ; outdent ; sColon ; eol ; return $ nd m $ N.Proc n fs p }
|
||||
<|> try (do { m <- md ; rs <- sepBy1 dataType sComma ; (n, fs) <- functionHeader ;
|
||||
do { sIS ; el <- expressionList ; sColon ; eol ; return $ nd m $ N.FuncIs n rs fs el }
|
||||
<|> do { eol ; indent ; vp <- valueProcess ; outdent ; sColon ; eol ; return $ nd m $ N.Func n rs fs vp } })
|
||||
<|> try (do { m <- md ; s <- specifier ; n <- name ;
|
||||
do { sRETYPES ; v <- variable ; sColon ; eol ; return $ nd m $ N.Retypes s n v }
|
||||
<|> do { try sRESHAPES ; v <- variable ; sColon ; eol ; return $ nd m $ N.Reshapes s n v } })
|
||||
<|> do { m <- md ; sVAL ; s <- specifier ; n <- name ;
|
||||
do { sRETYPES ; v <- variable ; sColon ; eol ; return $ nd m $ N.ValRetypes s n v }
|
||||
<|> do { sRESHAPES ; v <- variable ; sColon ; eol ; return $ nd m $ N.ValReshapes s n v } }
|
||||
<?> "definition"
|
||||
|
||||
digits
|
||||
|
|
@ -370,49 +382,48 @@ digits
|
|||
<?> "digits"
|
||||
|
||||
dyadicOperator
|
||||
= 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 }
|
||||
= do { m <- md ; reservedOp "+" ; return $ nd m $ N.Add }
|
||||
<|> do { m <- md ; reservedOp "-" ; return $ nd m $ N.Subtr }
|
||||
<|> do { m <- md ; reservedOp "*" ; return $ nd m $ N.Mul }
|
||||
<|> do { m <- md ; reservedOp "/" ; return $ nd m $ N.Div }
|
||||
<|> do { m <- md ; reservedOp "\\" ; return $ nd m $ N.Rem }
|
||||
<|> do { m <- md ; sREM ; return $ nd m $ N.Rem }
|
||||
<|> do { m <- md ; sPLUS ; return $ nd m $ N.Plus }
|
||||
<|> do { m <- md ; sMINUS ; return $ nd m $ N.Minus }
|
||||
<|> do { m <- md ; sTIMES ; return $ nd m $ N.Times }
|
||||
<|> do { m <- md ; reservedOp "/\\" ; return $ nd m $ N.BitAnd }
|
||||
<|> do { m <- md ; reservedOp "\\/" ; return $ nd m $ N.BitOr }
|
||||
<|> do { m <- md ; reservedOp "><" ; return $ nd m $ N.BitXor }
|
||||
<|> do { m <- md ; sBITAND ; return $ nd m $ N.BitAnd }
|
||||
<|> do { m <- md ; sBITOR ; return $ nd m $ N.BitOr }
|
||||
<|> do { m <- md ; sAND ; return $ nd m $ N.And }
|
||||
<|> do { m <- md ; sOR ; return $ nd m $ N.Or }
|
||||
<|> do { m <- md ; reservedOp "=" ; return $ nd m $ N.Eq }
|
||||
<|> do { m <- md ; reservedOp "<>" ; return $ nd m $ N.NEq }
|
||||
<|> do { m <- md ; reservedOp "<" ; return $ nd m $ N.Less }
|
||||
<|> do { m <- md ; reservedOp ">" ; return $ nd m $ N.More }
|
||||
<|> do { m <- md ; reservedOp "<=" ; return $ nd m $ N.LessEq }
|
||||
<|> do { m <- md ; reservedOp ">=" ; return $ nd m $ N.MoreEq }
|
||||
<|> do { m <- md ; sAFTER ; return $ nd m $ N.After }
|
||||
<?> "dyadicOperator"
|
||||
|
||||
occamExponent
|
||||
= try (do { c <- oneOf "+-" ; d <- digits ; return $ c : d })
|
||||
<?> "exponent"
|
||||
|
||||
expression :: Parser N.Node
|
||||
expression
|
||||
= try (do { o <- monadicOperator ; v <- operand ; return $ N.MonadicOp o v })
|
||||
<|> 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 $ N.DyadicOp o a b })
|
||||
= try (do { m <- md ; o <- monadicOperator ; v <- operand ; return $ nd m $ N.MonadicOp o v })
|
||||
<|> do { m <- md ; a <- sMOSTPOS ; t <- dataType ; return $ nd m $ N.MostPos t }
|
||||
<|> do { m <- md ; a <- sMOSTNEG ; t <- dataType ; return $ nd m $ N.MostNeg t }
|
||||
<|> do { m <- md ; a <- sSIZE ; t <- dataType ; return $ nd m $ N.Size t }
|
||||
<|> try (do { m <- md ; a <- operand ; o <- dyadicOperator ; b <- operand ; return $ nd m $ N.DyadicOp o a b })
|
||||
<|> try conversion
|
||||
<|> operand
|
||||
<?> "expression"
|
||||
|
||||
expressionList
|
||||
= try (do { n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ N.Call n as })
|
||||
<|> do { es <- sepBy1 expression sComma ; return $ N.ExpList es }
|
||||
= try (do { m <- md ; n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ nd m $ N.Call n as })
|
||||
<|> do { m <- md ; es <- sepBy1 expression sComma ; return $ nd m $ N.ExpList es }
|
||||
-- XXX value process
|
||||
<?> "expressionList"
|
||||
|
||||
|
|
@ -423,23 +434,23 @@ fieldName
|
|||
-- This is rather different from the grammar, since I had some difficulty
|
||||
-- getting Parsec to parse it as a list of lists of arguments.
|
||||
formalList
|
||||
= do { sLeftR ; fs <- sepBy formalArg sComma ; sRightR ; return $ markTypes fs }
|
||||
= do { m <- md ; sLeftR ; fs <- sepBy formalArg sComma ; sRightR ; return $ markTypes m fs }
|
||||
<?> "formalList"
|
||||
where
|
||||
formalArg :: Parser (Maybe N.Node, N.Node)
|
||||
formalArg = try (do { sVAL ; s <- specifier ; n <- name ; return $ (Just (N.Val s), n) })
|
||||
formalArg = try (do { m <- md ; sVAL ; s <- specifier ; n <- name ; return $ (Just (nd m $ N.Val s), n) })
|
||||
<|> try (do { s <- specifier ; n <- name ; return $ (Just s, n) })
|
||||
<|> try (do { n <- name ; return $ (Nothing, n) })
|
||||
|
||||
markTypes :: [(Maybe N.Node, N.Node)] -> [N.Node]
|
||||
markTypes [] = []
|
||||
markTypes ((Nothing, _):_) = error "Formal list must start with a type"
|
||||
markTypes ((Just ft, fn):is) = markRest ft [fn] is
|
||||
markTypes :: Meta -> [(Maybe N.Node, N.Node)] -> [N.Node]
|
||||
markTypes _ [] = []
|
||||
markTypes _ ((Nothing, _):_) = error "Formal list must start with a type"
|
||||
markTypes m ((Just ft, fn):is) = markRest m ft [fn] is
|
||||
|
||||
markRest :: N.Node -> [N.Node] -> [(Maybe N.Node, N.Node)] -> [N.Node]
|
||||
markRest lt ns [] = [N.Formals lt ns]
|
||||
markRest lt ns ((Nothing, n):is) = markRest lt (ns ++ [n]) is
|
||||
markRest lt ns ((Just t, n):is) = (markRest lt ns []) ++ (markRest t [n] is)
|
||||
markRest :: Meta -> N.Node -> [N.Node] -> [(Maybe N.Node, N.Node)] -> [N.Node]
|
||||
markRest m lt ns [] = [nd m $ N.Formals lt ns]
|
||||
markRest m lt ns ((Nothing, n):is) = markRest m lt (ns ++ [n]) is
|
||||
markRest m lt ns ((Just t, n):is) = (markRest m lt ns []) ++ (markRest m t [n] is)
|
||||
|
||||
functionHeader
|
||||
= do { sFUNCTION ; n <- name ; fs <- formalList ; return $ (n, fs) }
|
||||
|
|
@ -447,37 +458,38 @@ functionHeader
|
|||
|
||||
guard
|
||||
= try input
|
||||
<|> try (do { b <- boolean ; sAmp ; i <- input ; return $ N.CondGuard b i })
|
||||
<|> try (do { b <- boolean ; sAmp ; sSKIP ; eol ; return $ N.CondGuard b N.Skip })
|
||||
<|> try (do { m <- md ; b <- boolean ; sAmp ; i <- input ; return $ nd m $ N.CondGuard b i })
|
||||
<|> try (do { m <- md ; b <- boolean ; sAmp ; sSKIP ; eol ; return $ nd m $ N.CondGuard b (nd m $ N.Skip) })
|
||||
<?> "guard"
|
||||
|
||||
guardedAlternative
|
||||
= do { g <- guard ; indent ; p <- process ; outdent ; return $ N.Guard g p }
|
||||
= do { m <- md ; g <- guard ; indent ; p <- process ; outdent ; return $ nd m $ N.Guard g p }
|
||||
<?> "guardedAlternative"
|
||||
|
||||
guardedChoice
|
||||
= do { b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ N.Choice b p }
|
||||
= do { m <- md ; b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.Choice b p }
|
||||
<?> "guardedChoice"
|
||||
|
||||
hexDigits
|
||||
= do { d <- many1 hexDigit ; return $ N.LitHex d }
|
||||
= do { m <- md ; d <- many1 hexDigit ; return $ nd m $ N.LitHex d }
|
||||
<?> "hexDigits"
|
||||
|
||||
input
|
||||
= do c <- channel
|
||||
= do m <- md
|
||||
c <- channel
|
||||
sQuest
|
||||
(do { sCASE ; tl <- taggedList ; eol ; return $ N.In c (N.InTag tl) }
|
||||
<|> do { sAFTER ; e <- expression ; eol ; return $ N.In c (N.InAfter e) }
|
||||
<|> do { is <- sepBy1 inputItem sSemi ; eol ; return $ N.In c (N.InSimple is) })
|
||||
(do { sCASE ; tl <- taggedList ; eol ; return $ nd m $ N.In c (nd m $ N.InTag tl) }
|
||||
<|> do { sAFTER ; e <- expression ; eol ; return $ nd m $ N.In c (nd m $ N.InAfter e) }
|
||||
<|> do { is <- sepBy1 inputItem sSemi ; eol ; return $ nd m $ N.In c (nd m $ N.InSimple is) })
|
||||
<?> "input"
|
||||
|
||||
inputItem
|
||||
= try (do { v <- variable ; sColons ; w <- variable ; return $ N.Counted v w })
|
||||
= try (do { m <- md ; v <- variable ; sColons ; w <- variable ; return $ nd m $ N.Counted v w })
|
||||
<|> variable
|
||||
<?> "inputItem"
|
||||
|
||||
integer
|
||||
= try (do { d <- lexeme digits ; return $ N.LitInt d })
|
||||
= try (do { m <- md ; d <- lexeme digits ; return $ nd m $ N.LitInt d })
|
||||
<|> do { char '#' ; d <- lexeme hexDigits ; return $ d }
|
||||
<?> "integer"
|
||||
|
||||
|
|
@ -485,35 +497,35 @@ literal
|
|||
= try real
|
||||
<|> try integer
|
||||
<|> try byte
|
||||
<|> 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 }
|
||||
<|> try (do { m <- md ; v <- real ; sLeftR ; t <- dataType ; sRightR ; return $ nd m $ N.TypedLit t v })
|
||||
<|> try (do { m <- md ; v <- integer ; sLeftR ; t <- dataType ; sRightR ; return $ nd m $ N.TypedLit t v })
|
||||
<|> try (do { m <- md ; v <- byte ; sLeftR ; t <- dataType ; sRightR ; return $ nd m $ N.TypedLit t v })
|
||||
<|> try (do { m <- md ; sTRUE ; return $ nd m $ N.True })
|
||||
<|> do { m <- md ; sFALSE ; return $ nd m $ N.False }
|
||||
<?> "literal"
|
||||
|
||||
loop
|
||||
= do { sWHILE ; b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ N.While b p }
|
||||
= do { m <- md ; sWHILE ; b <- boolean ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.While b p }
|
||||
|
||||
monadicOperator
|
||||
= 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.MonSize }
|
||||
= do { m <- md ; reservedOp "-" ; return $ nd m $ N.MonSub }
|
||||
<|> do { m <- md ; sMINUS ; return $ nd m $ N.MonSub }
|
||||
<|> do { m <- md ; reservedOp "~" ; return $ nd m $ N.MonBitNot }
|
||||
<|> do { m <- md ; sBITNOT ; return $ nd m $ N.MonBitNot }
|
||||
<|> do { m <- md ; sNOT ; return $ nd m $ N.MonNot }
|
||||
<|> do { m <- md ; sSIZE ; return $ nd m $ N.MonSize }
|
||||
<?> "monadicOperator"
|
||||
|
||||
name
|
||||
= do { s <- identifier ; return $ N.Name s }
|
||||
= do { m <- md ; s <- identifier ; return $ nd m $ N.Name s }
|
||||
<?> "name"
|
||||
|
||||
occamString
|
||||
= lexeme (do { char '"' ; s <- many (noneOf "\"") ; char '"' ; return $ N.LitString s })
|
||||
= lexeme (do { m <- md ; char '"' ; s <- many (noneOf "\"") ; char '"' ; return $ nd m $ N.LitString s })
|
||||
<?> "string"
|
||||
|
||||
operand
|
||||
= do { v <- operand' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\e s -> N.Sub (N.SubPlain s) e) v es }
|
||||
= do { m <- md ; v <- operand' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\e s -> nd m $ N.Sub (nd m $ N.SubPlain s) e) v es }
|
||||
<?> "operand"
|
||||
|
||||
operand'
|
||||
|
|
@ -522,61 +534,62 @@ 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 $ 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 })
|
||||
<|> try (do { m <- md ; n <- name ; sLeftR ; as <- sepBy expression sComma ; sRightR ; return $ nd m $ N.Call n as })
|
||||
<|> try (do { m <- md ; sBYTESIN ; sLeftR ; o <- operand ; sRightR ; return $ nd m $ N.BytesIn o })
|
||||
<|> try (do { m <- md ; sBYTESIN ; sLeftR ; o <- dataType ; sRightR ; return $ nd m $ N.BytesIn o })
|
||||
<|> try (do { m <- md ; sOFFSETOF ; sLeftR ; n <- name ; sComma ; f <- fieldName ; sRightR ; return $ nd m $ N.OffsetOf n f })
|
||||
<?> "operand'"
|
||||
|
||||
occamOption
|
||||
= 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 }
|
||||
= try (do { m <- md ; ces <- sepBy caseExpression sComma ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.CaseExps ces p })
|
||||
<|> try (do { m <- md ; sELSE ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.Else p })
|
||||
<|> do { m <- md ; s <- specification ; o <- occamOption ; return $ nd m $ 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...
|
||||
-- ... so this now wants "c ! CASE x" if it's a tag, to match input.
|
||||
-- We can fix this with a pass later...
|
||||
output
|
||||
= do c <- channel
|
||||
= do m <- md
|
||||
c <- channel
|
||||
sBang
|
||||
(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 })
|
||||
(do { sCASE ; t <- tag ; sSemi ; os <- sepBy1 outputItem sSemi ; eol ; return $ nd m $ N.OutCase c t os }
|
||||
<|> do { sCASE ; t <- tag ; eol ; return $ nd m $ N.OutCase c t [] }
|
||||
<|> do { os <- sepBy1 outputItem sSemi ; eol ; return $ nd m $ N.Out c os })
|
||||
<?> "output"
|
||||
|
||||
outputItem
|
||||
= try (do { a <- expression ; sColons ; b <- expression ; return $ N.Counted a b })
|
||||
= try (do { m <- md ; a <- expression ; sColons ; b <- expression ; return $ nd m $ N.Counted a b })
|
||||
<|> expression
|
||||
<?> "outputItem"
|
||||
|
||||
parallel
|
||||
= 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 } }
|
||||
= do { m <- md ; sPAR ; do { eol ; indent ; ps <- many1 process ; outdent ; return $ nd m $ N.Par ps } <|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.ParRep r p } }
|
||||
<|> do { m <- md ; sPRI ; sPAR ; do { eol ; indent ; ps <- many1 process ; outdent ; return $ nd m $ N.PriPar ps } <|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ nd m $ 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 $ 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 }
|
||||
= do { m <- md ; sPLACED ; sPAR ; do { eol ; indent ; ps <- many1 placedpar ; outdent ; return $ nd m $ N.PlacedPar ps } <|> do { r <- replicator ; eol ; indent ; p <- placedpar ; outdent ; return $ nd m $ N.PlacedParRep r p } }
|
||||
<|> do { m <- md ; sPROCESSOR ; e <- expression ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.Processor e p }
|
||||
<?> "placedpar"
|
||||
|
||||
portType
|
||||
= do { sPORT ; sOF ; p <- protocol ; return $ N.PortOf p }
|
||||
<|> do { try sLeft ; s <- try expression ; try sRight ; t <- portType ; return $ N.Array s t }
|
||||
= do { m <- md ; sPORT ; sOF ; p <- protocol ; return $ nd m $ N.PortOf p }
|
||||
<|> do { m <- md ; try sLeft ; s <- try expression ; try sRight ; t <- portType ; return $ nd m $ N.Array s t }
|
||||
<?> "portType"
|
||||
|
||||
procInstance
|
||||
= do { n <- name ; sLeftR ; as <- sepBy actual sComma ; sRightR ; eol ; return $ N.ProcCall n as }
|
||||
= do { m <- md ; n <- name ; sLeftR ; as <- sepBy actual sComma ; sRightR ; eol ; return $ nd m $ N.ProcCall n as }
|
||||
<?> "procInstance"
|
||||
|
||||
process
|
||||
= try assignment
|
||||
<|> try input
|
||||
<|> try output
|
||||
<|> do { sSKIP ; eol ; return $ N.Skip }
|
||||
<|> do { sSTOP ; eol ; return $ N.Stop }
|
||||
<|> do { m <- md ; sSKIP ; eol ; return $ nd m $ N.Skip }
|
||||
<|> do { m <- md ; sSTOP ; eol ; return $ nd m $ N.Stop }
|
||||
<|> occamSequence
|
||||
<|> conditional
|
||||
<|> selection
|
||||
|
|
@ -585,9 +598,9 @@ process
|
|||
<|> alternation
|
||||
<|> try caseInput
|
||||
<|> try procInstance
|
||||
<|> 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 }
|
||||
<|> do { m <- md ; sMainMarker ; eol ; return $ nd m $ N.MainProcess }
|
||||
<|> do { m <- md ; a <- allocation ; p <- process ; return $ nd m $ N.Decl a p }
|
||||
<|> do { m <- md ; s <- specification ; p <- process ; return $ nd m $ N.Decl s p }
|
||||
<?> "process"
|
||||
|
||||
protocol
|
||||
|
|
@ -596,16 +609,16 @@ protocol
|
|||
<?> "protocol"
|
||||
|
||||
real
|
||||
= 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) }
|
||||
= try (do { m <- md ; l <- digits ; char '.' ; r <- digits ; char 'e' ; e <- lexeme occamExponent ; return $ nd m $ N.LitReal (l ++ "." ++ r ++ "e" ++ e) })
|
||||
<|> do { m <- md ; l <- digits ; char '.' ; r <- lexeme digits ; return $ nd m $ N.LitReal (l ++ "." ++ r) }
|
||||
<?> "real"
|
||||
|
||||
replicator
|
||||
= do { n <- name ; sEq ; b <- base ; sFOR ; c <- occamCount ; return $ N.For n b c }
|
||||
= do { m <- md ; n <- name ; sEq ; b <- base ; sFOR ; c <- occamCount ; return $ nd m $ N.For n b c }
|
||||
<?> "replicator"
|
||||
|
||||
selection
|
||||
= do { sCASE ; s <- selector ; eol ; indent ; os <- many1 occamOption ; outdent ; return $ N.Case s os }
|
||||
= do { m <- md ; sCASE ; s <- selector ; eol ; indent ; os <- many1 occamOption ; outdent ; return $ nd m $ N.Case s os }
|
||||
<?> "selection"
|
||||
|
||||
selector
|
||||
|
|
@ -613,9 +626,10 @@ selector
|
|||
<?> "selector"
|
||||
|
||||
occamSequence
|
||||
= do sSEQ
|
||||
(do { eol ; indent ; ps <- many1 process ; outdent ; return $ N.Seq ps }
|
||||
<|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ N.SeqRep r p })
|
||||
= do m <- md
|
||||
sSEQ
|
||||
(do { eol ; indent ; ps <- many1 process ; outdent ; return $ nd m $ N.Seq ps }
|
||||
<|> do { r <- replicator ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.SeqRep r p })
|
||||
<?> "sequence"
|
||||
|
||||
sequentialProtocol
|
||||
|
|
@ -623,9 +637,9 @@ sequentialProtocol
|
|||
<?> "sequentialProtocol"
|
||||
|
||||
simpleProtocol
|
||||
= try (do { l <- dataType ; sColons ; sLeft ; sRight ; r <- dataType ; return $ N.Counted l r })
|
||||
= try (do { m <- md ; l <- dataType ; sColons ; sLeft ; sRight ; r <- dataType ; return $ nd m $ N.Counted l r })
|
||||
<|> dataType
|
||||
<|> do { sANY ; return $ N.Any }
|
||||
<|> do { m <- md ; sANY ; return $ nd m $ N.Any }
|
||||
<?> "simpleProtocol"
|
||||
|
||||
specification
|
||||
|
|
@ -634,39 +648,38 @@ specification
|
|||
<|> definition
|
||||
<?> "specification"
|
||||
|
||||
specifier :: Parser N.Node
|
||||
specifier
|
||||
= try dataType
|
||||
<|> try channelType
|
||||
<|> try timerType
|
||||
<|> try portType
|
||||
<|> try (do { sLeft ; sRight ; s <- specifier ; return $ N.ArrayUnsized s })
|
||||
<|> do { sLeft ; e <- expression ; sRight ; s <- specifier ; return $ N.Array e s }
|
||||
<|> try (do { m <- md ; sLeft ; sRight ; s <- specifier ; return $ nd m $ N.ArrayUnsized s })
|
||||
<|> do { m <- md ; sLeft ; e <- expression ; sRight ; s <- specifier ; return $ nd m $ N.Array e s }
|
||||
<?> "specifier"
|
||||
|
||||
structuredType
|
||||
= 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 }
|
||||
= try (do { m <- md ; sRECORD ; eol ; indent ; fs <- many1 structuredTypeField ; outdent ; return $ nd m $ N.Record fs })
|
||||
<|> do { m <- md ; sPACKED ; sRECORD ; eol ; indent ; fs <- many1 structuredTypeField ; outdent ; return $ nd m $ 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 $ N.Fields t fs }
|
||||
= do { m <- md ; t <- dataType ; fs <- many1 fieldName ; sColon ; eol ; return $ nd m $ N.Fields t fs }
|
||||
<?> "structuredTypeField"
|
||||
|
||||
-- i.e. array literal
|
||||
table
|
||||
= do { v <- table' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\e s -> N.Sub (N.SubPlain s) e) v es }
|
||||
= do { m <- md ; v <- table' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\e s -> nd m $ N.Sub (nd m $ N.SubPlain s) e) v es }
|
||||
<?> "table"
|
||||
|
||||
table'
|
||||
= try occamString
|
||||
<|> try (do { s <- occamString ; sLeftR ; n <- name ; sRightR ; return $ N.TypedLit n s })
|
||||
<|> try (do { m <- md ; s <- occamString ; sLeftR ; n <- name ; sRightR ; return $ nd m $ N.TypedLit n s })
|
||||
<|> do { sLeft ;
|
||||
try (do { es <- sepBy1 expression sComma ; sRight ; return $ N.LitArray es })
|
||||
<|> try (do { n <- table ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ N.Sub (N.SubFromFor e f) n })
|
||||
<|> try (do { n <- table ; sFROM ; e <- expression ; sRight ; return $ N.Sub (N.SubFrom e) n })
|
||||
<|> do { n <- table ; sFOR ; e <- expression ; sRight ; return $ N.Sub (N.SubFor e) n } }
|
||||
try (do { m <- md ; es <- sepBy1 expression sComma ; sRight ; return $ nd m $ N.LitArray es })
|
||||
<|> try (do { m <- md ; n <- table ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFromFor e f) n })
|
||||
<|> try (do { m <- md ; n <- table ; sFROM ; e <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFrom e) n })
|
||||
<|> do { m <- md ; n <- table ; sFOR ; e <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFor e) n } }
|
||||
<?> "table'"
|
||||
|
||||
tag
|
||||
|
|
@ -674,32 +687,32 @@ tag
|
|||
<?> "tag"
|
||||
|
||||
taggedList
|
||||
= try (do { t <- tag ; sSemi ; is <- sepBy1 inputItem sSemi ; return $ N.Tag t is })
|
||||
<|> do { t <- tag ; return $ N.Tag t [] }
|
||||
= try (do { m <- md ; t <- tag ; sSemi ; is <- sepBy1 inputItem sSemi ; return $ nd m $ N.Tag t is })
|
||||
<|> do { m <- md ; t <- tag ; return $ nd m $ N.Tag t [] }
|
||||
<?> "taggedList"
|
||||
|
||||
taggedProtocol
|
||||
= try (do { t <- tag ; eol ; return $ N.Tag t [] })
|
||||
<|> try (do { t <- tag ; sSemi ; sp <- sequentialProtocol ; eol ; return $ N.Tag t sp })
|
||||
= try (do { m <- md ; t <- tag ; eol ; return $ nd m $ N.Tag t [] })
|
||||
<|> try (do { m <- md ; t <- tag ; sSemi ; sp <- sequentialProtocol ; eol ; return $ nd m $ N.Tag t sp })
|
||||
|
||||
timerType
|
||||
= do { sTIMER ; return $ N.Timer }
|
||||
<|> do { try sLeft ; s <- try expression ; try sRight ; t <- timerType ; return $ N.Array s t }
|
||||
= do { m <- md ; sTIMER ; return $ nd m $ N.Timer }
|
||||
<|> do { m <- md ; try sLeft ; s <- try expression ; try sRight ; t <- timerType ; return $ nd m $ N.Array s t }
|
||||
<?> "timerType"
|
||||
|
||||
valueProcess
|
||||
= 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 }
|
||||
= try (do { m <- md ; sVALOF ; eol ; indent ; p <- process ; sRESULT ; el <- expressionList ; eol ; outdent ; return $ nd m $ N.ValOf p el })
|
||||
<|> do { m <- md ; s <- specification ; v <- valueProcess ; return $ nd m $ N.Decl s v }
|
||||
|
||||
variable
|
||||
= do { v <- variable' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\e s -> N.Sub (N.SubPlain s) e) v es }
|
||||
= do { m <- md ; v <- variable' ; es <- many (do { sLeft ; e <- expression ; sRight ; return e }) ; return $ foldl (\e s -> nd m $ N.Sub (nd m $ N.SubPlain s) e) v es }
|
||||
<?> "variable"
|
||||
|
||||
variable'
|
||||
= try name
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ N.Sub (N.SubFromFor e f) n })
|
||||
<|> try (do { sLeft ; n <- variable ; sFROM ; e <- expression ; sRight ; return $ N.Sub (N.SubFrom e) n })
|
||||
<|> do { sLeft ; n <- variable ; sFOR ; e <- expression ; sRight ; return $ N.Sub (N.SubFor e) n }
|
||||
<|> try (do { m <- md ; sLeft ; n <- variable ; sFROM ; e <- expression ; sFOR ; f <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFromFor e f) n })
|
||||
<|> try (do { m <- md ; sLeft ; n <- variable ; sFROM ; e <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFrom e) n })
|
||||
<|> do { m <- md ; sLeft ; n <- variable ; sFOR ; e <- expression ; sRight ; return $ nd m $ N.Sub (nd m $ N.SubFor e) n }
|
||||
<?> "variable'"
|
||||
|
||||
variableList
|
||||
|
|
@ -707,8 +720,8 @@ variableList
|
|||
<?> "variableList"
|
||||
|
||||
variant
|
||||
= try (do { t <- taggedList ; eol ; indent ; p <- process ; outdent ; return $ N.Variant t p })
|
||||
<|> do { s <- specification ; v <- variant ; return $ N.Decl s v }
|
||||
= try (do { m <- md ; t <- taggedList ; eol ; indent ; p <- process ; outdent ; return $ nd m $ N.Variant t p })
|
||||
<|> do { m <- md ; s <- specification ; v <- variant ; return $ nd m $ N.Decl s v }
|
||||
<?> "variant"
|
||||
|
||||
-- -------------------------------------------------------------
|
||||
|
|
@ -775,9 +788,9 @@ readSource fn = do
|
|||
|
||||
-- -------------------------------------------------------------
|
||||
|
||||
parseSource :: String -> N.Node
|
||||
parseSource prep
|
||||
= case (parse sourceFile "occam" prep) of
|
||||
parseSource :: String -> String -> N.Node
|
||||
parseSource prep sourceFileName
|
||||
= case (parse sourceFile sourceFileName prep) of
|
||||
Left err -> error ("Parsing error: " ++ (show err))
|
||||
Right defs -> defs
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ instance Show SExp where
|
|||
show s = render $ sexpToDoc s
|
||||
|
||||
dyadicName :: N.Node -> String
|
||||
dyadicName n = case n of
|
||||
dyadicName (N.Node meta node) = case node of
|
||||
N.Add -> "+"
|
||||
N.Subtr -> "-"
|
||||
N.Mul -> "*"
|
||||
|
|
@ -39,25 +39,25 @@ dyadicName n = case n of
|
|||
N.After -> "after"
|
||||
|
||||
monadicName :: N.Node -> String
|
||||
monadicName n = case n of
|
||||
monadicName (N.Node meta node) = case node of
|
||||
N.MonSub -> "-"
|
||||
N.MonBitNot -> "bitnot"
|
||||
N.MonNot -> "not"
|
||||
N.MonSize -> "size"
|
||||
|
||||
nodeToSExp :: N.Node -> SExp
|
||||
nodeToSExp node
|
||||
nodeToSExp (N.Node meta node)
|
||||
= case node of
|
||||
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 (N.InSimple b) -> wrapl1 "?" (top a) (map top b)
|
||||
N.In a (N.Node _ (N.InSimple b)) -> wrapl1 "?" (top a) (map top b)
|
||||
N.Variant a b -> wrap2 "variant" (top a) (top b)
|
||||
N.In a (N.InCase b) -> wrapl1 "?case" (top a) (map top b)
|
||||
N.In a (N.InTag b) -> wrap2 "?case-tag" (top a) (top b)
|
||||
N.In a (N.InAfter b) -> wrap2 "?after" (top a) (top b)
|
||||
N.In a (N.Node _ (N.InCase b)) -> wrapl1 "?case" (top a) (map top b)
|
||||
N.In a (N.Node _ (N.InTag b)) -> wrap2 "?case-tag" (top a) (top b)
|
||||
N.In a (N.Node _ (N.InAfter 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)
|
||||
|
|
@ -101,10 +101,10 @@ nodeToSExp node
|
|||
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 (N.SubPlain b) a -> wrap2 "sub" (top a) (top b)
|
||||
N.Sub (N.SubFromFor b c) a -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
N.Sub (N.SubFrom b) a -> wrap2 "sub-from" (top a) (top b)
|
||||
N.Sub (N.SubFor b) a -> wrap2 "sub-for" (top a) (top b)
|
||||
N.Sub (N.Node _ (N.SubPlain b)) a -> wrap2 "sub" (top a) (top b)
|
||||
N.Sub (N.Node _ (N.SubFromFor b c)) a -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
N.Sub (N.Node _ (N.SubFrom b)) a -> wrap2 "sub-from" (top a) (top b)
|
||||
N.Sub (N.Node _ (N.SubFor b)) a -> 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)
|
||||
|
|
@ -159,18 +159,18 @@ nodeToSExp node
|
|||
wrapl2 name arg1 arg2 args = List ((Item name) : arg1 : arg2 : args)
|
||||
|
||||
nodeToSOccam :: N.Node -> SExp
|
||||
nodeToSOccam node
|
||||
nodeToSOccam (N.Node meta node)
|
||||
= case node of
|
||||
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 (N.InSimple b) -> wrapl1 "?" (top a) (map top b)
|
||||
N.In a (N.Node _ (N.InSimple b)) -> wrapl1 "?" (top a) (map top b)
|
||||
N.Variant a b -> wrap2 "variant" (top a) (top b)
|
||||
N.In a (N.InCase b) -> wrapl1 "?case" (top a) (map top b)
|
||||
N.In a (N.InTag b) -> wrap2 "?case-tag" (top a) (top b)
|
||||
N.In a (N.InAfter b) -> wrap2 "?after" (top a) (top b)
|
||||
N.In a (N.Node _ (N.InCase b)) -> wrapl1 "?case" (top a) (map top b)
|
||||
N.In a (N.Node _ (N.InTag b)) -> wrap2 "?case-tag" (top a) (top b)
|
||||
N.In a (N.Node _ (N.InAfter 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)
|
||||
|
|
@ -214,10 +214,10 @@ nodeToSOccam node
|
|||
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 (N.SubPlain b) a -> wrap2 "sub" (top a) (top b)
|
||||
N.Sub (N.SubFromFor b c) a -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
N.Sub (N.SubFrom b) a -> wrap2 "sub-from" (top a) (top b)
|
||||
N.Sub (N.SubFor b) a -> wrap2 "sub-for" (top a) (top b)
|
||||
N.Sub (N.Node _ (N.SubPlain b)) a -> wrap2 "sub" (top a) (top b)
|
||||
N.Sub (N.Node _ (N.SubFromFor b c)) a -> wrap3 "sub-from-for" (top a) (top b) (top c)
|
||||
N.Sub (N.Node _ (N.SubFrom b)) a -> wrap2 "sub-from" (top a) (top b)
|
||||
N.Sub (N.Node _ (N.SubFor b)) a -> 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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user