-- ==========================================================--
-- === Base declarations BaseDefs.hs ===--
-- ==========================================================--
module BaseDefs where
----------------------------------------------------------
-- Useful polymorphic types --
----------------------------------------------------------
type AList a b = [(a, b)]
type DefnGroup a = [(Bool, [a])]
type ST a b = b -> (a, b)
data ATree a b = ALeaf
| ABranch (ATree a b) a b (ATree a b) Int
deriving (Eq)
--1.3:data Maybe a = Nothing
-- | Just a
-- deriving (Eq)
data Reply a b = Ok a
| Fail b
deriving (Eq)
----------------------------------------------------------
-- Misc Utils stuff --
----------------------------------------------------------
type NameSupply = Int
type Oseq = Int -> Int -> [Char]
type Iseq = Oseq -> Oseq
data Set a = MkSet [a]
deriving (Eq)
type Bag a = [a]
----------------------------------------------------------
-- Flags --
----------------------------------------------------------
data Flag = Typecheck -- don't do strictness analysis
| Simp -- do HExpr-simplification (usually a bad idea)
| NoCaseOpt -- don't do case-of-case optimisation
| ShowHExpr -- print HExprs as they are generated
| NoPretty -- don't clean up the program after \-lifting
| NoFormat -- don't prettily format first order output
| NoBaraki -- don't use embedding-closure pairs
| SimpleInv -- use simplistic version of inverse
| PolyLim Int -- how hard to work in Baraki dept for
| MonoLim Int -- polymorphism and approx FPs respectively
| ForceAll -- force all thunks before analysis
| DryRun -- quick pass to check lattice table
| LowerLim Int -- lower threshold for approx fixed pts
| UpperLim Int -- upper threshold for approx fixed pts
| ScaleUp Int -- scale up target ratio
deriving (Eq)
bdDefaultSettings
= [PolyLim 10000, MonoLim 10000, LowerLim 0, UpperLim 1000000, ScaleUp 20]
bdDryRunSettings
= [NoBaraki, LowerLim 0, UpperLim 0, PolyLim 1, MonoLim 1, ScaleUp 20]
----------------------------------------------------------
-- Provides a way for the system to give a --
-- running commentary about what it is doing --
----------------------------------------------------------
data SAInfo = SAResult String Domain Route
| SASearch ACMode String Int Int
| SASizes String [OneFuncSize] [OneFuncSize]
| SAHExpr String (HExpr Naam)
| SASL [Route] [Route]
| SAGiveUp [String]
-- deriving ()
----------------------------------------------------------
-- Stuff for the Approx Fixed Pts business --
----------------------------------------------------------
data ExceptionInt a = MkExInt Int [a]
deriving (Eq, Ord, Show{-was:Text-})
{- partain: moved from SmallerLattice.hs -}
instance (Show{-was:Text-} a, Ord a) => Num (ExceptionInt a) where
(MkExInt i1 xs1) + (MkExInt i2 xs2)
= MkExInt (i1 + i2) (xs1 ++ xs2)
(MkExInt i1 xs1) * (MkExInt i2 xs2)
= MkExInt (i1 * i2) (xs1 ++ xs2)
type DomainInt = ExceptionInt Domain
type DInt = (Domain, Int)
type OneFuncSize = (Int, [Domain])
type Sequence = ([[OneFuncSize]], [[OneFuncSize]])
----------------------------------------------------------
-- Basic syntax trees for Core programs --
----------------------------------------------------------
type Naam = [Char]
type Alter = AlterP Naam
type AlterP a = ([a], -- parameters to pattern-match on
CExprP a) -- resulting expressions
type ScValue = ScValueP Naam
type ScValueP a = ([a], -- list of arguments for the SC
CExprP a) -- body of the SC
type CoreProgram = CoreProgramP Naam
type CoreProgramP a = ([TypeDef], -- type definitions
[(Naam, -- list of SC names ...
ScValueP a)]) -- and their definitions
type AtomicProgram = ([TypeDef], -- exactly like a CoreProgram except
CExpr) -- all the SCs are put into a letrec
type TypeDef = (Naam, -- the type's name
[Naam], -- schematic type variables
[ConstrAlt]) -- constructor list
type ConstrAlt = (Naam, -- constructor's name
[TDefExpr]) -- list of argument types
data TDefExpr -- type expressions for definitions
= TDefVar Naam -- type variables
| TDefCons -- constructed types
Naam -- constructor's name
[TDefExpr] -- constituent type expressions
deriving (Eq)
----------------------------------------------------------
-- Core expressions --
----------------------------------------------------------
type CExpr = CExprP Naam
data CExprP a -- Core expressions
= EVar Naam -- variables
| ENum Int -- numbers
| EConstr Naam -- constructors
| EAp (CExprP a) (CExprP a) -- applications
| ELet -- lets and letrecs
Bool -- True == recursive
[(a, CExprP a)]
(CExprP a)
| ECase -- case statements
(CExprP a)
[(Naam, AlterP a)]
| ELam -- lambda abstractions
[a]
(CExprP a)
deriving (Eq)
----------------------------------------------------------
-- Annotated Core expressions --
----------------------------------------------------------
type AnnExpr a b = (b, AnnExpr' a b)
data AnnExpr' a b
= AVar Naam
| ANum Int
| AConstr Naam
| AAp (AnnExpr a b) (AnnExpr a b)
| ALet Bool [AnnDefn a b] (AnnExpr a b)
| ACase (AnnExpr a b) [AnnAlt a b]
| ALam [a] (AnnExpr a b)
deriving (Eq)
type AnnDefn a b = (a, AnnExpr a b)
type AnnAlt a b = (Naam, ([a], (AnnExpr a b)))
type AnnProgram a b = [(Naam, [a], AnnExpr a b)]
----------------------------------------------------------
-- Stuff for the #*$*%*%* Lambda-Lifter --
----------------------------------------------------------
data Eqn = EqnNVC Naam (Set Naam) (Set Naam)
deriving (Eq)
----------------------------------------------------------
-- Typechecker stuff --
----------------------------------------------------------
type TVName = ([Int],[Int])
type Message = [Char]
data TExpr = TVar TVName
| TArr TExpr TExpr
| TCons [Char] [TExpr]
deriving (Eq)
data TypeScheme = Scheme [TVName] TExpr
deriving (Eq)
type Subst = AList TVName TExpr
type TcTypeEnv = AList Naam TypeScheme
type TypeEnv = AList Naam TExpr
type TypeNameSupply = TVName
type TypeInfo = (Subst, TExpr, AnnExpr Naam TExpr)
type TypeDependancy = DefnGroup Naam
----------------------------------------------------------
-- Domain stuff --
----------------------------------------------------------
-- Assumes that all Domain values passed are in --
-- uncurried form, ie no (Func _ (Func _ _)). --
-- Functions generating denormalised --
-- function Domains must normalise them themselves. --
----------------------------------------------------------
type Point = (Domain, Route)
data FrontierElem = MkFrel [Route]
deriving (Eq, Ord, Show{-was:Text-})
data Frontier = Min1Max0 Int [FrontierElem] [FrontierElem]
deriving (Eq, Ord, Show{-was:Text-})
data Domain = Two
| Lift1 [Domain]
| Lift2 [Domain]
| Func [Domain] Domain
deriving (Eq, Ord, Show, Read)
data Route = Zero
| One
| Stop1
| Up1 [Route]
| Stop2
| Up2
| UpUp2 [Route]
| Rep Rep
deriving (Eq, Ord, Show{-was:Text-})
data Rep = RepTwo Frontier
| Rep1 Frontier [Rep]
| Rep2 Frontier Frontier [Rep]
deriving (Eq, Ord, Show{-was:Text-})
data DExpr = DXTwo
| DXLift1 [DExpr]
| DXLift2 [DExpr]
| DXFunc [DExpr] DExpr
| DXVar String
deriving (Eq)
type RSubst = AList String Route
type DSubst = AList String Domain
type DRRSubst = AList String (Domain, Route, Route)
type DExprEnv = AList String DExpr
data ConstrElem = ConstrRec
| ConstrVar Int
deriving (Eq, Ord, Show{-was:Text-})
----------------------------------------------------------
-- Abs and Conc stuff --
----------------------------------------------------------
data ACMode = Safe
| Live
deriving (Eq)
----------------------------------------------------------
-- Frontier search stuff --
----------------------------------------------------------
type MemoList = AList [Route] Route
data AppInfo = A2
-- trivial case
| ALo1
-- low factor in function to Lift1
| AHi1 Int Int Domain
-- a high factor in a function to Lift1.
-- First Int is arity of low factor, second is
-- the index of the high factor sought.
-- Domain is of the high factor sought.
| ALo2
-- low factor in function to Lift2
| AMid2
-- middle factor in function to Lift2
| AHi2 Int Int Domain
-- a high factor in a function to Lift1.
-- First Int is arity of low & middle factors,
-- second is the index of the high factor sought.
-- Domain is of high factor sought.
deriving (Eq)
----------------------------------------------------------
-- Abstract expression trees --
----------------------------------------------------------
data HExpr a = HApp (HExpr a) (HExpr a)
| HVAp (HExpr a) [HExpr a]
| HLam [a] (HExpr a)
| HVar a
| HMeet [HExpr a] -- must be at least one in list
| HPoint Route
| HTable (AList Route (HExpr a))
deriving (Eq, Show{-was:Text-})
----------------------------------------------------------
-- Prettyprinter stuff --
----------------------------------------------------------
type PrPoint = [Int]
type PrDomain = [PrPoint]
----------------------------------------------------------
-- Parser stuff --
----------------------------------------------------------
type Token = (Int, [Char])
data PResult a = PFail [Token]
| POk a [Token]
deriving (Eq)
type Parser a = [Token] -> PResult a
data PartialExpr = NoOp
| FoundOp Naam CExpr
deriving (Eq)
-- ===============================================================--
-- === Definition of the static component ===--
-- ===---------------------------------------------------------===--
-- === The static component carries around all information ===--
-- === which remains unchanged throughout strictness analysis. ===--
-- === This avoids having to pass around vast hordes of ===--
-- === parameters containing static information. ===--
-- ===============================================================--
type StaticComponent
= (
DExprEnv,
-- == AList Naam DExpr, the program's types
DSubst,
-- == AList Naam Domain, the simplest domains of functions
AList Naam [ConstrElem],
-- information on constructors
AList Naam [Naam],
-- information on pseudo-params inserted to fix free vars
[Flag],
-- set of flags altering system operation
(Int, Int, Int, Int, Int),
-- polymorphic and monomorphic Baraki limits,
-- and lower and upper limits for lattice sizes
-- and the scaleup ratio
AList Domain Int
-- the lattice size table
)
-- ==========================================================--
-- === end BaseDefs.hs ===--
-- ==========================================================--
|
