suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Have the pregen programs figure out the types using generics.

Browse Source 
Previously they had a list of the types they needed to generate
instances for.  This patch adds some helper code that can be used to
list all the AST.* types in the AST automatically. The result is that we
should be able to add new types to the AST without needing to change the
generator code.

This also means that GenOrdAST is now generating *all* the instances of
Ord for the AST; previously the trivial ones were derived by the
compiler.
This commit is contained in:
Adam Sampson 2008-05-09 14:02:13 +00:00
parent 9f172865ff
commit 710be039cb
6 changed files with 98 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Makefile.am
View File

@ -38,11 +38,11 @@ tocktest$(EXEEXT): $(BUILT_SOURCES) $(tocktest_SOURCES) $(config_sources)
@MKDIR_P@ obj
ghc $(GHC_OPTS) -o tocktest$(EXEEXT) -main-is TestMain --make TestMain -odir obj -hidir obj
GenTagAST$(EXEEXT): $(GenTagAST_SOURCES) data/AST.hs
GenTagAST$(EXEEXT): $(GenTagAST_SOURCES)
@MKDIR_P@ obj
ghc $(GHC_OPTS) -o GenTagAST$(EXEEXT) -main-is GenTagAST --make GenTagAST -odir obj -hidir obj
GenOrdAST$(EXEEXT): $(GenOrdAST_SOURCES) data/AST.hs
GenOrdAST$(EXEEXT): $(GenOrdAST_SOURCES)
@MKDIR_P@ obj
ghc $(GHC_OPTS) -o GenOrdAST$(EXEEXT) -main-is GenOrdAST --make GenOrdAST -odir obj -hidir obj
@ -168,8 +168,11 @@ tocktest_SOURCES += frontends/RainTypesTest.hs
tocktest_SOURCES += frontends/StructureOccamTest.hs
tocktest_SOURCES += transformations/PassTest.hs
GenTagAST_SOURCES = pregen/GenTagAST.hs
GenOrdAST_SOURCES = pregen/GenOrdAST.hs
pregen_sources = data/AST.hs
pregen_sources += pregen/PregenUtils.hs
GenTagAST_SOURCES = pregen/GenTagAST.hs $(pregen_sources)
GenOrdAST_SOURCES = pregen/GenOrdAST.hs $(pregen_sources)
#The programs to actually build:
bin_PROGRAMS = tock

23
data/AST.hs
View File

@ -58,10 +58,7 @@ instance Show Name where
show n = show $ nameName n
instance Eq Name where
(==) a b = nameName a == nameName b
instance Ord Name where
compare a b = compare (nameName a) (nameName b)
(==) a b = (nameName a) == (nameName b)
-- | The definition of a name.
data NameDef = NameDef {
@ -89,7 +86,7 @@ data Direction =
| DirOutput -- ^ The output end.
| DirUnknown -- ^ Either direction; either this is a whole channel,
-- or its direction is to be figured out later.
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | Attributes of the type of a channel.
data ChanAttributes = ChanAttributes {
@ -103,7 +100,7 @@ data ChanAttributes = ChanAttributes {
-- reads into something of type Int), and a Rain timer (which reads into something
-- of type Time).
data TimerType = OccamTimer | RainTimer
deriving (Eq, Show, Ord, Typeable, Data)
deriving (Eq, Show, Typeable, Data)
-- | A data or protocol type.
-- The two concepts aren't unified in occam, but they are here, because it
@ -180,7 +177,7 @@ data ConversionMode =
DefaultConversion
| Round
| Trunc
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | Which ends (or both) of an array dimension to check the subscript against.
-- By default, all subscripts in occam have the CheckBoth mode, but
@ -192,7 +189,7 @@ data SubscriptCheck =
| CheckLower
| CheckUpper
| CheckBoth
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | A subscript that can be applied to a variable or an expression.
data Subscript =
@ -312,7 +309,7 @@ data MonadicOp =
| MonadicMinus
| MonadicBitNot
| MonadicNot
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | A dyadic (binary) operator.
data DyadicOp =
@ -324,7 +321,7 @@ data DyadicOp =
| Eq | NotEq | Less | More | LessEq | MoreEq
| After
| Concat
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | An item in an input.
data InputItem =
@ -470,7 +467,7 @@ data AbbrevMode =
| Abbrev
-- | An abbreviation by value.
| ValAbbrev
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | Anything that introduces a new name.
data Specification =
@ -516,7 +513,7 @@ data SpecType =
-- This indicates whether a function is inlined by the compiler.
data SpecMode =
PlainSpec | InlineSpec
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | Formal parameters for @PROC@s and @FUNCTION@s.
data Formal =
@ -542,7 +539,7 @@ data ParMode =
-- 'Processor' instances inside this indicate which processor each parallel
-- process runs on.
| PlacedPar
deriving (Show, Eq, Ord, Typeable, Data)
deriving (Show, Eq, Typeable, Data)
-- | A process.
data Process =

1
data/CompState.hs
View File

@ -33,6 +33,7 @@ import qualified Data.Set as Set
import qualified AST as A
import Errors (Die, dieP, ErrorReport, Warn, warnP)
import Metadata
import OrdAST ()
-- | Modes that Tock can run in.
data CompMode = ModeFlowGraph | ModeParse | ModeCompile | ModePostC | ModeFull

38
pregen/GenOrdAST.hs
View File

@ -27,8 +27,9 @@ import Control.Monad.Writer
import Data.Generics
import Data.List
import qualified AST as A
import Metadata
import PregenUtils
import Utils
genHeader :: [String]
genHeader = [
@ -80,42 +81,9 @@ ordFor' typeName x = process $ map processConstr $ dataTypeConstrs $ dataTypeOf
("AST." ++ showConstr c, x, y, z)
items :: [String]
items = concat
[ordFor (u :: A.Actual)
,ordFor (u :: A.Alternative)
,ordFor (u :: A.ArrayConstr)
,ordFor (u :: A.ArrayElem)
,ordFor (u :: A.ChanAttributes)
,ordFor (u :: A.Choice)
,ordFor (u :: A.Dimension)
,ordFor (u :: A.Expression)
,ordFor (u :: A.ExpressionList)
,ordFor (u :: A.Formal)
,ordFor (u :: A.InputItem)
,ordFor (u :: A.InputMode)
,ordFor (u :: A.LiteralRepr)
,ordFor (u :: A.OutputItem)
,ordFor (u :: A.Option)
,ordFor (u :: A.Process)
,ordFor (u :: A.Replicator)
,ordFor (u :: A.Specification)
,ordFor (u :: A.SpecType)
,ordFor (u :: A.Structured A.Process)
,ordFor (u :: A.Structured A.Choice)
,ordFor (u :: A.Structured A.Option)
,ordFor (u :: A.Structured A.Alternative)
,ordFor (u :: A.Structured A.Variant)
,ordFor (u :: A.Structured A.ExpressionList)
,ordFor (u :: A.Structured ())
,ordFor (u :: A.Subscript)
,ordFor (u :: A.Type)
,ordFor (u :: A.Variable)
,ordFor (u :: A.Variant)
]
items = concat [ordFor w | DataBox w <- astTypes]
where
ordFor x = ordFor' (show $ typeOf x) x
u = undefined
main :: IO ()
main = putStr $ unlines $ genHeader ++ items

36
pregen/GenTagAST.hs
View File

@ -26,7 +26,8 @@ import Data.Char
import Data.Generics
import Data.List (intersperse)
import qualified AST as A
import PregenUtils
import Utils
genHeader :: [String]
genHeader = [
@ -104,39 +105,8 @@ consParamsFor x = map consParamsFor' (dataTypeConstrs $ dataTypeOf x)
cons = gmapQ (show . typeOf) (fromConstr con :: a)
items :: [String]
items = concat
[ gen (u :: A.Actual)
, gen (u :: A.Alternative)
, gen (u :: A.ArrayConstr)
, gen (u :: A.ArrayElem)
, gen (u :: A.Choice)
, gen (u :: A.Expression)
, gen (u :: A.ExpressionList)
, gen (u :: A.Formal)
, gen (u :: A.InputItem)
, gen (u :: A.InputMode)
, gen (u :: A.LiteralRepr)
, gen (u :: A.OutputItem)
, gen (u :: A.Option)
, gen (u :: A.Process)
, gen (u :: A.Replicator)
, gen (u :: A.Specification)
, gen (u :: A.SpecType)
, gen (u :: A.Subscript)
, gen (u :: A.Type)
, gen (u :: A.Variable)
, gen (u :: A.Variant)
, gen (u :: A.Structured A.Process)
, gen (u :: A.Structured A.Option)
, gen (u :: A.Structured A.Choice)
, gen (u :: A.Structured A.Variant)
, gen (u :: A.Structured A.Alternative)
, gen (u :: A.Structured A.ExpressionList)
, gen (u :: A.Structured ())
]
items = concat [gen w | DataBox w <- astTypes]
where
u = undefined
gen w
= case typeRepArgs rep of
-- A parameterised type (e.g. Structured Process).

74
pregen/PregenUtils.hs Normal file
View File

@ -0,0 +1,74 @@
{-
Tock: a compiler for parallel languages
Copyright (C) 2008 University of Kent
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation, either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program. If not, see <http://www.gnu.org/licenses/>.
-}
-- | Utilities for metaprogramming.
module PregenUtils
( astTypes
) where
import Control.Monad.State
import Data.Generics
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
import System.IO.Unsafe
import qualified AST as A
import Utils
type TypeMap = Map Int (String, DataBox)
type TypeMapM = State TypeMap
-- | Given a starting value, find all the types that could possibly be inside
-- it.
findTypesIn :: Data t => t -> TypeMap
findTypesIn start = execState (doType start) Map.empty
where
doType :: Data t => t -> TypeMapM ()
doType x
= do map <- get
when (not $ key `Map.member` map) $
do modify $ Map.insert key (reps, DataBox x)
when (isAlgType dtype) $
mapM_ doConstr $ dataTypeConstrs dtype
where
rep = typeOf x
key = unsafePerformIO $ typeRepKey rep
reps = show rep
dtype = dataTypeOf x
doConstr :: Constr -> TypeMapM ()
doConstr ctr
= sequence_ [doType x' | DataBox x' <- args]
where
args = gmapQ DataBox (asTypeOf (fromConstr ctr) x)
-- | Reduce a 'TypeMap' to only the types in a particular module.
filterModule :: String -> TypeMap -> TypeMap
filterModule prefix = Map.filter (((prefix ++ ".") `isPrefixOf`) . fst)
-- | Reduce a 'TypeMap' to a list of 'DataBox'es, sorted by name.
justBoxes :: TypeMap -> [DataBox]
justBoxes = map snd . sortBy cmp . Map.elems
where
cmp (l, _) (r, _) = compare l r
-- | Witnesses for all the types defined in the 'AST' module.
astTypes :: [DataBox]
astTypes = justBoxes $ filterModule "AST" $ findTypesIn (undefined :: A.AST)