Make Structured non-parametric, and experiment with a traversal strategy for scope tracking
This commit is contained in:
Adam Sampson
parent
d895b72a2b
commit
5cb2b2d248
26
fco/AST.hs
26
fco/AST.hs
|
|
@ -131,16 +131,22 @@ data Variant = Variant Tag [InputItem] Process
|
|||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
-- This represents something that can contain local replicators and specifications.
|
||||
data Structured t =
|
||||
Rep Replicator (Structured t)
|
||||
| Spec Specification (Structured t)
|
||||
| Only t
|
||||
| Several [Structured t]
|
||||
-- (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]
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
data InputMode =
|
||||
InputSimple [InputItem]
|
||||
| InputCase (Structured Variant)
|
||||
| InputCase Structured
|
||||
| InputAfter Expression
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
|
|
@ -178,14 +184,14 @@ data Process =
|
|||
| Main
|
||||
| Seq [Process]
|
||||
| ReplicatedSeq Replicator Process
|
||||
| If (Structured Choice)
|
||||
| Case Expression (Structured Option)
|
||||
| If Structured
|
||||
| Case Expression Structured
|
||||
| While Expression Process
|
||||
| Par Bool [Process]
|
||||
| ParRep Bool Replicator Process
|
||||
| PlacedPar (Structured Process)
|
||||
| PlacedPar Structured
|
||||
| Processor Expression Process
|
||||
| Alt Bool (Structured Alternative)
|
||||
| Alt Bool Structured
|
||||
| ProcCall Name [Expression]
|
||||
deriving (Show, Eq, Typeable, Data)
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
module ASTPasses (astPasses) where
|
||||
|
||||
import qualified AST as A
|
||||
import List
|
||||
import Data.Generics
|
||||
import Control.Monad.State
|
||||
|
||||
|
|
@ -24,7 +25,8 @@ check only Main is left
|
|||
-}
|
||||
|
||||
astPasses =
|
||||
[ ("C-style names", cStyleNamesPass)
|
||||
[ ("Unique names", uniqueNamesPass)
|
||||
, ("C-style names", cStyleNamesPass)
|
||||
]
|
||||
|
||||
{-
|
||||
|
|
@ -44,6 +46,30 @@ numberPass n = evalState (everywhereM (mkM (number `extM` number')) n) 0
|
|||
return $ A.Tag (s ++ "." ++ (show i))
|
||||
-}
|
||||
|
||||
type Transform t = t -> t
|
||||
|
||||
everyContext :: Data a => (forall b. Data b => (c, b) -> (c, b)) -> c -> a -> a
|
||||
everyContext f c x = gmapT innerT x'
|
||||
where
|
||||
(c', x') = f (c, x)
|
||||
innerT xi = everyContext f c' xi
|
||||
|
||||
uniqueNamesPass :: Transform A.Process
|
||||
uniqueNamesPass n = everyContext doAny [] n
|
||||
where
|
||||
doAny :: Data t => Transform ([String], t)
|
||||
doAny = (mkT doP) `extT` doV `extT` doS `extT` doN
|
||||
doP :: Transform ([String], A.Process)
|
||||
doP (c, p) = case p of
|
||||
A.ProcSpec ((A.Name n), _) _ -> (n : c, p)
|
||||
otherwise -> (c, p)
|
||||
doV :: Transform ([String], A.ValueProcess)
|
||||
doV = undefined
|
||||
doS :: Transform ([String], A.Structured)
|
||||
doS = undefined
|
||||
doN :: Transform ([String], A.Name)
|
||||
doN (c, A.Name s) = (c, A.Name (s ++ "=" ++ (concat $ intersperse "," c)))
|
||||
|
||||
cStyleNamesPass :: A.Process -> A.Process
|
||||
cStyleNamesPass = everywhere (mkT doName)
|
||||
where
|
||||
|
|
|
|||
|
|
@ -125,22 +125,22 @@ doFields ns = concat $ [[(doType t, doTag f) | f <- fs] | (N.Node _ (N.Fields t
|
|||
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 O.Variant
|
||||
doVariant :: N.Node -> O.Structured
|
||||
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.Variant (N.Node _ (N.Tag t is)) p -> O.OnlyV $ 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.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.Only $ O.Choice (doExpression b) (doProcess p)
|
||||
N.Choice b p -> O.OnlyC $ 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.Node -> O.Structured
|
||||
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.CaseExps cs p -> O.OnlyO $ O.Option (map doExpression cs) (doProcess p)
|
||||
N.Else p -> O.OnlyO $ O.Else (doProcess p)
|
||||
N.Decl s o -> doSpecifications s O.Spec (doOption o)
|
||||
|
||||
doInputItem :: N.Node -> O.InputItem
|
||||
|
|
@ -157,7 +157,7 @@ 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.Only $ O.Variant (doTag t) (map doInputItem is) O.Skip)
|
||||
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)
|
||||
|
||||
doSimpleSpec :: N.Node -> O.Specification
|
||||
|
|
@ -197,25 +197,25 @@ doAlternative n@(N.Node _ nt) = case nt of
|
|||
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.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)
|
||||
N.Decl s n -> doSpecifications s O.Spec (doAlt n)
|
||||
otherwise -> O.Only $ doAlternative n
|
||||
otherwise -> O.OnlyA $ doAlternative n
|
||||
|
||||
doValueProcess :: N.Node -> O.ValueProcess
|
||||
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.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.Only $ O.Processor (doExpression e) (doProcess p)
|
||||
N.Processor e p -> O.OnlyP $ O.Processor (doExpression e) (doProcess p)
|
||||
N.Decl s p -> doSpecifications s O.Spec (doPlacedPar p)
|
||||
|
||||
doProcess :: N.Node -> O.Process
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user