Skip to content

Add ADT support on core representation #61

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
lospollosenjoyer wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Add ADT support on core representation #61

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
822 changes: 798 additions & 24 deletions lamagraph-compiler/src/Lamagraph/Compiler/Core/LmlToCore.hs
View file
Open in desktop

Large diffs are not rendered by default.

40 changes: 30 additions & 10 deletions lamagraph-compiler/src/Lamagraph/Compiler/Eval.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ import Lamagraph.Compiler.Typechecker.TcTypes

data UnaryPrim = UPMinus | UPPrintInt deriving (Show)

data BinaryPrim = BPPlus | BPMinus | BPTimes | BPLess deriving (Show)
data BinaryPrim = BPPlus | BPMinus | BPTimes | BPGreater | BPLess | BPGreaterEq | BPLessEq deriving (Show)

data Value
= VInt Int
Expand Down Expand Up @@ -103,9 +103,18 @@ evalBinaryPrim :: (MonadEval m) => BinaryPrim -> Value -> Value -> m Value
evalBinaryPrim BPPlus (VInt arg1) (VInt arg2) = pure $ VInt $ arg1 + arg2
evalBinaryPrim BPMinus (VInt arg1) (VInt arg2) = pure $ VInt $ arg1 - arg2
evalBinaryPrim BPTimes (VInt arg1) (VInt arg2) = pure $ VInt $ arg1 * arg2
evalBinaryPrim BPGreater (VInt arg1) (VInt arg2) =
let val = if arg1 > arg2 then "true" else "false"
in pure $ VAdt (Name $ mkLongident $ stdPrefix :| [val]) []
evalBinaryPrim BPLess (VInt arg1) (VInt arg2) =
let val = if arg1 < arg2 then "true" else "false"
in pure $ VAdt (Name $ mkLongident $ stdPrefix :| [val]) []
evalBinaryPrim BPGreaterEq (VInt arg1) (VInt arg2) =
let val = if arg1 >= arg2 then "true" else "false"
in pure $ VAdt (Name $ mkLongident $ stdPrefix :| [val]) []
evalBinaryPrim BPLessEq (VInt arg1) (VInt arg2) =
let val = if arg1 <= arg2 then "true" else "false"
in pure $ VAdt (Name $ mkLongident $ stdPrefix :| [val]) []
evalBinaryPrim prim arg1 arg2 = throwIO $ EInvalidBinaryApply prim arg1 arg2

{- | I think this is a bad code, because it can force pattern-matching in weird places
Expand Down Expand Up @@ -161,16 +170,22 @@ matchAlts eEnv val = \case
evalCoreBind :: (MonadEval m) => EvalEnv -> CoreBind -> m EvalEnv
evalCoreBind eEnv = \case
NonRec var expr -> do
value <- evalCoreExpr eEnv expr
value <- case expr of
Var var' | var == var' ->
case var of
Id (Name (Longident ne)) ->
pure $ VAdt (Name (Longident ne)) []
_ -> evalCoreExpr eEnv expr
pure $ coerce $ HashMap.insert var value (coerce eEnv)
Rec (bind :| []) ->
let (funVar, lamVar, lamExpr) = case bind of
(var, Lam lamVar' lamExpr') -> (var, lamVar', lamExpr')
_ -> impureThrow ENonLambdaUnderLetRec
recEnv = coerce $ HashMap.insert funVar (VClosure lamVar lamExpr recEnv) (coerce eEnv)
value = VClosure lamVar lamExpr recEnv
in pure $ coerce $ HashMap.insert funVar value (coerce eEnv)
Rec (_ :| _) -> throwIO EManyLetRecs
Rec binds ->
let extractLambda (var, Lam lamVar' lamExpr') = (var, lamVar', lamExpr')
extractLambda _ = impureThrow ENonLambdaUnderLetRec
lamInfos = fmap extractLambda binds
buildRecEnv :: EvalEnv
buildRecEnv = coerce $ foldr insertClosure (coerce eEnv) lamInfos
where
insertClosure (funVar, lamVar, lamExpr) = HashMap.insert funVar (VClosure lamVar lamExpr buildRecEnv)
in pure buildRecEnv

evalCoreBinds :: (MonadEval m) => EvalEnv -> [CoreBind] -> m EvalEnv
evalCoreBinds = foldlM evalCoreBind
Expand All @@ -183,11 +198,16 @@ defEvalEnv =
, (Id $ Name $ mkLongident $ stdPrefix :| ["+"], VBinaryPrim1 BPPlus)
, (Id $ Name $ mkLongident $ stdPrefix :| ["-"], VBinaryPrim1 BPMinus)
, (Id $ Name $ mkLongident $ stdPrefix :| ["*"], VBinaryPrim1 BPTimes)
, (Id $ Name $ mkLongident $ stdPrefix :| [">"], VBinaryPrim1 BPGreater)
, (Id $ Name $ mkLongident $ stdPrefix :| ["<"], VBinaryPrim1 BPLess)
, (Id $ Name $ mkLongident $ stdPrefix :| [">="], VBinaryPrim1 BPGreaterEq)
, (Id $ Name $ mkLongident $ stdPrefix :| ["<="], VBinaryPrim1 BPLessEq)
, (Id $ Name $ mkLongident $ stdPrefix :| ["[]"], VAdt (Name $ mkLongident $ stdPrefix :| ["[]"]) [])
, (Id $ Name $ mkLongident $ stdPrefix :| ["::"], VAdt (Name $ mkLongident $ stdPrefix :| ["::"]) [])
, (Id $ Name $ mkLongident $ stdPrefix :| ["Some"], VAdt (Name $ mkLongident $ stdPrefix :| ["Some"]) [])
, (Id $ Name $ mkLongident $ stdPrefix :| ["None"], VAdt (Name $ mkLongident $ stdPrefix :| ["None"]) [])
, (Id $ Name $ mkLongident $ stdPrefix :| ["true"], VAdt (Name $ mkLongident $ stdPrefix :| ["true"]) [])
, (Id $ Name $ mkLongident $ stdPrefix :| ["false"], VAdt (Name $ mkLongident $ stdPrefix :| ["false"]) [])
, (Id $ Name $ mkLongident $ stdPrefix :| ["print_int"], VUnaryPrim UPPrintInt)
]

Expand Down
2 changes: 1 addition & 1 deletion lamagraph-compiler/src/Lamagraph/Compiler/Typechecker/DefaultEnv.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -69,8 +69,8 @@ defaultEnv = TyEnv env
, (Name $ mkLongident $ stdPrefix :| ["*"], Forall [] $ tyInt `TArrow` tyInt `TArrow` tyInt)
, (Name $ mkLongident $ stdPrefix :| ["/"], Forall [] $ tyInt `TArrow` tyInt `TArrow` tyInt)
, (Name $ mkLongident $ stdPrefix :| [">"], Forall [] $ tyInt `TArrow` tyInt `TArrow` tyBool)
, (Name $ mkLongident $ stdPrefix :| [">="], Forall [] $ tyInt `TArrow` tyInt `TArrow` tyBool)
, (Name $ mkLongident $ stdPrefix :| ["<"], Forall [] $ tyInt `TArrow` tyInt `TArrow` tyBool)
, (Name $ mkLongident $ stdPrefix :| [">="], Forall [] $ tyInt `TArrow` tyInt `TArrow` tyBool)
, (Name $ mkLongident $ stdPrefix :| ["<="], Forall [] $ tyInt `TArrow` tyInt `TArrow` tyBool)
, (Name $ mkLongident $ stdPrefix :| ["[]"], Forall [Name $ mkLongident $ pure "a"] tyList)
,
Expand Down
90 changes: 90 additions & 0 deletions lamagraph-compiler/test/golden/core/core/Counter.lml.core
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,90 @@
let Counter.Zero = Counter.Zero
let Counter.One = Counter.One
let Counter.Two = Counter.Two
let Counter.Three = Counter.Three
let Counter.Four = Counter.Four
let Counter.Five = Counter.Five
let Counter.Positive = Counter.Positive
let Counter.Zegative = Counter.Zegative
let Counter.Negative = Counter.Negative
let Counter.Error = Counter.Error
let Counter.sum_multi = fun Counter.x ->
match Counter.x as t#a with (Counter.Zero, [], 0)
| (Counter.One, [Counter.a], Counter.a)
| ( Counter.Two
, [Counter.a, Counter.b]
, (#std.+ Counter.a) Counter.b )
| ( Counter.Three
, [Counter.a, Counter.b, Counter.c]
, (#std.+ Counter.a) ((#std.+ Counter.b) Counter.c) )
| ( Counter.Four
, [Counter.a, Counter.b, Counter.c, Counter.d]
, (#std.+ Counter.a) ((#std.+ Counter.b) ((#std.+ Counter.c) Counter.d)) )
| ( Counter.Five
, [ Counter.a
, Counter.b
, Counter.c
, Counter.d
, Counter.e ]
, (#std.+ Counter.a) ((#std.+ Counter.b) ((#std.+ Counter.c) ((#std.+ Counter.d) Counter.e))) )
let Counter.one_sign = fun Counter.x ->
match Counter.x as t#b with ( Counter.One
, [Counter.x]
, match (#std.> Counter.x) 0 as t#e with ( #std.true
, []
, Counter.Positive )
| ( #std.false
, []
, match t#b as t#b with ( Counter.One
, [Counter.x]
, match (#std.< Counter.x) 0 as t#d with ( #std.true
, []
, Counter.Negative )
| ( #std.false
, []
, match t#b as t#b with ( Counter.One
, [t#c]
, Counter.Zegative )
| (DEFAULT, [], Counter.Error) ) )
| (Counter.One, [t#c], Counter.Zegative)
| (DEFAULT, [], Counter.Error) ) )
| ( Counter.One
, [Counter.x]
, match (#std.< Counter.x) 0 as t#d with ( #std.true
, []
, Counter.Negative )
| ( #std.false
, []
, match t#b as t#b with ( Counter.One
, [t#c]
, Counter.Zegative )
| (DEFAULT, [], Counter.Error) ) )
| (Counter.One, [t#c], Counter.Zegative)
| (DEFAULT, [], Counter.Error)
let Counter.signum = fun Counter.x ->
match Counter.x as t#f with (Counter.Positive, [], 1)
| (Counter.Negative, [], -1)
| (DEFAULT, [], 0)
let Counter.signed = fun Counter.x ->
match Counter.x as t#g with (Counter.Positive, [], 1)
| (Counter.Negative, [], 1)
| (Counter.Zegative, [], 0)
| (Counter.Error, [], 0)
let Counter.zero = Counter.Zero
let Counter.one = Counter.One 1
let Counter.minus_one = Counter.One -10
let Counter.two = Counter.Two ((1), (2))
let Counter.three = Counter.Three ((2), (1), (3))
let Counter.four = Counter.Four ((1), (4), (3), (2))
let Counter.five = Counter.Five ((5), (1), (2), (4), (3))
let t#h = #std.print_int (Counter.sum_multi Counter.zero)
let t#i = #std.print_int (Counter.sum_multi Counter.one)
let t#j = #std.print_int (Counter.sum_multi Counter.two)
let t#k = #std.print_int (Counter.sum_multi Counter.three)
let t#l = #std.print_int (Counter.sum_multi Counter.four)
let t#m = #std.print_int (Counter.sum_multi Counter.five)
let t#n = #std.print_int (Counter.signum (Counter.one_sign Counter.one))
let t#o = #std.print_int (Counter.signum (Counter.one_sign Counter.minus_one))
let t#p = #std.print_int (Counter.signum (Counter.one_sign Counter.three))
let t#q = #std.print_int (Counter.signed (Counter.one_sign Counter.zero))
let t#r = #std.print_int ((#std.+ (Counter.signed (Counter.one_sign Counter.one))) (Counter.signed (Counter.one_sign Counter.minus_one)))
21 changes: 21 additions & 0 deletions lamagraph-compiler/test/golden/core/core/Forest.lml.core
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
let Forest.Leaf = Forest.Leaf
let Forest.Node = Forest.Node
let Forest.Nil = Forest.Nil
let Forest.Cons = Forest.Cons
let rec Forest.tree_sum = fun Forest.t ->
match Forest.t as t#a with ( Forest.Leaf
, [Forest.v]
, Forest.v )
| ( Forest.Node
, [Forest.f]
, Forest.forest_sum Forest.f )
and
Forest.forest_sum = fun Forest.f -> match Forest.f as t#b with ( Forest.Nil
, []
, 0 )
| ( Forest.Cons
, [Forest.t, Forest.rest]
, (#std.+ (Forest.tree_sum Forest.t)) (Forest.forest_sum Forest.rest) )
let t#c = #std.print_int (Forest.forest_sum (Forest.Cons ((Forest.Leaf 10),
(Forest.Cons ((Forest.Node (Forest.Cons ((Forest.Leaf 20),
(Forest.Nil)))), (Forest.Nil))))))
63 changes: 63 additions & 0 deletions lamagraph-compiler/test/golden/core/core/Insanity.lml.core
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,63 @@
let Insanity.F = Insanity.F
let Insanity.S = Insanity.S
let Insanity.T = Insanity.T
let Insanity.Tempty = Insanity.Tempty
let rec Insanity.first_sum = fun Insanity.a ->
match Insanity.a as t#a with ( Insanity.F
, [Insanity.x, Insanity.b]
, (#std.+ Insanity.x) (Insanity.second_sum Insanity.b) )
and
Insanity.second_sum = fun Insanity.b ->
match Insanity.b as t#b with ( Insanity.S
, [Insanity.x, Insanity.c]
, (#std.+ Insanity.x) (Insanity.third_sum Insanity.c) )
and
Insanity.third_sum = fun Insanity.c ->
match Insanity.c as t#c with (Insanity.Tempty, [], 0)
| ( Insanity.T
, [Insanity.x, Insanity.a]
, (#std.+ Insanity.x) (Insanity.first_sum Insanity.a) )
let Insanity.result = #std.print_int (Insanity.first_sum (Insanity.F ((1),
(Insanity.S ((2), (Insanity.T ((3), (Insanity.F ((4),
(Insanity.S ((5), (Insanity.Tempty))))))))))))
let Insanity.classify_num = fun Insanity.n -> match Insanity.n as t#d with ( 0
, []
, 100 )
| (1, [], 101)
| (2, [], 102)
| (5, [], 105)
| (DEFAULT, [], 999)
let Insanity.negate = fun Insanity.b -> match Insanity.b as t#e with ( #std.true
, []
, #std.false )
| (#std.false, [], #std.true)
let Insanity.to_int = fun Insanity.b -> match Insanity.b as t#f with ( #std.true
, []
, 1 )
| (#std.false, [], 0)
let Insanity.bool_and = fun Insanity.a -> fun Insanity.b ->
match Insanity.a as t#g with ( #std.true
, []
, match Insanity.b as t#h with ( #std.true
, []
, #std.true )
| (#std.false, [], #std.false) )
| (#std.false, [], #std.false)
let Insanity.sign = fun Insanity.n -> match Insanity.n as t#i with (0, [], 0)
| ( DEFAULT
, []
, match (#std.> t#i) 0 as t#j with ( #std.true
, []
, 1 )
| (#std.false, [], -1) )
let t#k = #std.print_int (Insanity.classify_num 0)
let t#l = #std.print_int (Insanity.classify_num 1)
let t#m = #std.print_int (Insanity.classify_num 5)
let t#n = #std.print_int (Insanity.classify_num 42)
let t#o = #std.print_int (Insanity.to_int (Insanity.negate #std.true))
let t#p = #std.print_int (Insanity.to_int (Insanity.negate #std.false))
let t#q = #std.print_int (Insanity.to_int ((Insanity.bool_and #std.true) #std.true))
let t#r = #std.print_int (Insanity.to_int ((Insanity.bool_and #std.true) #std.false))
let t#s = #std.print_int (Insanity.sign 0)
let t#t = #std.print_int (Insanity.sign 42)
let t#u = #std.print_int (Insanity.sign -10)
47 changes: 47 additions & 0 deletions lamagraph-compiler/test/golden/core/core/Option.lml.core
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@
let Option.None = Option.None
let Option.Some = Option.Some
let Option.map = fun Option.f -> fun Option.opt ->
match Option.opt as t#a with ( Option.Some
, [Option.x]
, Option.Some (Option.f Option.x) )
| (Option.None, [], Option.None)
let Option.mapOrDefault = fun Option.f -> fun Option.default ->
fun Option.opt ->
match Option.opt as t#b with ( Option.Some
, [Option.x]
, Option.f Option.x )
| (Option.None, [], Option.default)
let Option.increment = fun Option.x -> (#std.+ Option.x) 1
let Option.double = fun Option.x -> (#std.* Option.x) 2
let Option.f = fun Option.opt ->
(Option.map Option.double) ((Option.map Option.increment) Option.opt)
let rec Option.count_somes = fun Option.l ->
match Option.l as t#c with (#std.[], [], 0)
| ( #std.::
, [Option.hd, Option.tl]
, let Option.count_tl = Option.count_somes Option.tl
in match Option.hd as t#d with ( Option.None
, []
, Option.count_tl )
| ( Option.Some
, [t#e]
, (#std.+ 1) Option.count_tl ) )
let rec Option.sum_list_of_options = fun Option.l ->
match Option.l as t#f with (#std.[], [], 0)
| ( #std.::
, [Option.hd, Option.tl]
, let Option.sum_tl = Option.sum_list_of_options Option.tl
in match Option.hd as t#g with ( Option.None
, []
, Option.sum_tl )
| ( Option.Some
, [Option.v]
, (#std.+ Option.v) Option.sum_tl ) )
let Option.l_of_opts = #std.:: ((Option.Some 1), (#std.:: ((Option.None),
(#std.:: ((Option.Some 3), (#std.:: ((Option.Some 5),
(#std.[]))))))))
let t#h = #std.print_int (((Option.mapOrDefault Option.increment) 0) (Option.f (Option.Some 5)))
let t#i = #std.print_int (((Option.mapOrDefault Option.double) 0) (Option.Some 42))
let t#j = #std.print_int (((Option.mapOrDefault Option.double) 0) Option.None)
let Option.result1 = #std.print_int (Option.count_somes Option.l_of_opts)
let Option.result2 = #std.print_int (Option.sum_list_of_options Option.l_of_opts)
49 changes: 49 additions & 0 deletions lamagraph-compiler/test/golden/core/core/Range.lml.core
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,49 @@
let rec Range.range = fun Range.n ->
match (#std.< Range.n) 1 as t#a with ( #std.true
, []
, #std.[] )
| ( #std.false
, []
, let Range.tl = Range.range ((#std.- Range.n) 1)
in #std.:: ((Range.n), (Range.tl)) )
let rec Range.sum_list = fun Range.l -> match Range.l as t#b with ( #std.[]
, []
, 0 )
| ( #std.::
, [Range.hd, Range.tl]
, (#std.+ Range.hd) (Range.sum_list Range.tl) )
let rec Range.length = fun Range.l -> match Range.l as t#c with (#std.[], [], 0)
| ( #std.::
, [t#d, Range.tl]
, (#std.+ 1) (Range.length Range.tl) )
let rec Range.map = fun Range.f -> fun Range.l ->
match Range.l as t#e with ( #std.::
, [Range.hd, Range.tl]
, #std.:: ((Range.f Range.hd),
((Range.map Range.f) Range.tl)) )
| (#std.[], [], #std.[])
let Range.increment = fun Range.x -> (#std.+ Range.x) 1
let Range.head_of_head = fun Range.ll -> match Range.ll as t#f with ( #std.[]
, []
, 0 )
| ( #std.::
, [Range.l, t#i]
, match Range.l as t#g with ( #std.[]
, []
, 1 )
| ( #std.::
, [Range.hd, t#h]
, Range.hd ) )
let Range.r = Range.range 100
let Range.l = #std.:: ((1), (#std.:: ((2), (#std.:: ((3), (#std.[]))))))
let Range.l' = let Range.list_increment = Range.map Range.increment
in Range.list_increment Range.l
let Range.ll = #std.:: ((#std.:: ((42), (#std.:: ((43), (#std.[]))))),
(#std.:: ((#std.:: ((44), (#std.[]))), (#std.[]))))
let Range.empty_ll = #std.:: ((#std.[]), (#std.[]))
let t#j = #std.print_int (Range.sum_list Range.r)
let t#k = #std.print_int (Range.length Range.r)
let t#l = #std.print_int (Range.length Range.l)
let t#m = #std.print_int (Range.sum_list Range.l')
let t#n = #std.print_int (Range.head_of_head Range.ll)
let t#o = #std.print_int (Range.head_of_head Range.empty_ll)
Loading