git.iko.soy/Idris-dev
on master help sign in
Group EVAL/APPLY constructors
371bd9aEdwin Brady
CHANGELOG+1
compare with master
unifiedsplit
@@ -14,6 +14,7 @@ User visible changes:
14
14
15Internal changes:
15Internal changes:
16
16
17+* Completely new run time system (not based on Epic or relying on Boehm GC)
17* Normalise before forcing to catch more forceable arguments
18* Normalise before forcing to catch more forceable arguments
18* Types no longer exported in normal form
19* Types no longer exported in normal form
19* Try to resolve overloading by inspecting types, rather than full type
20* Try to resolve overloading by inspecting types, rather than full type
src/IRTS/Defunctionalise.hs+4−1
@@ -5,15 +5,18 @@ import Core.TT
5
5
6import Debug.Trace
6import Debug.Trace
7import Data.Maybe
7import Data.Maybe
8+import Data.List
8
9
9defunctionalise :: Int -> LDefs -> LDefs
10defunctionalise :: Int -> LDefs -> LDefs
10defunctionalise nexttag defs
11defunctionalise nexttag defs
11 = let all = toAlist defs
12 = let all = toAlist defs
13+ -- sort newcons so that EVAL and APPLY cons get sequential tags
12− newcons = concatMap toCons (getFn all)
14+ newcons = sortBy conord $ concatMap toCons (getFn all)
13 eval = mkEval newcons
15 eval = mkEval newcons
14 app = mkApply newcons
16 app = mkApply newcons
15 condecls = declare nexttag newcons in
17 condecls = declare nexttag newcons in
16 addAlist (eval : app : condecls ++ (map (addApps defs) all)) emptyContext
18 addAlist (eval : app : condecls ++ (map (addApps defs) all)) emptyContext
19+ where conord (n, _, _) (n', _, _) = compare n n'
17
20
18getFn :: [(Name, LDecl)] -> [(Name, Int)]
21getFn :: [(Name, LDecl)] -> [(Name, Int)]
19getFn xs = mapMaybe fnData xs
22getFn xs = mapMaybe fnData xs
src/IRTS/Lang.hs+9−7
@@ -2,9 +2,11 @@ module IRTS.Lang where
2
2
3import Core.TT
3import Core.TT
4import Control.Monad.State hiding(lift)
4import Control.Monad.State hiding(lift)
5+import Data.List
6+import Debug.Trace
5
7
6data LVar = Loc Int | Glob Name
8data LVar = Loc Int | Glob Name
7− deriving Show
9+ deriving (Show, Eq)
8
10
9data LExp = LV LVar
11data LExp = LV LVar
10 | LApp Bool LExp [LExp] -- True = tail call
12 | LApp Bool LExp [LExp] -- True = tail call
@@ -19,7 +21,7 @@ data LExp = LV LVar
19 | LForeign FLang FType String [(FType, LExp)]
21 | LForeign FLang FType String [(FType, LExp)]
20 | LOp PrimFn [LExp]
22 | LOp PrimFn [LExp]
21 | LError String
23 | LError String
22− deriving Show
24+ deriving (Show, Eq)
23
25
24data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
26data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
25 | LFPlus | LFMinus | LFTimes | LFDiv | LFEq | LFLt | LFLe | LFGt | LFGe
27 | LFPlus | LFMinus | LFTimes | LFDiv | LFEq | LFLt | LFLe | LFGt | LFGe
@@ -35,24 +37,24 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
35 | LStrHead | LStrTail | LStrCons | LStrIndex | LStrRev
37 | LStrHead | LStrTail | LStrCons | LStrIndex | LStrRev
36 | LStdIn | LStdOut | LStdErr
38 | LStdIn | LStdOut | LStdErr
37 | LNoOp
39 | LNoOp
38− deriving Show
40+ deriving (Show, Eq)
39
41
40-- Supported target languages for foreign calls
42-- Supported target languages for foreign calls
41
43
42data FLang = LANG_C
44data FLang = LANG_C
43− deriving Show
45+ deriving (Show, Eq)
44
46
45data FType = FInt | FChar | FString | FUnit | FPtr | FDouble | FAny
47data FType = FInt | FChar | FString | FUnit | FPtr | FDouble | FAny
46− deriving Show
48+ deriving (Show, Eq)
47
49
48data LAlt = LConCase Int Name [Name] LExp
50data LAlt = LConCase Int Name [Name] LExp
49 | LConstCase Const LExp
51 | LConstCase Const LExp
50 | LDefaultCase LExp
52 | LDefaultCase LExp
51− deriving Show
53+ deriving (Show, Eq)
52
54
53data LDecl = LFun Name [Name] LExp -- name, arg names, definition
55data LDecl = LFun Name [Name] LExp -- name, arg names, definition
54 | LConstructor Name Int Int -- constructor name, tag, arity
56 | LConstructor Name Int Int -- constructor name, tag, arity
55− deriving Show
57+ deriving (Show, Eq)
56
58
57type LDefs = Ctxt LDecl
59type LDefs = Ctxt LDecl
58
60