ugh
This commit is contained in:
crumbtoo committed
1 parent
7b271e5265
commit
514abe802b
9 files changed
+87
-5
No files matched your search
@@ -0,0 +1,5 @@
|
||||
ignore-project: False
|
||||
library-profiling: True
|
||||
executable-profiling: True
|
||||
tests: True
|
||||
benchmarks: True
|
||||
@@ -0,0 +1,4 @@
|
||||
ignore-project: False
|
||||
tests: True
|
||||
coverage: True
|
||||
library-coverage: True
|
||||
@@ -0,0 +1,13 @@
|
||||
data List a = Nil | Cons a (List a)
|
||||
|
||||
map :: (a -> b) -> List a -> List b
|
||||
map f l = case l of
|
||||
Nil -> Nil
|
||||
Cons a as -> Cons (f a) (map f as)
|
||||
|
||||
list = Cons 1 (Cons 2 (Cons 3 Nil))
|
||||
|
||||
lam x = *# x x
|
||||
|
||||
main = print# (map lam list)
|
||||
|
||||
@@ -0,0 +1,40 @@
|
||||
data List a = Nil | Cons a (List a)
|
||||
|
||||
data Bool = False | True
|
||||
|
||||
filter :: (a -> Bool) -> List a -> List a
|
||||
filter p l = case l of
|
||||
Nil -> Nil
|
||||
Cons a as ->
|
||||
case p a of
|
||||
True -> Cons a (filter p as)
|
||||
False -> filter p as
|
||||
|
||||
append :: List a -> List a -> List a
|
||||
append p q = case p of
|
||||
Nil -> q
|
||||
Cons a as -> Cons a (append as q)
|
||||
|
||||
qsort :: List Int# -> List Int#
|
||||
qsort l = case l of
|
||||
Nil -> Nil
|
||||
Cons a as ->
|
||||
let lesser = filter (>=# a) as
|
||||
greater = filter (<# a) as
|
||||
in append (append (qsort lesser) (Cons a Nil)) (qsort greater)
|
||||
|
||||
list = Cons 9 (Cons 2 (Cons 3 (Cons 2
|
||||
(Cons 5 (Cons 2 (Cons 12 (Cons 89 Nil)))))))
|
||||
|
||||
list2 = Cons 2 (Cons 3 Nil)
|
||||
|
||||
lt :: Int# -> Int# -> Bool
|
||||
lt a = (>=# a)
|
||||
|
||||
id x = x
|
||||
|
||||
main = case list of
|
||||
Nil -> Nil
|
||||
Cons a as -> let lesser = filter (lt a) as
|
||||
in print# lesser
|
||||
|
||||
@@ -7,5 +7,5 @@ foldr f z l = case l of
|
||||
|
||||
list = Cons 1 (Cons 2 (Cons 3 Nil))
|
||||
|
||||
main = foldr (+#) 0 list
|
||||
main = print# (foldr (+#) 0 list)
|
||||
|
||||
@@ -0,0 +1 @@
|
||||
Tix [ TixModule "rlp-0.1.0.0-inplace/Control.Monad.Utils" 2594480549 34 [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,1,1,1,1,2,2,2,2,2,2,0,0], TixModule "rlp-0.1.0.0-inplace/Rlp2Core" 2136257857 472 [1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,4,0,0,4,0,0,0,0,4,4,4,4,4,4,2,1,1,4,4,4,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,8,0,0,0,0,0,0,0,0,0,8,8,8,8,8,8,2,2,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,1,1,1,1,2,2,1,1,2,2,8,2,2,2,8,0,0,0,0,0,0,0,0,0,0,0,0,8,2,2,2,2,4,10,10,10,0,0,0,0,0,0,10,10,10,10,8,8,10,10,10,10,10,10,10,10,10,1,2,2,10,10,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,1,1,3,3,3,3,3,0,0,0,0,0,0,3,1,2,2,2,2,2,2,2,0,2,2,0,2,0,2,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,61,17,17,23,61,25,50,1,1,1,50,50,50,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,5,2,4,1,5,5,5,5,1,2,2,2,0,0,0,0,10,10,128,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4,4,0,0,0,0,0,0,0,4,4,0,0,0,0,0,0,0,0,0,0,2,2,2,0,2,2,2,2,2,2,2,2,2,3,2,2,0,0,1,3,3,8,0,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,3,8,8,8,8,8,14,1,1,1,1,1,1,0,0,0,0,0,0,0,1,1,1,1,1,0,1,0,0,0,1,1,1,1,1,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], TixModule "rlp-0.1.0.0-inplace/Core2Core" 1500124368 252 [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,21,21,21,21,21,21,0,0,0,0,0,0,0,0,0,0,0,8,8,10,9,9,14,0,0,0,0,45,0,0,1,0,0,0,2,1,2,4,0,0,0,0,0,0,0,0,0,0,0,3,3,8,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,0,0,0,0,0,0,2,2,2,2,1,1,1,1,2,0,2,2,1,1,1,2,39,39,41,1,1,1,1,1,1,1,1,1,1,1,1,4,1,1,1,1,4,4,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], TixModule "rlp-0.1.0.0-inplace/Core.Lex" 1660614516 936 [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0], TixModule "rlp-0.1.0.0-inplace/Core.Parse" 2003537170 2003 [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,Line truncated
|
||||
@@ -8,6 +8,7 @@ module Core.Examples where
|
||||
----------------------------------------------------------------------------------
|
||||
import Core.Syntax
|
||||
import Core.TH
|
||||
import Rlp.TH
|
||||
----------------------------------------------------------------------------------
|
||||
|
||||
-- fac3 = undefined
|
||||
@@ -244,3 +245,17 @@ namedConsCase = [coreProg|
|
||||
|
||||
--}
|
||||
|
||||
qsort = [rlpProg|
|
||||
data List a = Nil | Cons a (List a)
|
||||
|
||||
list = Cons 9 (Cons 2 (Cons 3 (Cons 2
|
||||
(Cons 5 (Cons 2 (Cons 12 (Cons 89 Nil)))))))
|
||||
|
||||
id x = x
|
||||
|
||||
main = case list of
|
||||
Nil -> Nil
|
||||
Cons a as -> let lesser = as
|
||||
in print# lesser
|
||||
|]
|
||||
|
||||
+2
-1
@@ -20,6 +20,7 @@ import Control.Monad.State.Lazy
|
||||
import Control.Arrow ((>>>))
|
||||
import Data.Text qualified as T
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Debug.Trace
|
||||
import Numeric (showHex)
|
||||
|
||||
import Data.Pretty
|
||||
@@ -70,7 +71,7 @@ tagData p = let ?dt = p ^. programDataTags
|
||||
go x = embed x
|
||||
|
||||
tagAlts :: (?dt :: HashMap Name (Tag, Int)) => Alter' -> Alter'
|
||||
tagAlts (Alter (AltData c) bs e) = Alter (AltTag tag) bs e
|
||||
tagAlts (Alter (AltData c) bs e) = Alter (AltTag tag) bs (cata go e)
|
||||
where tag = case ?dt ^. at c of
|
||||
Just (t,_) -> t
|
||||
-- TODO: errorful
|
||||
|
||||
@@ -103,7 +103,7 @@ data Instr = Unwind
|
||||
-- arith
|
||||
| Neg | Add | Sub | Mul | Div
|
||||
-- comparison
|
||||
| Equals | Lesser
|
||||
| Equals | Lesser | GreaterEq
|
||||
| Pack Tag Int -- Pack Tag Arity
|
||||
| CaseJump [(Tag, Code)]
|
||||
| Split Int
|
||||
@@ -228,6 +228,7 @@ step st = case head (st ^. gmCode) of
|
||||
Div -> divI
|
||||
Equals -> equalsI
|
||||
Lesser -> lesserI
|
||||
GreaterEq -> greaterEqI
|
||||
Split n -> splitI n
|
||||
Pack t n -> packI t n
|
||||
CaseJump as -> caseJumpI as
|
||||
@@ -451,9 +452,10 @@ step st = case head (st ^. gmCode) of
|
||||
mulI = primitive2 boxInt unboxInt (*) st
|
||||
divI = primitive2 boxInt unboxInt div st
|
||||
|
||||
lesserI, equalsI :: GmState
|
||||
lesserI, greaterEqI, equalsI :: GmState
|
||||
equalsI = primitive2 boxBool unboxInt (==) st
|
||||
lesserI = primitive2 boxBool unboxInt (<) st
|
||||
greaterEqI = primitive2 boxBool unboxInt (>=) st
|
||||
|
||||
splitI :: Int -> GmState
|
||||
splitI n = st
|
||||
@@ -638,6 +640,7 @@ compiledPrims =
|
||||
, binop "/#" Div
|
||||
, binop "==#" Equals
|
||||
, binop "<#" Lesser
|
||||
, binop ">=#" GreaterEq
|
||||
, ("print#", 1, [ Push 0, Eval, Print, Pack tag_Unit_unit 0, Update 1, Pop 1
|
||||
, Unwind])
|
||||
]
|
||||
@@ -653,7 +656,7 @@ buildInitialHeap (view programScDefs -> ss) = mapAccumL allocateSc mempty compil
|
||||
|
||||
-- note that we don't count sc allocations in the stats
|
||||
allocateSc :: GmHeap -> CompiledSC -> (GmHeap, (Key, Addr))
|
||||
allocateSc h (n,d,c) = (h', (NameKey n, a))
|
||||
allocateSc h (n,d,c) = traceShow a (h', (NameKey n, a))
|
||||
where (h',a) = alloc h $ NGlobal d c
|
||||
|
||||
-- >> [ref/compileSc]
|
||||
|
||||
Reference in new issue
Block a user