1 2 -- ==========================================================-- 3 -- === Base declarations BaseDefs.hs ===-- 4 -- ==========================================================-- 5 6 module BaseDefs where 7 8 ---------------------------------------------------------- 9 -- Useful polymorphic types -- 10 ---------------------------------------------------------- 11 12 type AList a b = [(a, b)] 13 14 type DefnGroup a = [(Bool, [a])] 15 16 type ST a b = b -> (a, b) 17 18 data ATree a b = ALeaf 19 | ABranch (ATree a b) a b (ATree a b) Int 20 deriving (Eq) 21 22 --1.3:data Maybe a = Nothing 23 -- | Just a 24 -- deriving (Eq) 25 26 data Reply a b = Ok a 27 | Fail b 28 deriving (Eq) 29 30 31 ---------------------------------------------------------- 32 -- Misc Utils stuff -- 33 ---------------------------------------------------------- 34 35 type NameSupply = Int 36 37 type Oseq = Int -> Int -> [Char] 38 39 type Iseq = Oseq -> Oseq 40 41 data Set a = MkSet [a] 42 deriving (Eq) 43 44 type Bag a = [a] 45 46 47 ---------------------------------------------------------- 48 -- Flags -- 49 ---------------------------------------------------------- 50 51 data Flag = Typecheck -- don't do strictness analysis 52 | Simp -- do HExpr-simplification (usually a bad idea) 53 | NoCaseOpt -- don't do case-of-case optimisation 54 | ShowHExpr -- print HExprs as they are generated 55 | NoPretty -- don't clean up the program after \-lifting 56 | NoFormat -- don't prettily format first order output 57 | NoBaraki -- don't use embedding-closure pairs 58 | SimpleInv -- use simplistic version of inverse 59 | PolyLim Int -- how hard to work in Baraki dept for 60 | MonoLim Int -- polymorphism and approx FPs respectively 61 | ForceAll -- force all thunks before analysis 62 | DryRun -- quick pass to check lattice table 63 | LowerLim Int -- lower threshold for approx fixed pts 64 | UpperLim Int -- upper threshold for approx fixed pts 65 | ScaleUp Int -- scale up target ratio 66 deriving (Eq) 67 68 bdDefaultSettings 69 = [PolyLim 10000, MonoLim 10000, LowerLim 0, UpperLim 1000000, ScaleUp 20] 70 71 bdDryRunSettings 72 = [NoBaraki, LowerLim 0, UpperLim 0, PolyLim 1, MonoLim 1, ScaleUp 20] 73 74 75 ---------------------------------------------------------- 76 -- Provides a way for the system to give a -- 77 -- running commentary about what it is doing -- 78 ---------------------------------------------------------- 79 80 data SAInfo = SAResult String Domain Route 81 | SASearch ACMode String Int Int 82 | SASizes String [OneFuncSize] [OneFuncSize] 83 | SAHExpr String (HExpr Naam) 84 | SASL [Route] [Route] 85 | SAGiveUp [String] 86 deriving () 87 88 89 ---------------------------------------------------------- 90 -- Stuff for the Approx Fixed Pts business -- 91 ---------------------------------------------------------- 92 93 data ExceptionInt a = MkExInt Int [a] 94 deriving (Eq, Ord, Show{-was:Text-}) 95 96 {- partain: moved from SmallerLattice.hs -} 97 instance (Show{-was:Text-} a, Ord a) => Num (ExceptionInt a) where 98 99 (MkExInt i1 xs1) + (MkExInt i2 xs2) 100 = MkExInt (i1 + i2) (xs1 ++ xs2) 101 102 (MkExInt i1 xs1) * (MkExInt i2 xs2) 103 = MkExInt (i1 * i2) (xs1 ++ xs2) 104 105 type DomainInt = ExceptionInt Domain 106 107 type DInt = (Domain, Int) 108 109 type OneFuncSize = (Int, [Domain]) 110 111 type Sequence = ([[OneFuncSize]], [[OneFuncSize]]) 112 113 114 ---------------------------------------------------------- 115 -- Basic syntax trees for Core programs -- 116 ---------------------------------------------------------- 117 118 type Naam = [Char] 119 120 type Alter = AlterP Naam 121 type AlterP a = ([a], -- parameters to pattern-match on 122 CExprP a) -- resulting expressions 123 124 type ScValue = ScValueP Naam 125 type ScValueP a = ([a], -- list of arguments for the SC 126 CExprP a) -- body of the SC 127 128 type CoreProgram = CoreProgramP Naam 129 type CoreProgramP a = ([TypeDef], -- type definitions 130 [(Naam, -- list of SC names ... 131 ScValueP a)]) -- and their definitions 132 133 type AtomicProgram = ([TypeDef], -- exactly like a CoreProgram except 134 CExpr) -- all the SCs are put into a letrec 135 136 type TypeDef = (Naam, -- the type's name 137 [Naam], -- schematic type variables 138 [ConstrAlt]) -- constructor list 139 140 type ConstrAlt = (Naam, -- constructor's name 141 [TDefExpr]) -- list of argument types 142 143 data TDefExpr -- type expressions for definitions 144 = TDefVar Naam -- type variables 145 | TDefCons -- constructed types 146 Naam -- constructor's name 147 [TDefExpr] -- constituent type expressions 148 deriving (Eq) 149 150 151 ---------------------------------------------------------- 152 -- Core expressions -- 153 ---------------------------------------------------------- 154 155 type CExpr = CExprP Naam 156 157 data CExprP a -- Core expressions 158 = EVar Naam -- variables 159 | ENum Int -- numbers 160 | EConstr Naam -- constructors 161 | EAp (CExprP a) (CExprP a) -- applications 162 | ELet -- lets and letrecs 163 Bool -- True == recursive 164 [(a, CExprP a)] 165 (CExprP a) 166 | ECase -- case statements 167 (CExprP a) 168 [(Naam, AlterP a)] 169 | ELam -- lambda abstractions 170 [a] 171 (CExprP a) 172 deriving (Eq) 173 174 175 ---------------------------------------------------------- 176 -- Annotated Core expressions -- 177 ---------------------------------------------------------- 178 179 type AnnExpr a b = (b, AnnExpr' a b) 180 181 data AnnExpr' a b 182 = AVar Naam 183 | ANum Int 184 | AConstr Naam 185 | AAp (AnnExpr a b) (AnnExpr a b) 186 | ALet Bool [AnnDefn a b] (AnnExpr a b) 187 | ACase (AnnExpr a b) [AnnAlt a b] 188 | ALam [a] (AnnExpr a b) 189 deriving (Eq) 190 191 type AnnDefn a b = (a, AnnExpr a b) 192 193 type AnnAlt a b = (Naam, ([a], (AnnExpr a b))) 194 195 type AnnProgram a b = [(Naam, [a], AnnExpr a b)] 196 197 198 ---------------------------------------------------------- 199 -- Stuff for the #*$*%*%* Lambda-Lifter -- 200 ---------------------------------------------------------- 201 202 data Eqn = EqnNVC Naam (Set Naam) (Set Naam) 203 deriving (Eq) 204 205 206 ---------------------------------------------------------- 207 -- Typechecker stuff -- 208 ---------------------------------------------------------- 209 210 type TVName = ([Int],[Int]) 211 212 type Message = [Char] 213 214 data TExpr = TVar TVName 215 | TArr TExpr TExpr 216 | TCons [Char] [TExpr] 217 deriving (Eq) 218 219 data TypeScheme = Scheme [TVName] TExpr 220 deriving (Eq) 221 222 type Subst = AList TVName TExpr 223 224 type TcTypeEnv = AList Naam TypeScheme 225 226 type TypeEnv = AList Naam TExpr 227 228 type TypeNameSupply = TVName 229 230 type TypeInfo = (Subst, TExpr, AnnExpr Naam TExpr) 231 232 type TypeDependancy = DefnGroup Naam 233 234 235 ---------------------------------------------------------- 236 -- Domain stuff -- 237 ---------------------------------------------------------- 238 -- Assumes that all Domain values passed are in -- 239 -- uncurried form, ie no (Func _ (Func _ _)). -- 240 -- Functions generating denormalised -- 241 -- function Domains must normalise them themselves. -- 242 ---------------------------------------------------------- 243 244 type Point = (Domain, Route) 245 246 data FrontierElem = MkFrel [Route] 247 deriving (Eq, Ord, Show{-was:Text-}) 248 249 data Frontier = Min1Max0 Int [FrontierElem] [FrontierElem] 250 deriving (Eq, Ord, Show{-was:Text-}) 251 252 data Domain = Two 253 | Lift1 [Domain] 254 | Lift2 [Domain] 255 | Func [Domain] Domain 256 deriving (Eq, Ord, Show, Read) 257 258 data Route = Zero 259 | One 260 | Stop1 261 | Up1 [Route] 262 | Stop2 263 | Up2 264 | UpUp2 [Route] 265 | Rep Rep 266 deriving (Eq, Ord, Show{-was:Text-}) 267 268 data Rep = RepTwo Frontier 269 | Rep1 Frontier [Rep] 270 | Rep2 Frontier Frontier [Rep] 271 deriving (Eq, Ord, Show{-was:Text-}) 272 273 data DExpr = DXTwo 274 | DXLift1 [DExpr] 275 | DXLift2 [DExpr] 276 | DXFunc [DExpr] DExpr 277 | DXVar String 278 deriving (Eq) 279 280 type RSubst = AList String Route 281 282 type DSubst = AList String Domain 283 284 type DRRSubst = AList String (Domain, Route, Route) 285 286 type DExprEnv = AList String DExpr 287 288 data ConstrElem = ConstrRec 289 | ConstrVar Int 290 deriving (Eq, Ord, Show{-was:Text-}) 291 292 293 ---------------------------------------------------------- 294 -- Abs and Conc stuff -- 295 ---------------------------------------------------------- 296 297 data ACMode = Safe 298 | Live 299 deriving (Eq) 300 301 ---------------------------------------------------------- 302 -- Frontier search stuff -- 303 ---------------------------------------------------------- 304 305 type MemoList = AList [Route] Route 306 307 data AppInfo = A2 308 -- trivial case 309 | ALo1 310 -- low factor in function to Lift1 311 | AHi1 Int Int Domain 312 -- a high factor in a function to Lift1. 313 -- First Int is arity of low factor, second is 314 -- the index of the high factor sought. 315 -- Domain is of the high factor sought. 316 | ALo2 317 -- low factor in function to Lift2 318 | AMid2 319 -- middle factor in function to Lift2 320 | AHi2 Int Int Domain 321 -- a high factor in a function to Lift1. 322 -- First Int is arity of low & middle factors, 323 -- second is the index of the high factor sought. 324 -- Domain is of high factor sought. 325 deriving (Eq) 326 327 328 ---------------------------------------------------------- 329 -- Abstract expression trees -- 330 ---------------------------------------------------------- 331 332 data HExpr a = HApp (HExpr a) (HExpr a) 333 | HVAp (HExpr a) [HExpr a] 334 | HLam [a] (HExpr a) 335 | HVar a 336 | HMeet [HExpr a] -- must be at least one in list 337 | HPoint Route 338 | HTable (AList Route (HExpr a)) 339 deriving (Eq, Show{-was:Text-}) 340 341 342 ---------------------------------------------------------- 343 -- Prettyprinter stuff -- 344 ---------------------------------------------------------- 345 346 type PrPoint = [Int] 347 348 type PrDomain = [PrPoint] 349 350 351 ---------------------------------------------------------- 352 -- Parser stuff -- 353 ---------------------------------------------------------- 354 355 type Token = (Int, [Char]) 356 357 data PResult a = PFail [Token] 358 | POk a [Token] 359 deriving (Eq) 360 361 type Parser a = [Token] -> PResult a 362 363 data PartialExpr = NoOp 364 | FoundOp Naam CExpr 365 deriving (Eq) 366 367 368 -- ===============================================================-- 369 -- === Definition of the static component ===-- 370 -- ===---------------------------------------------------------===-- 371 -- === The static component carries around all information ===-- 372 -- === which remains unchanged throughout strictness analysis. ===-- 373 -- === This avoids having to pass around vast hordes of ===-- 374 -- === parameters containing static information. ===-- 375 -- ===============================================================-- 376 377 type StaticComponent 378 = ( 379 DExprEnv, 380 -- == AList Naam DExpr, the program's types 381 382 DSubst, 383 -- == AList Naam Domain, the simplest domains of functions 384 385 AList Naam [ConstrElem], 386 -- information on constructors 387 388 AList Naam [Naam], 389 -- information on pseudo-params inserted to fix free vars 390 391 [Flag], 392 -- set of flags altering system operation 393 394 (Int, Int, Int, Int, Int), 395 -- polymorphic and monomorphic Baraki limits, 396 -- and lower and upper limits for lattice sizes 397 -- and the scaleup ratio 398 399 AList Domain Int 400 -- the lattice size table 401 ) 402 403 404 -- ==========================================================-- 405 -- === end BaseDefs.hs ===-- 406 -- ==========================================================--