From 9a22dc032da2ab1f65d8a7f63b7f5f94e80dd40b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 5 Oct 2017 00:39:10 -0400 Subject: - Simplified "eval". --- new-luxc/source/luxc/eval.lux | 5 +- new-luxc/source/luxc/generator/eval.jvm.lux | 5 +- new-luxc/test/test/luxc/generator/case.lux | 16 +- new-luxc/test/test/luxc/generator/function.lux | 15 +- new-luxc/test/test/luxc/generator/primitive.lux | 8 +- .../test/luxc/generator/procedure/common.jvm.lux | 174 ++++++++++++--------- new-luxc/test/test/luxc/generator/structure.lux | 9 +- 7 files changed, 138 insertions(+), 94 deletions(-) diff --git a/new-luxc/source/luxc/eval.lux b/new-luxc/source/luxc/eval.lux index 266becee6..9d6ee05e7 100644 --- a/new-luxc/source/luxc/eval.lux +++ b/new-luxc/source/luxc/eval.lux @@ -13,5 +13,6 @@ (do macro;Monad [exprA (../base;with-expected-type type (analyser;analyser eval exprC)) - #let [exprS (synthesizer;synthesize exprA)]] - (eval;eval (expr;generate exprS)))) + #let [exprS (synthesizer;synthesize exprA)] + exprI (expr;generate exprS)] + (eval;eval exprI))) diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux index 818c03b66..96f7a4917 100644 --- a/new-luxc/source/luxc/generator/eval.jvm.lux +++ b/new-luxc/source/luxc/generator/eval.jvm.lux @@ -59,11 +59,10 @@ (def: eval-field Text "_value") (def: $Object $;Type ($t;class "java.lang.Object" (list))) -(def: #export (eval generator) - (-> (Lux $;Inst) (Lux Top)) +(def: #export (eval valueI) + (-> $;Inst (Lux Top)) (do Monad [class-name (:: @ map %code (macro;gensym "eval")) - valueI generator #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) (ClassWriter.visit [&common;bytecode-version (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER) diff --git a/new-luxc/test/test/luxc/generator/case.lux b/new-luxc/test/test/luxc/generator/case.lux index 9e6dbf928..9fec0d501 100644 --- a/new-luxc/test/test/luxc/generator/case.lux +++ b/new-luxc/test/test/luxc/generator/case.lux @@ -79,10 +79,11 @@ ($_ seq (test "Can generate pattern-matching." (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate valueS - (#ls;AltP (#ls;SeqP path (#ls;ExecP (#ls;Bool true))) - (#ls;SeqP (#ls;BindP +0) (#ls;ExecP (#ls;Bool false))))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate valueS + (#ls;AltP (#ls;SeqP path (#ls;ExecP (#ls;Bool true))) + (#ls;SeqP (#ls;BindP +0) (#ls;ExecP (#ls;Bool false)))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (:! Bool valueG) @@ -91,9 +92,10 @@ false))) (test "Can bind values." (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Nat to-bind) - (#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Nat to-bind) + (#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= to-bind (:! Nat valueG)) diff --git a/new-luxc/test/test/luxc/generator/function.lux b/new-luxc/test/test/luxc/generator/function.lux index 76ab600fe..3f938d9df 100644 --- a/new-luxc/test/test/luxc/generator/function.lux +++ b/new-luxc/test/test/luxc/generator/function.lux @@ -50,8 +50,9 @@ ($_ seq (test "Can read arguments." (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@expr;generate (#ls;Call argsS functionS)))) + [runtime-bytecode @runtime;generate + sampleI (@expr;generate (#ls;Call argsS functionS))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= arg-value (:! Nat valueG)) @@ -64,8 +65,9 @@ [#let [partial-arity (n.inc cut-off) preS (list;take partial-arity argsS) postS (list;drop partial-arity argsS)] - runtime-bytecode @runtime;generate] - (@eval;eval (@expr;generate (|> functionS (#ls;Call preS) (#ls;Call postS))))) + runtime-bytecode @runtime;generate + sampleI (@expr;generate (|> functionS (#ls;Call preS) (#ls;Call postS)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= arg-value (:! Nat valueG)) @@ -85,8 +87,9 @@ functionS (<| (#ls;Function super-arity (list)) (#ls;Function sub-arity env) (#ls;Variable arg-var))] - runtime-bytecode @runtime;generate] - (@eval;eval (@expr;generate (#ls;Call argsS functionS)))) + runtime-bytecode @runtime;generate + sampleI (@expr;generate (#ls;Call argsS functionS))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= arg-value (:! Nat valueG)) diff --git a/new-luxc/test/test/luxc/generator/primitive.lux b/new-luxc/test/test/luxc/generator/primitive.lux index 15289b267..581a26bdb 100644 --- a/new-luxc/test/test/luxc/generator/primitive.lux +++ b/new-luxc/test/test/luxc/generator/primitive.lux @@ -29,7 +29,9 @@ (with-expansions [ (do-template [ ] [(test (format "Can generate " ".") - (|> (@eval;eval (@;generate ( ))) + (|> (do macro;Monad + [sampleI (@;generate ( ))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( (:! valueG)) @@ -45,7 +47,9 @@ ["text" Text #ls;Text %text% T/=])] ($_ seq (test "Can generate unit." - (|> (@eval;eval (@;generate #ls;Unit)) + (|> (do macro;Monad + [sampleI (@;generate #ls;Unit)] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (is @runtime;unit (:! Text valueG)) diff --git a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux index 1da4d7c62..1016d4957 100644 --- a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux +++ b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux @@ -6,8 +6,8 @@ (data text/format [bit] ["R" result] - [bool "B/" Eq] - [text "T/" Eq] + [bool "bool/" Eq] + [text "text/" Eq] [number "n/" Interval "i/" Interval "r/" Interval "d/" Interval] (coll ["a" array] [list])) @@ -29,9 +29,11 @@ subject r;nat] (with-expansions [ (do-template [ ] [(test - (|> (@eval;eval (@;generate (#ls;Procedure - (list (#ls;Nat subject) - (#ls;Nat param))))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure + (list (#ls;Nat subject) + (#ls;Nat param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= ( param subject) (:! Nat valueG)) @@ -47,7 +49,9 @@ )] ($_ seq (test "bit count" - (|> (@eval;eval (@;generate (#ls;Procedure "bit count" (list (#ls;Nat subject))))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure "bit count" (list (#ls;Nat subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= (bit;count subject) (:! Nat valueG)) @@ -57,9 +61,11 @@ (test "bit shift-right" - (|> (@eval;eval (@;generate (#ls;Procedure "bit shift-right" - (list (#ls;Int (nat-to-int subject)) - (#ls;Nat param))))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure "bit shift-right" + (list (#ls;Int (nat-to-int subject)) + (#ls;Nat param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (i.= (bit;signed-shift-right param (nat-to-int subject)) @@ -74,7 +80,9 @@ subject r;nat] (with-expansions [ (do-template [ ] [(test - (|> (@eval;eval (@;generate (#ls;Procedure (list)))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= (:! Nat valueG)) @@ -87,7 +95,9 @@ ) (do-template [ ] [(test - (|> (@eval;eval (@;generate (#ls;Procedure (list (#ls;Nat subject))))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure (list (#ls;Nat subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( subject) (:! valueG)) @@ -96,15 +106,16 @@ false)))] ["nat to-int" Int nat-to-int i.=] - ["nat to-char" Text text;from-code T/=] + ["nat to-char" Text text;from-code text/=] ) (do-template [ ] [(test (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure - (list (#ls;Nat subject) - (#ls;Nat param)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure + (list (#ls;Nat subject) + (#ls;Nat param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( param subject) (:! valueG)) @@ -117,8 +128,8 @@ ["nat *" n.* Nat n.=] ["nat /" n./ Nat n.=] ["nat %" n.% Nat n.=] - ["nat =" n.= Bool B/=] - ["nat <" n.< Bool B/=] + ["nat =" n.= Bool bool/=] + ["nat <" n.< Bool bool/=] )] ($_ seq @@ -131,7 +142,9 @@ subject r;int] (with-expansions [ (do-template [ ] [(test - (|> (@eval;eval (@;generate (#ls;Procedure (list)))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (i.= (:! Int valueG)) @@ -144,7 +157,9 @@ ) (do-template [ ] [(test - (|> (@eval;eval (@;generate (#ls;Procedure (list (#ls;Int subject))))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure (list (#ls;Int subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( subject) (:! valueG)) @@ -158,10 +173,11 @@ (do-template [ ] [(test (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure - (list (#ls;Int subject) - (#ls;Int param)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure + (list (#ls;Int subject) + (#ls;Int param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( param subject) (:! valueG)) @@ -174,8 +190,8 @@ ["int *" i.* Int i.=] ["int /" i./ Int i.=] ["int %" i.% Int i.=] - ["int =" i.= Bool B/=] - ["int <" i.< Bool B/=] + ["int =" i.= Bool bool/=] + ["int <" i.< Bool bool/=] )] ($_ seq @@ -183,12 +199,44 @@ ))) -(context: "Frac procedures" +(context: "Frac procedures [Part 1]" + [param (|> r;frac (r;filter (|>. (f.= 0.0) not))) + subject r;frac] + (with-expansions [ (do-template [ ] + [(test + (|> (do Monad + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure + (list (#ls;Frac subject) + (#ls;Frac param))))] + (@eval;eval sampleI)) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + ( ( param subject) (:! valueG)) + + _ + false)))] + + ["frac +" f.+ Frac f.=] + ["frac -" f.- Frac f.=] + ["frac *" f.* Frac f.=] + ["frac /" f./ Frac f.=] + ["frac %" f.% Frac f.=] + ["frac =" f.= Bool bool/=] + ["frac <" f.< Bool bool/=] + )] + ($_ seq + + ))) + +(context: "Frac procedures [Part 2]" [param (|> r;frac (r;filter (|>. (f.= 0.0) not))) subject r;frac] (with-expansions [ (do-template [ ] [(test - (|> (@eval;eval (@;generate (#ls;Procedure (list)))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( (:! Frac valueG)) @@ -206,8 +254,9 @@ (do-template [ ] [(test (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure (list (#ls;Frac subject)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure (list (#ls;Frac subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( subject) (:! valueG)) @@ -217,39 +266,17 @@ ["frac to-int" Int frac-to-int i.=] ["frac to-deg" Deg frac-to-deg d.=] - ) - (do-template [ ] - [(test - (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure - (list (#ls;Frac subject) - (#ls;Frac param)))))) - (macro;run (init-compiler [])) - (case> (#R;Success valueG) - ( ( param subject) (:! valueG)) - - _ - false)))] - - ["frac +" f.+ Frac f.=] - ["frac -" f.- Frac f.=] - ["frac *" f.* Frac f.=] - ["frac /" f./ Frac f.=] - ["frac %" f.% Frac f.=] - ["frac =" f.= Bool B/=] - ["frac <" f.< Bool B/=] - )] + )] ($_ seq - (test "frac encode|decode" (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (|> (#ls;Frac subject) - (list) (#ls;Procedure "frac encode") - (list) (#ls;Procedure "frac decode"))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (|> (#ls;Frac subject) + (list) (#ls;Procedure "frac encode") + (list) (#ls;Procedure "frac decode")))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (^multi (#R;Success valueG) [(:! (Maybe Frac) valueG) (#;Some value)]) @@ -265,7 +292,9 @@ subject r;deg] (with-expansions [ (do-template [ ] [(test - (|> (@eval;eval (@;generate (#ls;Procedure (list)))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Procedure (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (d.= (:! Deg valueG)) @@ -279,8 +308,9 @@ (do-template [ ] [(test (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure (list (#ls;Deg subject)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure (list (#ls;Deg subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( subject) (:! valueG)) @@ -293,10 +323,11 @@ (do-template [ ] [(test (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure - (list (#ls;Deg subject) - (#ls;Deg param)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure + (list (#ls;Deg subject) + (#ls;Deg param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( param subject) (:! valueG)) @@ -309,16 +340,17 @@ ["deg *" d.* Deg d.=] ["deg /" d./ Deg d.=] ["deg %" d.% Deg d.=] - ["deg =" d.= Bool B/=] - ["deg <" d.< Bool B/=] + ["deg =" d.= Bool bool/=] + ["deg <" d.< Bool bool/=] ) (do-template [ ] [(test (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure - (list (#ls;Deg subject) - (#ls;Nat special)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure + (list (#ls;Deg subject) + (#ls;Nat special))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) ( ( special subject) (:! valueG)) diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux index ab0c17ade..9fec0e078 100644 --- a/new-luxc/test/test/luxc/generator/structure.lux +++ b/new-luxc/test/test/luxc/generator/structure.lux @@ -63,7 +63,9 @@ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) members (r;list size gen-primitive)] (test "Can generate tuple." - (|> (@eval;eval (@;generate (#ls;Tuple members))) + (|> (do macro;Monad + [sampleI (@;generate (#ls;Tuple members))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (let [valueG (:! (a;Array Top) valueG)] @@ -80,8 +82,9 @@ member gen-primitive] (test "Can generate variant." (|> (do Monad - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Variant tag last? member)))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Variant tag last? member))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (let [valueG (:! (a;Array Top) valueG)] -- cgit v1.2.3