diff --git a/examples/rlp/QuickSort.rl b/examples/rlp/QuickSort.rl new file mode 100644 index 0000000..1d45c1f --- /dev/null +++ b/examples/rlp/QuickSort.rl @@ -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) + +gte :: Int# -> Int# -> Bool +gte a = (<# a) + +id x = x + +main = print# (qsort list) + diff --git a/src/Compiler/JustRun.hs b/src/Compiler/JustRun.hs index 23cdc9e..8046603 100644 --- a/src/Compiler/JustRun.hs +++ b/src/Compiler/JustRun.hs @@ -11,6 +11,7 @@ module Compiler.JustRun ( justLexCore , justParseCore , justTypeCheckCore + , justHdbg ) where ---------------------------------------------------------------------------------- @@ -20,14 +21,22 @@ import Core.HindleyMilner import Core.Syntax (Program') import Compiler.RLPC import Control.Arrow ((>>>)) -import Control.Monad ((>=>)) +import Control.Monad ((>=>), void) import Control.Comonad import Control.Lens import Data.Text qualified as T import Data.Function ((&)) +import System.IO import GM +import Rlp.Parse +import Rlp2Core ---------------------------------------------------------------------------------- +justHdbg :: String -> IO (Node, Stats) +justHdbg s = do + p <- evalRLPCIO def (parseRlpProgR >=> desugarRlpProgR $ T.pack s) + withFile "/tmp/t.log" WriteMode $ hdbgProg p + justLexCore :: String -> Either [MsgEnvelope RlpcError] [CoreToken] justLexCore s = lexCoreR (T.pack s) & mapped . each %~ extract