From 792728b7aa4ec3e8caf8afa4a8c2fdacd92d5d88 Mon Sep 17 00:00:00 2001 From: Adam Sampson Date: Mon, 2 Oct 2006 16:23:03 +0000 Subject: [PATCH] Add nicer Haskell AST types, for use with Data.Generics --- fco/Main.hs | 2 + fco/Makefile | 3 +- fco/OccamTypes.hs | 179 ++++++++++++++++++++++++++++++++++++++++++++++ fco/Parse.hs | 1 + 4 files changed, 184 insertions(+), 1 deletion(-) create mode 100644 fco/OccamTypes.hs diff --git a/fco/Main.hs b/fco/Main.hs index 08b35ce..ee8a778 100644 --- a/fco/Main.hs +++ b/fco/Main.hs @@ -15,6 +15,8 @@ import PhaseSource import PhaseIntermediate import PhaseOutput +import qualified OccamTypes as O + phaseList = [phaseSource, phaseIntermediate, phaseOutput] doPhases :: [Phase] -> Node -> Progress -> IO Node diff --git a/fco/Makefile b/fco/Makefile index 6d9e3ba..fecc45e 100644 --- a/fco/Makefile +++ b/fco/Makefile @@ -2,6 +2,7 @@ all: fco sources = \ BaseTransforms.hs \ + OccamTypes.hs \ Parse.hs \ Pass.hs \ PhaseIntermediate.hs \ @@ -12,7 +13,7 @@ sources = \ Main.hs fco: $(sources) - ghc -o fco --make Main + ghc -fglasgow-exts -o fco --make Main BaseTransforms.hs: Tree.hs make-passthrough.py python make-passthrough.py diff --git a/fco/OccamTypes.hs b/fco/OccamTypes.hs new file mode 100644 index 0000000..e3e2303 --- /dev/null +++ b/fco/OccamTypes.hs @@ -0,0 +1,179 @@ +-- Data types for occam abstract syntax +-- This is intended to be imported qualified: +-- import qualified OccamTypes as O + +module OccamTypes where + +import Data.Generics + +type Name = String +data Tag = Tag Name + deriving (Show, Eq, Typeable, Data) + +data Type = + Bool + | Byte + | Int | Int16 | Int32 | Int64 + | Real32 | Real64 + | Array Expression Type + | UnsizedArray Type + | UserType Name + | Chan Type + | Counted Type Type + | Any + | Timer + | Port Type + deriving (Show, Eq, Typeable, Data) + +data ConversionMode = + DefaultConversion + | Round + | Trunc + deriving (Show, Eq, Typeable, Data) + +data Slice = + SliceFromFor Expression Expression + | SliceFrom Expression + | SliceFor Expression + deriving (Show, Eq, Typeable, Data) + +data LiteralRepr = + RealLiteral String + | IntLiteral String + | ByteLiteral String + | StringLiteral String + | ArrayLiteral [Expression] + | SlicedLiteral Slice LiteralRepr + deriving (Show, Eq, Typeable, Data) + +data Variable = + Variable Name + | SlicedVariable Slice Variable + | Subscript Expression Variable + deriving (Show, Eq, Typeable, Data) + +data Expression = + Monadic MonadicOp Expression + | Dyadic DyadicOp Expression Expression + | MostPos Type + | MostNeg Type + | Size Type + | Conversion ConversionMode Expression + | ExprVariable Variable + | Literal Type LiteralRepr + | True + | False + | Table + | FunctionCall Name [Expression] + | BytesInType Type + | OffsetOf Type Name + deriving (Show, Eq, Typeable, Data) + +data ExpressionList = + FunctionCallList Name [Expression] + | ExpressionList [Expression] + deriving (Show, Eq, Typeable, Data) + +data MonadicOp = + MonadicBytesIn + | MonadicSubtr + | MonadicBitNot + | MonadicNot + | MonadicSize + deriving (Show, Eq, Typeable, Data) + +data DyadicOp = + Add | Subtr | Mul | Div | Rem + | Plus | Minus | Times + | BitAnd | BitOr | BitXor + | And | Or + | Eq | NotEq | Less | More | LessEq | MoreEq + | After + deriving (Show, Eq, Typeable, Data) + +data InputItem = + InCounted Variable Variable + | InVariable Variable + deriving (Show, Eq, Typeable, Data) + +data OutputItem = + OutCounted Expression Expression + | OutExpression Expression + deriving (Show, Eq, Typeable, Data) + +data Replicator = For Name Expression Expression + deriving (Show, Eq, Typeable, Data) + +data Choice = Choice Expression Process + deriving (Show, Eq, Typeable, Data) + +data Alternative = + AltInput Input Process + | GuardedAltInput Expression Input Process + | GuardedSkip Expression Process + deriving (Show, Eq, Typeable, Data) + +data Option = + Option [Expression] Process + | Else Process + deriving (Show, Eq, Typeable, Data) + +data Variant = Variant Tag [InputItem] Process + deriving (Show, Eq, Typeable, Data) + +-- This represents something that can contain local replicators and specifications. +type Structured t = [StructEntry t] +data StructEntry t = + Rep Replicator (Structured t) + | Spec Specification (Structured t) + | Only t + deriving (Show, Eq, Typeable, Data) + +data Input = + InputSimple Variable [InputItem] + | InputCase Variable (Structured Variant) + | InputAfter Variable Expression + deriving (Show, Eq, Typeable, Data) + +data Specification = + Place Name Expression + | Declaration Type Name + | Is Type Name Variable + | ValIs Type Name Expression + | DataTypeIs Name Type + | DataTypeRecord Name Bool [(Type, Name)] + | ProtocolIs Name [Type] + | ProtocolCase Name [(Tag, [Type])] + | Proc Name [(Type, Name)] Process + | Function Name [Type] [(Type, Name)] ValueProcess + | Retypes Name Variable + | Reshapes Name Variable + | ValRetypes Name Variable + | ValReshapes Name Variable + deriving (Show, Eq, Typeable, Data) + +type ValueProcess = Structured ValOf +data ValOf = ValOf Process ExpressionList + deriving (Show, Eq, Typeable, Data) + +type Process = Structured ProcessEntry +data ProcessEntry = + Assignment [Variable] ExpressionList + | Input Input + | Output Variable [OutputItem] + | OutputCase Variable Tag [OutputItem] + | Skip + | Stop + | Main + | Seq [Process] + | ReplicatedSeq Replicator Process + | If (Structured Choice) + | Case Expression (Structured Option) + | While Expression Process + | Par Bool (Structured Process) + | PlacedPar (Structured Process) + | Processor Expression Process + | Alt Bool (Structured Alternative) + | ProcCall Name [Expression] + deriving (Show, Eq, Typeable, Data) + diff --git a/fco/Parse.hs b/fco/Parse.hs index 53f71e2..8c300c5 100644 --- a/fco/Parse.hs +++ b/fco/Parse.hs @@ -538,6 +538,7 @@ occamOption -- 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 sBang