Include metadata in the AST
This commit is contained in:
Adam Sampson
parent
996f64702a
commit
f7114b6c84
184
fco/AST.hs
184
fco/AST.hs
|
|
@ -5,11 +5,12 @@
|
|||
module AST where
|
||||
|
||||
import Data.Generics
|
||||
import Metadata
|
||||
|
||||
data Name = Name String
|
||||
data Name = Name Meta String
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Tag = Tag String
|
||||
data Tag = Tag Meta String
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Type =
|
||||
|
|
@ -26,7 +27,7 @@ data Type =
|
|||
| Timer
|
||||
| Port Type
|
||||
| Val Type
|
||||
| Infer -- for where the type is not given but can be worked out (e.g. "x IS y:")
|
||||
| Infer -- for where the type is not given but can be worked out (e.g. "x IS y:")
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data ConversionMode =
|
||||
|
|
@ -36,51 +37,51 @@ data ConversionMode =
|
|||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Subscript =
|
||||
Subscript Expression
|
||||
| SubscriptTag Tag
|
||||
| SubFromFor Expression Expression
|
||||
| SubFrom Expression
|
||||
| SubFor Expression
|
||||
Subscript Meta Expression
|
||||
| SubscriptTag Meta Tag
|
||||
| SubFromFor Meta Expression Expression
|
||||
| SubFrom Meta Expression
|
||||
| SubFor Meta Expression
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data LiteralRepr =
|
||||
RealLiteral String
|
||||
| IntLiteral String
|
||||
| HexLiteral String
|
||||
| ByteLiteral String
|
||||
| StringLiteral String
|
||||
| ArrayLiteral [Expression]
|
||||
RealLiteral Meta String
|
||||
| IntLiteral Meta String
|
||||
| HexLiteral Meta String
|
||||
| ByteLiteral Meta String
|
||||
| StringLiteral Meta String
|
||||
| ArrayLiteral Meta [Expression]
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Literal =
|
||||
Literal Type LiteralRepr
|
||||
| SubscriptedLiteral Subscript Literal
|
||||
Literal Meta Type LiteralRepr
|
||||
| SubscriptedLiteral Meta Subscript Literal
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Variable =
|
||||
Variable Name
|
||||
| SubscriptedVariable Subscript Variable
|
||||
Variable Meta Name
|
||||
| SubscriptedVariable Meta Subscript Variable
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Expression =
|
||||
Monadic MonadicOp Expression
|
||||
| Dyadic DyadicOp Expression Expression
|
||||
| MostPos Type
|
||||
| MostNeg Type
|
||||
| Size Type
|
||||
| Conversion ConversionMode Type Expression
|
||||
| ExprVariable Variable
|
||||
| ExprLiteral Literal
|
||||
| True
|
||||
| False
|
||||
| FunctionCall Name [Expression]
|
||||
| BytesInType Type
|
||||
| OffsetOf Type Tag
|
||||
Monadic Meta MonadicOp Expression
|
||||
| Dyadic Meta DyadicOp Expression Expression
|
||||
| MostPos Meta Type
|
||||
| MostNeg Meta Type
|
||||
| Size Meta Type
|
||||
| Conversion Meta ConversionMode Type Expression
|
||||
| ExprVariable Meta Variable
|
||||
| ExprLiteral Meta Literal
|
||||
| True Meta
|
||||
| False Meta
|
||||
| FunctionCall Meta Name [Expression]
|
||||
| BytesInType Meta Type
|
||||
| OffsetOf Meta Type Tag
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data ExpressionList =
|
||||
FunctionCallList Name [Expression]
|
||||
| ExpressionList [Expression]
|
||||
FunctionCallList Meta Name [Expression]
|
||||
| ExpressionList Meta [Expression]
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data MonadicOp =
|
||||
|
|
@ -101,99 +102,98 @@ data DyadicOp =
|
|||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data InputItem =
|
||||
InCounted Variable Variable
|
||||
| InVariable Variable
|
||||
InCounted Meta Variable Variable
|
||||
| InVariable Meta Variable
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data OutputItem =
|
||||
OutCounted Expression Expression
|
||||
| OutExpression Expression
|
||||
OutCounted Meta Expression Expression
|
||||
| OutExpression Meta Expression
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Replicator = For Name Expression Expression
|
||||
data Replicator = For Meta Name Expression Expression
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Choice = Choice Expression Process
|
||||
data Choice = Choice Meta Expression Process
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Alternative =
|
||||
Alternative Variable InputMode Process
|
||||
| AlternativeCond Expression Variable InputMode Process
|
||||
| AlternativeSkip Expression Process
|
||||
Alternative Meta Variable InputMode Process
|
||||
| AlternativeCond Meta Expression Variable InputMode Process
|
||||
| AlternativeSkip Meta Expression Process
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Option =
|
||||
Option [Expression] Process
|
||||
| Else Process
|
||||
Option Meta [Expression] Process
|
||||
| Else Meta Process
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Variant = Variant Tag [InputItem] Process
|
||||
data Variant = Variant Meta Tag [InputItem] Process
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
-- This represents something that can contain local replicators and specifications.
|
||||
-- (This ought to be a parametric type, "Structured Variant" etc., but doing so
|
||||
-- makes using generic functions across it hard.)
|
||||
data Structured =
|
||||
Rep Replicator Structured
|
||||
| Spec Specification Structured
|
||||
| OnlyV Variant
|
||||
| OnlyC Choice
|
||||
| OnlyO Option
|
||||
| OnlyP Process
|
||||
| OnlyA Alternative
|
||||
| Several [Structured]
|
||||
Rep Meta Replicator Structured
|
||||
| Spec Meta Specification Structured
|
||||
| OnlyV Meta Variant
|
||||
| OnlyC Meta Choice
|
||||
| OnlyO Meta Option
|
||||
| OnlyP Meta Process
|
||||
| OnlyA Meta Alternative
|
||||
| Several Meta [Structured]
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data InputMode =
|
||||
InputSimple [InputItem]
|
||||
| InputCase Structured
|
||||
| InputAfter Expression
|
||||
InputSimple Meta [InputItem]
|
||||
| InputCase Meta Structured
|
||||
| InputAfter Meta Expression
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
type Formals = [(Type, Name)]
|
||||
|
||||
type Specification = (Name, SpecType)
|
||||
data SpecType =
|
||||
Place Expression
|
||||
| Declaration Type
|
||||
| Is Type Variable
|
||||
| ValIs Type Expression
|
||||
| DataTypeIs Type
|
||||
| DataTypeRecord Bool [(Type, Tag)]
|
||||
| ProtocolIs [Type]
|
||||
| ProtocolCase [(Tag, [Type])]
|
||||
| Proc Formals Process
|
||||
| Function [Type] Formals ValueProcess
|
||||
| Retypes Type Variable
|
||||
| Reshapes Type Variable
|
||||
| ValRetypes Type Variable
|
||||
| ValReshapes Type Variable
|
||||
Place Meta Expression
|
||||
| Declaration Meta Type
|
||||
| Is Meta Type Variable
|
||||
| ValIs Meta Type Expression
|
||||
| DataTypeIs Meta Type
|
||||
| DataTypeRecord Meta Bool [(Type, Tag)]
|
||||
| ProtocolIs Meta [Type]
|
||||
| ProtocolCase Meta [(Tag, [Type])]
|
||||
| Proc Meta Formals Process
|
||||
| Function Meta [Type] Formals ValueProcess
|
||||
| Retypes Meta Type Variable
|
||||
| Reshapes Meta Type Variable
|
||||
| ValRetypes Meta Type Variable
|
||||
| ValReshapes Meta Type Variable
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data ValueProcess =
|
||||
ValOfSpec Specification ValueProcess
|
||||
| ValOf Process ExpressionList
|
||||
ValOfSpec Meta Specification ValueProcess
|
||||
| ValOf Meta Process ExpressionList
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data Process =
|
||||
ProcSpec Specification Process
|
||||
| Assign [Variable] ExpressionList
|
||||
| Input Variable InputMode
|
||||
| Output Variable [OutputItem]
|
||||
| OutputCase Variable Tag [OutputItem]
|
||||
| Skip
|
||||
| Stop
|
||||
| Main
|
||||
| Seq [Process]
|
||||
| SeqRep Replicator Process
|
||||
| If Structured
|
||||
| Case Expression Structured
|
||||
| While Expression Process
|
||||
| Par Bool [Process]
|
||||
| ParRep Bool Replicator Process
|
||||
| PlacedPar Structured
|
||||
| Processor Expression Process
|
||||
| Alt Bool Structured
|
||||
| ProcCall Name [Expression]
|
||||
ProcSpec Meta Specification Process
|
||||
| Assign Meta [Variable] ExpressionList
|
||||
| Input Meta Variable InputMode
|
||||
| Output Meta Variable [OutputItem]
|
||||
| OutputCase Meta Variable Tag [OutputItem]
|
||||
| Skip Meta
|
||||
| Stop Meta
|
||||
| Main Meta
|
||||
| Seq Meta [Process]
|
||||
| SeqRep Meta Replicator Process
|
||||
| If Meta Structured
|
||||
| Case Meta Expression Structured
|
||||
| While Meta Expression Process
|
||||
| Par Meta Bool [Process]
|
||||
| ParRep Meta Bool Replicator Process
|
||||
| PlacedPar Meta Structured
|
||||
| Processor Meta Expression Process
|
||||
| Alt Meta Bool Structured
|
||||
| ProcCall Meta Name [Expression]
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ uniqueNamesPass p = evalState (doAny p) (0, [])
|
|||
withNames :: Data t => [A.Name] -> t -> UniqueM ([A.Name], t)
|
||||
withNames ns b = do
|
||||
(count, vars) <- get
|
||||
let names = [s | A.Name s <- ns]
|
||||
let (ms, names) = unzip [(m, s) | A.Name m s <- ns]
|
||||
let names' = [n ++ "." ++ show (count + i) | (n, i) <- zip names [0..]]
|
||||
put (count + length ns, (zip names names') ++ vars)
|
||||
|
||||
|
|
@ -54,7 +54,7 @@ uniqueNamesPass p = evalState (doAny p) (0, [])
|
|||
(count', _) <- get
|
||||
put (count', vars)
|
||||
|
||||
return (map A.Name names', b')
|
||||
return ([A.Name m n | (m, n) <- zip ms names'], b')
|
||||
|
||||
withName :: Data t => A.Name -> t -> UniqueM (A.Name, t)
|
||||
withName n b = do
|
||||
|
|
@ -70,57 +70,57 @@ uniqueNamesPass p = evalState (doAny p) (0, [])
|
|||
withSpec :: Data t => A.Specification -> t -> UniqueM (A.Specification, t)
|
||||
withSpec (n, st) b = do
|
||||
st' <- case st of
|
||||
A.Proc fs pp -> do (fs', pp') <- withFormals fs pp
|
||||
return $ A.Proc fs' pp'
|
||||
A.Function rt fs pp -> do (fs', pp') <- withFormals fs pp
|
||||
return $ A.Function rt fs' pp'
|
||||
A.Proc m fs pp -> do (fs', pp') <- withFormals fs pp
|
||||
return $ A.Proc m fs' pp'
|
||||
A.Function m rt fs pp -> do (fs', pp') <- withFormals fs pp
|
||||
return $ A.Function m rt fs' pp'
|
||||
otherwise -> doAny st
|
||||
(n', b') <- withName n b
|
||||
return ((n', st'), b')
|
||||
|
||||
withRep :: Data t => A.Replicator -> t -> UniqueM (A.Replicator, t)
|
||||
withRep (A.For n f1 f2) b = do
|
||||
withRep (A.For m n f1 f2) b = do
|
||||
(n', b') <- withName n b
|
||||
f1' <- doAny f1
|
||||
f2' <- doAny f2
|
||||
return $ (A.For n' f1' f2', b')
|
||||
return $ (A.For m n' f1' f2', b')
|
||||
|
||||
doProcess :: A.Process -> UniqueM A.Process
|
||||
doProcess p = case p of
|
||||
A.ProcSpec s b -> do (s', b') <- withSpec s b
|
||||
return $ A.ProcSpec s' b'
|
||||
A.SeqRep r b -> do (r', b') <- withRep r b
|
||||
return $ A.SeqRep r' b'
|
||||
A.ParRep pri r b -> do (r', b') <- withRep r b
|
||||
return $ A.ParRep pri r' b'
|
||||
A.ProcSpec m s b -> do (s', b') <- withSpec s b
|
||||
return $ A.ProcSpec m s' b'
|
||||
A.SeqRep m r b -> do (r', b') <- withRep r b
|
||||
return $ A.SeqRep m r' b'
|
||||
A.ParRep m pri r b -> do (r', b') <- withRep r b
|
||||
return $ A.ParRep m pri r' b'
|
||||
otherwise -> doGeneric p
|
||||
|
||||
doValueProcess :: A.ValueProcess -> UniqueM A.ValueProcess
|
||||
doValueProcess p = case p of
|
||||
A.ValOfSpec s b -> do (s', b') <- withSpec s b
|
||||
return $ A.ValOfSpec s' b'
|
||||
A.ValOfSpec m s b -> do (s', b') <- withSpec s b
|
||||
return $ A.ValOfSpec m s' b'
|
||||
otherwise -> doGeneric p
|
||||
|
||||
doStructured :: A.Structured -> UniqueM A.Structured
|
||||
doStructured p = case p of
|
||||
A.Rep r b -> do (r', b') <- withRep r b
|
||||
return $ A.Rep r' b'
|
||||
A.Spec s b -> do (s', b') <- withSpec s b
|
||||
return $ A.Spec s' b'
|
||||
A.Rep m r b -> do (r', b') <- withRep r b
|
||||
return $ A.Rep m r' b'
|
||||
A.Spec m s b -> do (s', b') <- withSpec s b
|
||||
return $ A.Spec m s' b'
|
||||
otherwise -> doGeneric p
|
||||
|
||||
doName :: A.Name -> UniqueM A.Name
|
||||
doName (A.Name s) = do
|
||||
doName (A.Name m s) = do
|
||||
(_, vars) <- get
|
||||
let s' = case lookup s vars of
|
||||
Just n -> n
|
||||
Nothing -> "(not-declared-" ++ s ++ ")"
|
||||
--Nothing -> error $ "Name " ++ s ++ " not declared before use"
|
||||
return $ A.Name s'
|
||||
return $ A.Name m s'
|
||||
|
||||
cStyleNamesPass :: A.Process -> A.Process
|
||||
cStyleNamesPass = everywhere (mkT doName)
|
||||
where
|
||||
doName :: A.Name -> A.Name
|
||||
doName (A.Name s) = A.Name [if c == '.' then '_' else c | c <- s]
|
||||
doName (A.Name m s) = A.Name m [if c == '.' then '_' else c | c <- s]
|
||||
|
||||
|
|
|
|||
|
|
@ -4,13 +4,14 @@ module COutput where
|
|||
|
||||
import List
|
||||
import Data.Generics
|
||||
import Metadata
|
||||
import qualified AST as A
|
||||
|
||||
concatWith x l = concat $ intersperse x l
|
||||
bracketed s = "(" ++ s ++ ")"
|
||||
|
||||
unimp :: Data a => a -> String
|
||||
unimp = unimpG `extQ` unimpS
|
||||
unimp = unimpG `extQ` unimpS `extQ` unimpM
|
||||
where
|
||||
unimpG :: Data a => a -> String
|
||||
unimpG t = rep
|
||||
|
|
@ -22,16 +23,19 @@ unimp = unimpG `extQ` unimpS
|
|||
unimpS :: String -> String
|
||||
unimpS s = show s
|
||||
|
||||
unimpM :: Meta -> String
|
||||
unimpM m = formatSourcePos m
|
||||
|
||||
writeC :: A.Process -> String
|
||||
writeC p = header ++ doProcess p
|
||||
where
|
||||
header = "#include <stdint.h>\n"
|
||||
|
||||
doName :: A.Name -> String
|
||||
doName (A.Name n) = n
|
||||
doName (A.Name _ n) = n
|
||||
|
||||
doUserType :: A.Type -> String
|
||||
doUserType (A.UserType (A.Name n)) = "usertype_" ++ n
|
||||
doUserType (A.UserType (A.Name _ n)) = "usertype_" ++ n
|
||||
|
||||
doType :: A.Type -> String
|
||||
doType (A.Val t) = "const " ++ (doType t)
|
||||
|
|
@ -47,18 +51,18 @@ writeC p = header ++ doProcess p
|
|||
doType t = unimp t
|
||||
|
||||
doVariable :: A.Variable -> String
|
||||
doVariable (A.Variable n) = doName n
|
||||
doVariable (A.Variable _ n) = doName n
|
||||
|
||||
doLiteralRepr :: A.LiteralRepr -> String
|
||||
doLiteralRepr r = case r of
|
||||
A.IntLiteral s -> s
|
||||
A.IntLiteral _ s -> s
|
||||
|
||||
doLiteral :: A.Literal -> String
|
||||
doLiteral (A.Literal t r) = doLiteralRepr r
|
||||
doLiteral (A.Literal _ t r) = doLiteralRepr r
|
||||
|
||||
doFunction :: A.ValueProcess -> String
|
||||
doFunction (A.ValOfSpec s p) = doSpecification s ++ doFunction p
|
||||
doFunction (A.ValOf p el) = doProcess p ++ "return " ++ doExpressionListOne el ++ ";\n"
|
||||
doFunction (A.ValOfSpec _ s p) = doSpecification s ++ doFunction p
|
||||
doFunction (A.ValOf _ p el) = doProcess p ++ "return " ++ doExpressionListOne el ++ ";\n"
|
||||
-- FIXME handle multi-value return
|
||||
|
||||
makeDecl :: A.Type -> A.Name -> String
|
||||
|
|
@ -69,16 +73,16 @@ writeC p = header ++ doProcess p
|
|||
|
||||
doSpecification :: A.Specification -> String
|
||||
doSpecification s@(n, st) = case st of
|
||||
A.Declaration t -> makeDecl t n ++ ";\n"
|
||||
A.Proc fs p -> "void " ++ doName n ++ " " ++ makeFormals fs ++ " {\n" ++ doProcess p ++ "}\n"
|
||||
A.Function [r] fs vp -> doType r ++ " " ++ doName n ++ " " ++ makeFormals fs ++ " {\n" ++ doFunction vp ++ "}\n"
|
||||
A.Declaration _ t -> makeDecl t n ++ ";\n"
|
||||
A.Proc _ fs p -> "void " ++ doName n ++ " " ++ makeFormals fs ++ " {\n" ++ doProcess p ++ "}\n"
|
||||
A.Function _ [r] fs vp -> doType r ++ " " ++ doName n ++ " " ++ makeFormals fs ++ " {\n" ++ doFunction vp ++ "}\n"
|
||||
_ -> unimp s
|
||||
|
||||
doProcSpec :: A.Process -> String
|
||||
doProcSpec p = doP [] p
|
||||
where
|
||||
doP :: [A.Specification] -> A.Process -> String
|
||||
doP ss (A.ProcSpec s p) = doP (ss ++ [s]) p
|
||||
doP ss (A.ProcSpec _ s p) = doP (ss ++ [s]) p
|
||||
doP ss p = "{\n" ++ concat (map doSpecification ss) ++ doProcess p ++ "}\n"
|
||||
|
||||
doActuals :: [A.Expression] -> String
|
||||
|
|
@ -101,27 +105,27 @@ writeC p = header ++ doProcess p
|
|||
|
||||
doExpression :: A.Expression -> String
|
||||
doExpression e = case e of
|
||||
A.Monadic o a -> doMonadic o a
|
||||
A.Dyadic o a b -> doDyadic o a b
|
||||
A.ExprVariable v -> doVariable v
|
||||
A.ExprLiteral l -> doLiteral l
|
||||
A.Monadic _ o a -> doMonadic o a
|
||||
A.Dyadic _ o a b -> doDyadic o a b
|
||||
A.ExprVariable _ v -> doVariable v
|
||||
A.ExprLiteral _ l -> doLiteral l
|
||||
|
||||
doExpressionListOne :: A.ExpressionList -> String
|
||||
doExpressionListOne e = case e of
|
||||
A.FunctionCallList n as -> doFunctionCall n as
|
||||
A.ExpressionList [e] -> doExpression e
|
||||
A.FunctionCallList _ n as -> doFunctionCall n as
|
||||
A.ExpressionList _ [e] -> doExpression e
|
||||
|
||||
doAssign :: A.Process -> String
|
||||
doAssign a = case a of
|
||||
A.Assign [v] el -> (doVariable v) ++ " = " ++ (doExpressionListOne el) ++ ";\n"
|
||||
A.Assign _ [v] el -> (doVariable v) ++ " = " ++ (doExpressionListOne el) ++ ";\n"
|
||||
|
||||
doProcess :: A.Process -> String
|
||||
doProcess s@(A.ProcSpec _ _) = doProcSpec s
|
||||
doProcess a@(A.Assign _ _) = doAssign a
|
||||
doProcess A.Skip = "/* SKIP */;\n"
|
||||
doProcess A.Stop = "SetErr ();\n"
|
||||
doProcess A.Main = "/* MAIN-PROCESS */\n";
|
||||
doProcess (A.Seq ps) = concatWith "" (map doProcess ps)
|
||||
doProcess (A.ProcCall n as) = doName n ++ " " ++ doActuals as ++ ";\n"
|
||||
doProcess s@(A.ProcSpec _ _ _) = doProcSpec s
|
||||
doProcess a@(A.Assign _ _ _) = doAssign a
|
||||
doProcess (A.Skip _) = "/* SKIP */;\n"
|
||||
doProcess (A.Stop _) = "SetErr ();\n"
|
||||
doProcess (A.Main _) = "/* MAIN-PROCESS */\n";
|
||||
doProcess (A.Seq _ ps) = concatWith "" (map doProcess ps)
|
||||
doProcess (A.ProcCall _ n as) = doName n ++ " " ++ doActuals as ++ ";\n"
|
||||
doProcess n = unimp n
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
module Metadata where
|
||||
|
||||
import Data.Generics
|
||||
import Data.List
|
||||
|
||||
type Meta = [Metadatum]
|
||||
|
||||
|
|
@ -10,3 +11,12 @@ data Metadatum =
|
|||
SourcePos String Int Int
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
findSourcePos :: Meta -> Maybe Metadatum
|
||||
findSourcePos ms = find (\x -> case x of SourcePos _ _ _ -> True
|
||||
otherwise -> False) ms
|
||||
|
||||
formatSourcePos :: Meta -> String
|
||||
formatSourcePos m = case findSourcePos m of
|
||||
Just (SourcePos f l c) -> "<@" ++ show l ++ ":" ++ show c ++ ">"
|
||||
Nothing -> "<?>"
|
||||
|
||||
|
|
|
|||
261
fco/PTToAST.hs
261
fco/PTToAST.hs
|
|
@ -2,15 +2,16 @@
|
|||
|
||||
module PTToAST (ptToAST) where
|
||||
|
||||
import Metadata
|
||||
import qualified PT as N
|
||||
import qualified AST as O
|
||||
|
||||
doName :: N.Node -> O.Name
|
||||
doName (N.Node _ (N.Name s)) = O.Name s
|
||||
doName (N.Node m (N.Name s)) = O.Name m s
|
||||
doName n = error $ "Failed to translate to Name: " ++ (show n)
|
||||
|
||||
doTag :: N.Node -> O.Tag
|
||||
doTag (N.Node _ (N.Name s)) = O.Tag s
|
||||
doTag (N.Node m (N.Name s)) = O.Tag m s
|
||||
|
||||
doType :: N.Node -> O.Type
|
||||
doType n@(N.Node _ nt) = case nt of
|
||||
|
|
@ -63,61 +64,61 @@ doDyadicOp n@(N.Node _ nt) = case nt of
|
|||
N.After -> O.After
|
||||
|
||||
doSubscript :: N.Node -> O.Subscript
|
||||
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)
|
||||
doSubscript n@(N.Node m nt) = case nt of
|
||||
N.SubPlain e -> O.Subscript m (doExpression e)
|
||||
N.SubFromFor e f -> O.SubFromFor m (doExpression e) (doExpression f)
|
||||
N.SubFrom e -> O.SubFrom m (doExpression e)
|
||||
N.SubFor f -> O.SubFor m (doExpression f)
|
||||
|
||||
doLiteral :: N.Node -> O.Literal
|
||||
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)
|
||||
N.LitHex s -> O.Literal O.Int (O.HexLiteral s)
|
||||
N.LitByte s -> O.Literal O.Byte (O.ByteLiteral s)
|
||||
N.LitString s -> O.Literal (O.ArrayUnsized O.Byte) (O.StringLiteral s)
|
||||
N.LitArray ns -> O.Literal O.Infer (O.ArrayLiteral (map doExpression ns))
|
||||
N.Sub s l -> O.SubscriptedLiteral (doSubscript s) (doLiteral l)
|
||||
doLiteral n@(N.Node m nt) = case nt of
|
||||
N.TypedLit t l -> O.Literal m (doType t) rep where (O.Literal _ _ rep) = doLiteral l
|
||||
N.LitReal s -> O.Literal m O.Real32 (O.RealLiteral m s)
|
||||
N.LitInt s -> O.Literal m O.Int (O.IntLiteral m s)
|
||||
N.LitHex s -> O.Literal m O.Int (O.HexLiteral m s)
|
||||
N.LitByte s -> O.Literal m O.Byte (O.ByteLiteral m s)
|
||||
N.LitString s -> O.Literal m (O.ArrayUnsized O.Byte) (O.StringLiteral m s)
|
||||
N.LitArray ns -> O.Literal m O.Infer (O.ArrayLiteral m (map doExpression ns))
|
||||
N.Sub s l -> O.SubscriptedLiteral m (doSubscript s) (doLiteral l)
|
||||
|
||||
doVariable :: N.Node -> O.Variable
|
||||
doVariable n@(N.Node _ nt) = case nt of
|
||||
N.Name _ -> O.Variable (doName n)
|
||||
N.Sub s v -> O.SubscriptedVariable (doSubscript s) (doVariable v)
|
||||
doVariable n@(N.Node m nt) = case nt of
|
||||
N.Name _ -> O.Variable m (doName n)
|
||||
N.Sub s v -> O.SubscriptedVariable m (doSubscript s) (doVariable v)
|
||||
_ -> error $ "Failed to translate to Variable: " ++ (show n)
|
||||
|
||||
doExpression :: N.Node -> O.Expression
|
||||
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)
|
||||
N.MostNeg t -> O.MostNeg (doType t)
|
||||
N.Size t -> O.Size (doType t)
|
||||
N.Conv t e -> O.Conversion O.DefaultConversion (doType t) (doExpression e)
|
||||
N.Round t e -> O.Conversion O.Round (doType t) (doExpression e)
|
||||
N.Trunc t e -> O.Conversion O.Trunc (doType t) (doExpression e)
|
||||
N.TypedLit _ _ -> O.ExprLiteral $ doLiteral n
|
||||
N.LitReal _ -> O.ExprLiteral $ doLiteral n
|
||||
N.LitInt _ -> O.ExprLiteral $ doLiteral n
|
||||
N.LitHex _ -> O.ExprLiteral $ doLiteral n
|
||||
N.LitByte _ -> O.ExprLiteral $ doLiteral n
|
||||
N.LitString _ -> O.ExprLiteral $ doLiteral n
|
||||
N.LitArray _ -> O.ExprLiteral $ doLiteral n
|
||||
N.True -> O.True
|
||||
N.False -> O.False
|
||||
N.Call f es -> O.FunctionCall (doName f) (map doExpression es)
|
||||
N.BytesIn t -> O.BytesInType (doType t)
|
||||
N.OffsetOf t g -> O.OffsetOf (doType t) (doTag g)
|
||||
otherwise -> O.ExprVariable (doVariable n)
|
||||
doExpression n@(N.Node m nt) = case nt of
|
||||
N.MonadicOp o a -> O.Monadic m (doMonadicOp o) (doExpression a)
|
||||
N.DyadicOp o a b -> O.Dyadic m (doDyadicOp o) (doExpression a) (doExpression b)
|
||||
N.MostPos t -> O.MostPos m (doType t)
|
||||
N.MostNeg t -> O.MostNeg m (doType t)
|
||||
N.Size t -> O.Size m (doType t)
|
||||
N.Conv t e -> O.Conversion m O.DefaultConversion (doType t) (doExpression e)
|
||||
N.Round t e -> O.Conversion m O.Round (doType t) (doExpression e)
|
||||
N.Trunc t e -> O.Conversion m O.Trunc (doType t) (doExpression e)
|
||||
N.TypedLit _ _ -> O.ExprLiteral m $ doLiteral n
|
||||
N.LitReal _ -> O.ExprLiteral m $ doLiteral n
|
||||
N.LitInt _ -> O.ExprLiteral m $ doLiteral n
|
||||
N.LitHex _ -> O.ExprLiteral m $ doLiteral n
|
||||
N.LitByte _ -> O.ExprLiteral m $ doLiteral n
|
||||
N.LitString _ -> O.ExprLiteral m $ doLiteral n
|
||||
N.LitArray _ -> O.ExprLiteral m $ doLiteral n
|
||||
N.True -> O.True m
|
||||
N.False -> O.False m
|
||||
N.Call f es -> O.FunctionCall m (doName f) (map doExpression es)
|
||||
N.BytesIn t -> O.BytesInType m (doType t)
|
||||
N.OffsetOf t g -> O.OffsetOf m (doType t) (doTag g)
|
||||
otherwise -> O.ExprVariable m (doVariable n)
|
||||
|
||||
doExpressionList :: N.Node -> O.ExpressionList
|
||||
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)
|
||||
doExpressionList n@(N.Node m nt) = case nt of
|
||||
N.Call f es -> O.FunctionCallList m (doName f) (map doExpression es)
|
||||
N.ExpList es -> O.ExpressionList m (map doExpression es)
|
||||
|
||||
doReplicator :: N.Node -> O.Replicator
|
||||
doReplicator n@(N.Node _ nt) = case nt of
|
||||
N.For v f t -> O.For (doName v) (doExpression f) (doExpression t)
|
||||
doReplicator n@(N.Node m nt) = case nt of
|
||||
N.For v f t -> O.For m (doName v) (doExpression f) (doExpression t)
|
||||
|
||||
doFields :: [N.Node] -> [(O.Type, O.Tag)]
|
||||
doFields ns = concat $ [[(doType t, doTag f) | f <- fs] | (N.Node _ (N.Fields t fs)) <- ns]
|
||||
|
|
@ -126,125 +127,125 @@ doFormals :: [N.Node] -> [(O.Type, O.Name)]
|
|||
doFormals fs = concat $ [[(doType t, doName n) | n <- ns] | (N.Node _ (N.Formals t ns)) <- fs]
|
||||
|
||||
doVariant :: N.Node -> O.Structured
|
||||
doVariant n@(N.Node _ nt) = case nt of
|
||||
N.Variant (N.Node _ (N.Tag t is)) p -> O.OnlyV $ O.Variant (doTag t) (map doInputItem is) (doProcess p)
|
||||
doVariant n@(N.Node m nt) = case nt of
|
||||
N.Variant (N.Node _ (N.Tag t is)) p -> O.OnlyV m $ O.Variant m (doTag t) (map doInputItem is) (doProcess p)
|
||||
N.Decl s v -> doSpecifications s O.Spec (doVariant v)
|
||||
|
||||
doChoice :: N.Node -> O.Structured
|
||||
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.OnlyC $ O.Choice (doExpression b) (doProcess p)
|
||||
doChoice n@(N.Node m nt) = case nt of
|
||||
N.If cs -> O.Several m $ map doChoice cs
|
||||
N.IfRep r c -> O.Rep m (doReplicator r) (doChoice c)
|
||||
N.Choice b p -> O.OnlyC m $ O.Choice m (doExpression b) (doProcess p)
|
||||
N.Decl s c -> doSpecifications s O.Spec (doChoice c)
|
||||
|
||||
doOption :: N.Node -> O.Structured
|
||||
doOption n@(N.Node _ nt) = case nt of
|
||||
N.CaseExps cs p -> O.OnlyO $ O.Option (map doExpression cs) (doProcess p)
|
||||
N.Else p -> O.OnlyO $ O.Else (doProcess p)
|
||||
doOption n@(N.Node m nt) = case nt of
|
||||
N.CaseExps cs p -> O.OnlyO m $ O.Option m (map doExpression cs) (doProcess p)
|
||||
N.Else p -> O.OnlyO m $ O.Else m (doProcess p)
|
||||
N.Decl s o -> doSpecifications s O.Spec (doOption o)
|
||||
|
||||
doInputItem :: N.Node -> O.InputItem
|
||||
doInputItem n@(N.Node _ nt) = case nt of
|
||||
N.Counted c d -> O.InCounted (doVariable c) (doVariable d)
|
||||
otherwise -> O.InVariable (doVariable n)
|
||||
doInputItem n@(N.Node m nt) = case nt of
|
||||
N.Counted c d -> O.InCounted m (doVariable c) (doVariable d)
|
||||
otherwise -> O.InVariable m (doVariable n)
|
||||
|
||||
doOutputItem :: N.Node -> O.OutputItem
|
||||
doOutputItem n@(N.Node _ nt) = case nt of
|
||||
N.Counted c d -> O.OutCounted (doExpression c) (doExpression d)
|
||||
otherwise -> O.OutExpression (doExpression n)
|
||||
doOutputItem n@(N.Node m nt) = case nt of
|
||||
N.Counted c d -> O.OutCounted m (doExpression c) (doExpression d)
|
||||
otherwise -> O.OutExpression m (doExpression n)
|
||||
|
||||
doInputMode :: N.Node -> O.InputMode
|
||||
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.Node _ (N.Tag t is)) -> O.InputCase (O.OnlyV $ O.Variant (doTag t) (map doInputItem is) O.Skip)
|
||||
N.InAfter e -> O.InputAfter (doExpression e)
|
||||
doInputMode n@(N.Node m nt) = case nt of
|
||||
N.InSimple is -> O.InputSimple m (map doInputItem is)
|
||||
N.InCase vs -> O.InputCase m (O.Several m $ map doVariant vs)
|
||||
N.InTag (N.Node _ (N.Tag t is)) -> O.InputCase m (O.OnlyV m $ O.Variant m (doTag t) (map doInputItem is) (O.Skip m))
|
||||
N.InAfter e -> O.InputAfter m (doExpression e)
|
||||
|
||||
doSimpleSpec :: N.Node -> O.Specification
|
||||
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.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.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)))
|
||||
N.Retypes t d s -> (doName d, O.Retypes (doType t) (doVariable s))
|
||||
N.ValRetypes t d s -> (doName d, O.ValRetypes (doType t) (doVariable s))
|
||||
N.Reshapes t d s -> (doName d, O.Reshapes (doType t) (doVariable s))
|
||||
N.ValReshapes t d s -> (doName d, O.ValReshapes (doType t) (doVariable s))
|
||||
doSimpleSpec n@(N.Node m nt) = case nt of
|
||||
N.Is d v -> (doName d, O.Is m O.Infer (doVariable v))
|
||||
N.IsType t d v -> (doName d, O.Is m (doType t) (doVariable v))
|
||||
N.ValIs d e -> (doName d, O.ValIs m O.Infer (doExpression e))
|
||||
N.ValIsType t d e -> (doName d, O.ValIs m (doType t) (doExpression e))
|
||||
N.Place v e -> (doName v, O.Place m (doExpression e))
|
||||
N.DataType n (N.Node _ (N.Record fs)) -> (doName n, O.DataTypeRecord m False (doFields fs))
|
||||
N.DataType n (N.Node _ (N.PackedRecord fs)) -> (doName n, O.DataTypeRecord m True (doFields fs))
|
||||
N.DataType n t -> (doName n, O.DataTypeIs m (doType t))
|
||||
N.Protocol n is -> (doName n, O.ProtocolIs m (map doType is))
|
||||
N.TaggedProtocol n ts -> (doName n, O.ProtocolCase m [(doTag tn, map doType tts) | (N.Node _ (N.Tag tn tts)) <- ts])
|
||||
N.Proc n fs p -> (doName n, O.Proc m (doFormals fs) (doProcess p))
|
||||
N.Func n rs fs vp -> (doName n, O.Function m (map doType rs) (doFormals fs) (doValueProcess vp))
|
||||
N.FuncIs n rs fs el -> (doName n, O.Function m (map doType rs) (doFormals fs) (O.ValOf m (O.Skip m) (doExpressionList el)))
|
||||
N.Retypes t d s -> (doName d, O.Retypes m (doType t) (doVariable s))
|
||||
N.ValRetypes t d s -> (doName d, O.ValRetypes m (doType t) (doVariable s))
|
||||
N.Reshapes t d s -> (doName d, O.Reshapes m (doType t) (doVariable s))
|
||||
N.ValReshapes t d s -> (doName d, O.ValReshapes m (doType t) (doVariable s))
|
||||
|
||||
doSpecifications :: N.Node -> (O.Specification -> a -> a) -> a -> a
|
||||
doSpecifications :: N.Node -> (Meta -> O.Specification -> a -> a) -> a -> a
|
||||
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.Node m (N.Vars t vs)) comb arg)
|
||||
otherwise -> comb (doSimpleSpec n) arg
|
||||
N.Vars t (v:vs) -> comb m (doName v, O.Declaration m (doType t)) (doSpecifications (N.Node m (N.Vars t vs)) comb arg)
|
||||
otherwise -> comb m (doSimpleSpec n) arg
|
||||
|
||||
doAlternative :: N.Node -> O.Alternative
|
||||
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)
|
||||
doAlternative n@(N.Node m nt) = case nt of
|
||||
N.Guard (N.Node _ (N.In c md)) p -> O.Alternative m (doVariable c) (doInputMode md) (doProcess p)
|
||||
N.Guard (N.Node _ (N.CondGuard b (N.Node _ (N.In c md)))) p -> O.AlternativeCond m (doExpression b) (doVariable c) (doInputMode md) (doProcess p)
|
||||
N.Guard (N.Node _ (N.CondGuard b (N.Node _ N.Skip))) p -> O.AlternativeSkip m (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.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
|
||||
N.In c md@(N.Node _ (N.InCase _)) -> O.Alternative m (doVariable c) (doInputMode md) (O.Skip m)
|
||||
N.CondGuard b (N.Node _ (N.In c md@(N.Node _ (N.InCase _)))) -> O.AlternativeCond m (doExpression b) (doVariable c) (doInputMode md) (O.Skip m)
|
||||
|
||||
doAlt :: N.Node -> O.Structured
|
||||
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)
|
||||
N.PriAltRep r n -> O.Rep (doReplicator r) (doAlt n)
|
||||
doAlt n@(N.Node m nt) = case nt of
|
||||
N.Alt ns -> O.Several m $ map doAlt ns
|
||||
N.PriAlt ns -> O.Several m $ map doAlt ns
|
||||
N.AltRep r n -> O.Rep m (doReplicator r) (doAlt n)
|
||||
N.PriAltRep r n -> O.Rep m (doReplicator r) (doAlt n)
|
||||
N.Decl s n -> doSpecifications s O.Spec (doAlt n)
|
||||
otherwise -> O.OnlyA $ doAlternative n
|
||||
otherwise -> O.OnlyA m $ doAlternative n
|
||||
|
||||
doValueProcess :: N.Node -> O.ValueProcess
|
||||
doValueProcess n@(N.Node _ nt) = case nt of
|
||||
doValueProcess n@(N.Node m nt) = case nt of
|
||||
N.Decl s n -> doSpecifications s O.ValOfSpec (doValueProcess n)
|
||||
N.ValOf p el -> O.ValOf (doProcess p) (doExpressionList el)
|
||||
N.ValOf p el -> O.ValOf m (doProcess p) (doExpressionList el)
|
||||
|
||||
doPlacedPar :: N.Node -> O.Structured
|
||||
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.OnlyP $ O.Processor (doExpression e) (doProcess p)
|
||||
doPlacedPar n@(N.Node m nt) = case nt of
|
||||
N.PlacedPar ps -> O.Several m $ map doPlacedPar ps
|
||||
N.PlacedParRep r p -> O.Rep m (doReplicator r) (doPlacedPar p)
|
||||
N.Processor e p -> O.OnlyP m $ O.Processor m (doExpression e) (doProcess p)
|
||||
N.Decl s p -> doSpecifications s O.Spec (doPlacedPar p)
|
||||
|
||||
doProcess :: N.Node -> O.Process
|
||||
doProcess n@(N.Node _ nt) = case nt of
|
||||
doProcess n@(N.Node m 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)
|
||||
N.Out c os -> O.Output (doVariable c) (map doOutputItem os)
|
||||
N.OutCase c t os -> O.OutputCase (doVariable c) (doTag t) (map doOutputItem os)
|
||||
N.Skip -> O.Skip
|
||||
N.Stop -> O.Stop
|
||||
N.MainProcess -> O.Main
|
||||
N.Seq ps -> O.Seq (map doProcess ps)
|
||||
N.SeqRep r p -> O.SeqRep (doReplicator r) (doProcess p)
|
||||
N.If _ -> O.If $ doChoice n
|
||||
N.Case e os -> O.Case (doExpression e) (O.Several $ map doOption os)
|
||||
N.While e p -> O.While (doExpression e) (doProcess p)
|
||||
N.Par ns -> O.Par False (map doProcess ns)
|
||||
N.PriPar ns -> O.Par True (map doProcess ns)
|
||||
N.ParRep r p -> O.ParRep False (doReplicator r) (doProcess p)
|
||||
N.PriParRep r p -> O.ParRep True (doReplicator r) (doProcess p)
|
||||
N.PlacedPar _ -> O.PlacedPar $ doPlacedPar n
|
||||
N.PlacedParRep _ _ -> O.PlacedPar $ doPlacedPar n
|
||||
N.Processor _ _ -> O.PlacedPar $ doPlacedPar n
|
||||
N.Alt _ -> O.Alt False $ doAlt n
|
||||
N.AltRep _ _ -> O.Alt False $ doAlt n
|
||||
N.PriAlt _ -> O.Alt True $ doAlt n
|
||||
N.PriAltRep _ _ -> O.Alt True $ doAlt n
|
||||
N.ProcCall p es -> O.ProcCall (doName p) (map doExpression es)
|
||||
N.Assign vs el -> O.Assign m (map doVariable vs) (doExpressionList el)
|
||||
N.In c md -> O.Input m (doVariable c) (doInputMode md)
|
||||
N.Out c os -> O.Output m (doVariable c) (map doOutputItem os)
|
||||
N.OutCase c t os -> O.OutputCase m (doVariable c) (doTag t) (map doOutputItem os)
|
||||
N.Skip -> O.Skip m
|
||||
N.Stop -> O.Stop m
|
||||
N.MainProcess -> O.Main m
|
||||
N.Seq ps -> O.Seq m (map doProcess ps)
|
||||
N.SeqRep r p -> O.SeqRep m (doReplicator r) (doProcess p)
|
||||
N.If _ -> O.If m $ doChoice n
|
||||
N.Case e os -> O.Case m (doExpression e) (O.Several m $ map doOption os)
|
||||
N.While e p -> O.While m (doExpression e) (doProcess p)
|
||||
N.Par ns -> O.Par m False (map doProcess ns)
|
||||
N.PriPar ns -> O.Par m True (map doProcess ns)
|
||||
N.ParRep r p -> O.ParRep m False (doReplicator r) (doProcess p)
|
||||
N.PriParRep r p -> O.ParRep m True (doReplicator r) (doProcess p)
|
||||
N.PlacedPar _ -> O.PlacedPar m $ doPlacedPar n
|
||||
N.PlacedParRep _ _ -> O.PlacedPar m $ doPlacedPar n
|
||||
N.Processor _ _ -> O.PlacedPar m $ doPlacedPar n
|
||||
N.Alt _ -> O.Alt m False $ doAlt n
|
||||
N.AltRep _ _ -> O.Alt m False $ doAlt n
|
||||
N.PriAlt _ -> O.Alt m True $ doAlt n
|
||||
N.PriAltRep _ _ -> O.Alt m True $ doAlt n
|
||||
N.ProcCall p es -> O.ProcCall m (doName p) (map doExpression es)
|
||||
|
||||
ptToAST :: N.Node -> O.Process
|
||||
ptToAST = doProcess
|
||||
|
|
|
|||
|
|
@ -1,9 +1,13 @@
|
|||
-- A generic show implementation that pretty-prints expressions
|
||||
-- This ought to use a class (like show does), so that it can be extended
|
||||
-- properly without me needing to have FCO-specific cases in here -- see the
|
||||
-- appropriate SYB paper.
|
||||
|
||||
module PrettyShow (pshow) where
|
||||
|
||||
import Data.Generics
|
||||
import Text.PrettyPrint.HughesPJ
|
||||
import Metadata
|
||||
|
||||
-- This is ugly -- but it looks like you can't easily define a generic function
|
||||
-- even for a single tuple type, since it has to parameterise over multiple Data
|
||||
|
|
@ -34,8 +38,11 @@ doList t = brackets $ sep $ punctuate (text ",") (map doAny t)
|
|||
doString :: String -> Doc
|
||||
doString s = text $ show s
|
||||
|
||||
doMeta :: Meta -> Doc
|
||||
doMeta m = text $ formatSourcePos m
|
||||
|
||||
doAny :: Data a => a -> Doc
|
||||
doAny = doGeneral `ext1Q` doList `extQ` doString
|
||||
doAny = doGeneral `ext1Q` doList `extQ` doString `extQ` doMeta
|
||||
|
||||
pshow :: Data a => a -> String
|
||||
pshow x = render $ doAny x
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user