on master help sign in
Group EVAL/APPLY constructors
commit371bd9a295ea4f3659886d6dd3ea7a81b6a91526 authorEdwin Brady <eb@cs.st-andrews.ac.uk> dateFri 14 Sep 2012, 00:18 (14 years ago) parent847ee50
3 files changed+14−8
CHANGELOG+1 src/IRTS/Defunctionalise.hs+4−1 src/IRTS/Lang.hs+9−7
CHANGELOG+1
@@ -14,6 +14,7 @@ User visible changes:
1414
1515Internal changes:
1616
17+* Completely new run time system (not based on Epic or relying on Boehm GC)
1718* Normalise before forcing to catch more forceable arguments
1819* Types no longer exported in normal form
1920* Try to resolve overloading by inspecting types, rather than full type
src/IRTS/Defunctionalise.hs+4−1
@@ -5,15 +5,18 @@ import Core.TT
55
66import Debug.Trace
77import Data.Maybe
8+import Data.List
89
910defunctionalise :: Int -> LDefs -> LDefs
1011defunctionalise nexttag defs
1112 = let all = toAlist defs
12− newcons = concatMap toCons (getFn all)
13+ -- sort newcons so that EVAL and APPLY cons get sequential tags
14+ newcons = sortBy conord $ concatMap toCons (getFn all)
1315 eval = mkEval newcons
1416 app = mkApply newcons
1517 condecls = declare nexttag newcons in
1618 addAlist (eval : app : condecls ++ (map (addApps defs) all)) emptyContext
19+ where conord (n, _, _) (n', _, _) = compare n n'
1720
1821getFn :: [(Name, LDecl)] -> [(Name, Int)]
1922getFn xs = mapMaybe fnData xs
src/IRTS/Lang.hs+9−7
@@ -2,9 +2,11 @@ module IRTS.Lang where
22
33import Core.TT
44import Control.Monad.State hiding(lift)
5+import Data.List
6+import Debug.Trace
57
68data LVar = Loc Int | Glob Name
7− deriving Show
9+ deriving (Show, Eq)
810
911data LExp = LV LVar
1012 | LApp Bool LExp [LExp] -- True = tail call
@@ -19,7 +21,7 @@ data LExp = LV LVar
1921 | LForeign FLang FType String [(FType, LExp)]
2022 | LOp PrimFn [LExp]
2123 | LError String
22− deriving Show
24+ deriving (Show, Eq)
2325
2426data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
2527 | LFPlus | LFMinus | LFTimes | LFDiv | LFEq | LFLt | LFLe | LFGt | LFGe
@@ -35,24 +37,24 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
3537 | LStrHead | LStrTail | LStrCons | LStrIndex | LStrRev
3638 | LStdIn | LStdOut | LStdErr
3739 | LNoOp
38− deriving Show
40+ deriving (Show, Eq)
3941
4042-- Supported target languages for foreign calls
4143
4244data FLang = LANG_C
43− deriving Show
45+ deriving (Show, Eq)
4446
4547data FType = FInt | FChar | FString | FUnit | FPtr | FDouble | FAny
46− deriving Show
48+ deriving (Show, Eq)
4749
4850data LAlt = LConCase Int Name [Name] LExp
4951 | LConstCase Const LExp
5052 | LDefaultCase LExp
51− deriving Show
53+ deriving (Show, Eq)
5254
5355data LDecl = LFun Name [Name] LExp -- name, arg names, definition
5456 | LConstructor Name Int Int -- constructor name, tag, arity
55− deriving Show
57+ deriving (Show, Eq)
5658
5759type LDefs = Ctxt LDecl
5860