Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Group EVAL/APPLY constructors

  • Loading branch information...
commit 371bd9a295ea4f3659886d6dd3ea7a81b6a91526 1 parent 847ee50
Edwin Brady authored
Showing with 14 additions and 8 deletions.
  1. +1 −0  CHANGELOG
  2. +4 −1 src/IRTS/Defunctionalise.hs
  3. +9 −7 src/IRTS/Lang.hs
1  CHANGELOG
View
@@ -14,6 +14,7 @@ User visible changes:
Internal changes:
+* Completely new run time system (not based on Epic or relying on Boehm GC)
* Normalise before forcing to catch more forceable arguments
* Types no longer exported in normal form
* Try to resolve overloading by inspecting types, rather than full type
5 src/IRTS/Defunctionalise.hs
View
@@ -5,15 +5,18 @@ import Core.TT
import Debug.Trace
import Data.Maybe
+import Data.List
defunctionalise :: Int -> LDefs -> LDefs
defunctionalise nexttag defs
= let all = toAlist defs
- newcons = concatMap toCons (getFn all)
+ -- sort newcons so that EVAL and APPLY cons get sequential tags
+ newcons = sortBy conord $ concatMap toCons (getFn all)
eval = mkEval newcons
app = mkApply newcons
condecls = declare nexttag newcons in
addAlist (eval : app : condecls ++ (map (addApps defs) all)) emptyContext
+ where conord (n, _, _) (n', _, _) = compare n n'
getFn :: [(Name, LDecl)] -> [(Name, Int)]
getFn xs = mapMaybe fnData xs
16 src/IRTS/Lang.hs
View
@@ -2,9 +2,11 @@ module IRTS.Lang where
import Core.TT
import Control.Monad.State hiding(lift)
+import Data.List
+import Debug.Trace
data LVar = Loc Int | Glob Name
- deriving Show
+ deriving (Show, Eq)
data LExp = LV LVar
| LApp Bool LExp [LExp] -- True = tail call
@@ -19,7 +21,7 @@ data LExp = LV LVar
| LForeign FLang FType String [(FType, LExp)]
| LOp PrimFn [LExp]
| LError String
- deriving Show
+ deriving (Show, Eq)
data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
| LFPlus | LFMinus | LFTimes | LFDiv | LFEq | LFLt | LFLe | LFGt | LFGe
@@ -35,24 +37,24 @@ data PrimFn = LPlus | LMinus | LTimes | LDiv | LEq | LLt | LLe | LGt | LGe
| LStrHead | LStrTail | LStrCons | LStrIndex | LStrRev
| LStdIn | LStdOut | LStdErr
| LNoOp
- deriving Show
+ deriving (Show, Eq)
-- Supported target languages for foreign calls
data FLang = LANG_C
- deriving Show
+ deriving (Show, Eq)
data FType = FInt | FChar | FString | FUnit | FPtr | FDouble | FAny
- deriving Show
+ deriving (Show, Eq)
data LAlt = LConCase Int Name [Name] LExp
| LConstCase Const LExp
| LDefaultCase LExp
- deriving Show
+ deriving (Show, Eq)
data LDecl = LFun Name [Name] LExp -- name, arg names, definition
| LConstructor Name Int Int -- constructor name, tag, arity
- deriving Show
+ deriving (Show, Eq)
type LDefs = Ctxt LDecl
Please sign in to comment.
Something went wrong with that request. Please try again.