aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
authorEduardo Julian2018-07-30 18:17:01 -0400
committerEduardo Julian2018-07-30 18:17:01 -0400
commit4edf1f78132715124910ac8b8fc20e4da7072f15 (patch)
tree5cc731d4db39e1a7bb567f03f4bc8ef1db8a6261 /new-luxc
parenta59fc865aee240afe21b82ffef2681bb9a6ea693 (diff)
Updating new-luxc to latest Lux changes [Part 0].
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux19
-rw-r--r--new-luxc/test/test/luxc/common.lux123
-rw-r--r--new-luxc/test/test/luxc/lang/translation/function.lux173
-rw-r--r--new-luxc/test/test/luxc/lang/translation/primitive.lux37
-rw-r--r--new-luxc/test/test/luxc/lang/translation/structure.lux104
5 files changed, 229 insertions, 227 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
index 52b104149..8f4af43c6 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -160,7 +160,7 @@
(#error.Error error)
(ex.throw invalid-field [class-name ..value-field])))
-(def: (eval store loader temp-label valueI)
+(def: (evaluate! store loader temp-label valueI)
(-> Store ClassLoader Text Inst (Error Any))
(do error.Monad<Error>
[#let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))
@@ -181,21 +181,20 @@
class (..load! eval-class loader)]
(class-value eval-class class)))
-(def: (define store loader temp-label [class-name class-bytecode])
+(def: (execute! store loader temp-label [class-name class-bytecode])
(-> Store ClassLoader Text Definition (Error Any))
(do error.Monad<Error>
- [_ (..store! class-name class-bytecode store)
- class (..load! class-name loader)]
- (class-value class-name class)))
+ [_ (..store! class-name class-bytecode store)]
+ (..load! class-name loader)))
(def: #export init
- (IO State)
+ (IO Host)
(io (let [store (: Store (atom (dictionary.new text.Hash<Text>)))
loader (memory-class-loader store)]
- (translation.init (: Host
- (structure
- (def: evaluate! (..eval store loader))
- (def: execute! (..define store loader))))))))
+ (: Host
+ (structure
+ (def: evaluate! (..evaluate! store loader))
+ (def: execute! (..execute! store loader)))))))
(def: #export runtime-class "LuxRuntime")
(def: #export function-class "LuxFunction")
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index b181004f7..87ecaed5c 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -2,77 +2,72 @@
[lux #*
[control
[monad (#+ do)]]
- [io (#+ IO)]
+ ["." io (#+ IO)]
[data
[error (#+ Error)]]
["." macro
- [code]]
- ["." language
- [compiler
- [init]
- [analysis
- [module]]
- [synthesis (#+ Synthesis)]]]]
+ ["." code]]
+ [compiler
+ ["." default
+ ["." init]
+ ["." phase
+ ["." analysis
+ ["." module]]
+ [synthesis (#+ Synthesis)]
+ ["." translation]
+ [extension
+ ["." bundle]]]]]]
[luxc
[lang
+ [host
+ [jvm (#+ Inst State Operation Phase Bundle)]]
[translation
["." jvm
+ ["._jvm" runtime]
["._jvm" expression]
- ## ["._jvm" eval]
- ## ["._jvm" runtime]
## ["._jvm" statement]
]
## [js]
## (js ["._js" expression]
- ## ["._js" eval]
## ["._js" runtime]
## ["._js" statement])
## [lua]
## (lua ["._lua" expression]
- ## ["._lua" eval]
## ["._lua" runtime]
## ["._lua" statement])
## [ruby]
## (ruby ["._ruby" expression]
- ## ["._ruby" eval]
## ["._ruby" runtime]
## ["._ruby" statement])
## [python]
## (python ["._python" expression]
- ## ["._python" eval]
## ["._python" runtime]
## ["._python" statement])
## [r]
## (r ["._r" expression]
- ## ["._r" eval]
## ["._r" runtime]
## ["._r" statement])
## [scheme]
## (scheme ["._scheme" expression]
- ## ["._scheme" eval]
## ["._scheme" runtime]
## ["._scheme" statement])
## [common-lisp]
## (common-lisp ["._common-lisp" expression]
- ## ["._common-lisp" eval]
## ["._common-lisp" runtime]
## ["._common-lisp" statement])
## [php]
## (php ["._php" expression]
- ## ["._php" eval]
## ["._php" runtime]
## ["._php" statement])
]]])
(type: #export Runner (-> Synthesis (Error Any)))
-(type: #export Definer (-> Ident Synthesis (Error Any)))
+(type: #export Definer (-> Name Synthesis (Error Any)))
(do-template [<name> <host>]
[(def: #export <name>
- (IO Lux)
- (do io.Monad<IO>
- [host <host>]
- (wrap (init.compiler host))))]
+ (IO State)
+ (:: io.Monad<IO> map translation.state <host>))]
[init-jvm jvm.init]
## [init-js js.init]
@@ -85,55 +80,55 @@
## [init-php php.init]
)
-(def: (runner translate-runtime translate-expression eval init)
- (All [a] (-> (Meta Any) (-> Synthesis (Meta a)) (-> a (Meta Any)) (IO Lux)
- Runner))
+(def: (runner generate-runtime translate bundle state)
+ (-> (Operation Any) Phase Bundle (IO State)
+ Runner)
(function (_ synthesis)
- (|> (do macro.Monad<Meta>
- [_ translate-runtime
- sampleO (translate-expression synthesis)]
- (eval sampleO))
- (language.with-current-module "")
- (macro.run (io.run init)))))
+ (|> (do phase.Monad<Operation>
+ [_ generate-runtime
+ program (translate synthesis)]
+ (translation.evaluate! program))
+ (phase.run [bundle (io.run state)]))))
-(def: (definer translate-runtime translate-expression eval init translate-def)
- (All [a] (-> (Meta Any) (-> Synthesis (Meta a)) (-> a (Meta Any)) (IO Lux)
- (-> Text Type a Code (Meta Any))
- Definer))
- (function (_ [module-name def-name] synthesis)
- (|> (do macro.Monad<Meta>
- [_ translate-runtime
- valueO (translate-expression synthesis)
- _ (module.with-module +0 module-name
- (translate-def def-name Any valueO (' {})))
- sampleO (translate-expression (code.identifier [module-name def-name]))]
- (eval sampleO))
- (language.with-current-module "")
- (macro.run (io.run init)))))
+## (def: (definer generate-runtime translate bundle state translate-def)
+## (All [a]
+## (-> (Operation Any) Phase Bundle (IO State)
+## (-> Text Type a Code (Meta Any))
+## Definer))
+## (function (_ [module-name def-name] synthesis)
+## (|> (do macro.Monad<Meta>
+## [_ generate-runtime
+## valueO (translate synthesis)
+## _ (module.with-module +0 module-name
+## (translate-def def-name Any valueO (' {})))
+## sampleO (translate (code.identifier [module-name def-name]))]
+## (eval sampleO))
+## (analysis.with-current-module "")
+## (macro.run (io.run init)))))
-(def: #export run-jvm (runner runtime_jvm.translate expression_jvm.translate eval_jvm.eval init-jvm))
-(def: #export def-jvm (definer runtime_jvm.translate expression_jvm.translate eval_jvm.eval init-jvm statement_jvm.translate-def))
+(def: #export run-jvm (runner runtime_jvm.translate expression_jvm.translate bundle.empty init-jvm))
+## (def: #export def-jvm (definer runtime_jvm.translate expression_jvm.translate init-jvm statement_jvm.translate-def))
-## (def: #export run-js (runner runtime_js.translate expression_js.translate eval_js.eval init-js))
-## (def: #export def-js (definer runtime_js.translate expression_js.translate eval_js.eval init-js statement_js.translate-def))
+## (def: #export run-js (runner runtime_js.translate expression_js.translate init-js))
+## (def: #export def-js (definer runtime_js.translate expression_js.translate init-js statement_js.translate-def))
-## (def: #export run-lua (runner runtime_lua.translate expression_lua.translate eval_lua.eval init-lua))
-## (def: #export def-lua (definer runtime_lua.translate expression_lua.translate eval_lua.eval init-lua statement_lua.translate-def))
+## (def: #export run-lua (runner runtime_lua.translate expression_lua.translate init-lua))
+## (def: #export def-lua (definer runtime_lua.translate expression_lua.translate init-lua statement_lua.translate-def))
-## (def: #export run-ruby (runner runtime_ruby.translate expression_ruby.translate eval_ruby.eval init-ruby))
-## (def: #export def-ruby (definer runtime_ruby.translate expression_ruby.translate eval_ruby.eval init-ruby statement_ruby.translate-def))
+## (def: #export run-ruby (runner runtime_ruby.translate expression_ruby.translate init-ruby))
+## (def: #export def-ruby (definer runtime_ruby.translate expression_ruby.translate init-ruby statement_ruby.translate-def))
-## (def: #export run-python (runner runtime_python.translate expression_python.translate eval_python.eval init-python))
-## (def: #export def-python (definer runtime_python.translate expression_python.translate eval_python.eval init-python statement_python.translate-def))
+## (def: #export run-python (runner runtime_python.translate expression_python.translate init-python))
+## (def: #export def-python (definer runtime_python.translate expression_python.translate init-python statement_python.translate-def))
-## (def: #export run-r (runner runtime_r.translate expression_r.translate eval_r.eval init-r))
-## (def: #export def-r (definer runtime_r.translate expression_r.translate eval_r.eval init-r statement_r.translate-def))
+## (def: #export run-r (runner runtime_r.translate expression_r.translate init-r))
+## (def: #export def-r (definer runtime_r.translate expression_r.translate init-r statement_r.translate-def))
-## (def: #export run-scheme (runner runtime_scheme.translate expression_scheme.translate eval_scheme.eval init-scheme))
-## (def: #export def-scheme (definer runtime_scheme.translate expression_scheme.translate eval_scheme.eval init-scheme statement_scheme.translate-def))
+## (def: #export run-scheme (runner runtime_scheme.translate expression_scheme.translate init-scheme))
+## (def: #export def-scheme (definer runtime_scheme.translate expression_scheme.translate init-scheme statement_scheme.translate-def))
-## (def: #export run-common-lisp (runner runtime_common-lisp.translate expression_common-lisp.translate eval_common-lisp.eval init-common-lisp))
-## (def: #export def-common-lisp (definer runtime_common-lisp.translate expression_common-lisp.translate eval_common-lisp.eval init-common-lisp statement_common-lisp.translate-def))
+## (def: #export run-common-lisp (runner runtime_common-lisp.translate expression_common-lisp.translate init-common-lisp))
+## (def: #export def-common-lisp (definer runtime_common-lisp.translate expression_common-lisp.translate init-common-lisp statement_common-lisp.translate-def))
-## (def: #export run-php (runner runtime_php.translate expression_php.translate eval_php.eval init-php))
-## (def: #export def-php (definer runtime_php.translate expression_php.translate eval_php.eval init-php statement_php.translate-def))
+## (def: #export run-php (runner runtime_php.translate expression_php.translate init-php))
+## (def: #export def-php (definer runtime_php.translate expression_php.translate init-php statement_php.translate-def))
diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux
index 9eb25d380..981dbb889 100644
--- a/new-luxc/test/test/luxc/lang/translation/function.lux
+++ b/new-luxc/test/test/luxc/lang/translation/function.lux
@@ -1,41 +1,55 @@
(.module:
- lux
- (lux [io #+ IO]
- (control [monad #+ do]
- pipe)
- (data [product]
- [maybe]
- ["e" error]
- text/format
- (coll ["a" array]
- [list "list/" Functor<List>]))
- ["r" math/random "r/" Monad<Random>]
- [macro]
- (macro [code])
- [host]
- test)
- (luxc [lang]
- (lang ["ls" synthesis]))
- (test/luxc common))
-
-(def: arity-limit Nat +10)
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["." maybe]
+ ["." error (#+ Error)]
+ [collection
+ ["." list ("list/." Functor<List>)]]]
+ [math
+ ["r" random ("r/." Monad<Random>)]]
+ [compiler
+ [default
+ ["." reference]
+ [phase
+ [analysis (#+ Arity)]
+ ["." synthesis (#+ Synthesis)]]]]
+ test]
+ [test
+ [luxc
+ ["." common (#+ Runner)]]])
+
+(def: max-arity Nat 10)
(def: arity
- (r.Random ls.Arity)
- (|> r.nat (r/map (|>> (n/% arity-limit) (n/max +1)))))
+ (r.Random Arity)
+ (|> r.nat (r/map (|>> (n/% max-arity) (n/max 1)))))
(def: gen-function
- (r.Random [ls.Arity Nat ls.Synthesis])
+ (r.Random [Arity Nat Synthesis])
(do r.Monad<Random>
[arity arity
- arg (|> r.nat (:: @ map (n/% arity)))
- #let [functionS (` ("lux function" (~ (code.nat arity)) []
- ((~ (code.int (nat-to-int (n/inc arg)))))))]]
- (wrap [arity arg functionS])))
+ arg (|> r.nat (:: @ map (n/% arity)))]
+ (wrap [arity arg
+ (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity arity
+ #synthesis.body (synthesis.variable/local arg)})])))
(def: upper-alpha-ascii
(r.Random Nat)
- (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65)))))
+ (|> r.nat (:: r.Functor<Random> map (|>> (n/% 26) (n/+ 65)))))
+
+(def: #export (check reference)
+ (-> Frac (Error Any) Bit)
+ (|>> (case> (#error.Success valueT)
+ (|> valueT (:coerce Frac) (f/= reference))
+
+ (#error.Error error)
+ (exec (log! error)
+ #0))))
(def: (function-spec run)
(-> Runner Test)
@@ -44,85 +58,74 @@
cut-off (|> r.nat (:: @ map (n/% arity)))
args (r.list arity r.frac)
#let [arg-value (maybe.assume (list.nth arg args))
- argsS (list/map code.frac args)
- last-arg (n/dec arity)
- cut-off (|> cut-off (n/min (n/dec last-arg)))]]
+ argsS (list/map (|>> synthesis.f64) args)
+ last-arg (dec arity)
+ cut-off (|> cut-off (n/min (dec last-arg)))]]
($_ seq
(test "Can read arguments."
- (|> (run (` ("lux call" (~ functionS) (~+ argsS))))
- (case> (#e.Success valueT)
- (f/= arg-value (:coerce Frac valueT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))
+ (|> (run (synthesis.function/apply [functionS argsS]))
+ (check arg-value)))
(test "Can partially apply functions."
- (or (n/= +1 arity)
- (let [partial-arity (n/inc cut-off)
+ (or (n/= 1 arity)
+ (let [partial-arity (inc cut-off)
preS (list.take partial-arity argsS)
postS (list.drop partial-arity argsS)]
- (|> (run (` ("lux call"
- ("lux call" (~ functionS) (~+ preS))
- (~+ postS))))
- (case> (#e.Success valueT)
- (f/= arg-value (:coerce Frac valueT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))))
+ (|> (run (synthesis.function/apply {#synthesis.function (synthesis.function/apply {#synthesis.function functionS
+ #synthesis.arguments preS})
+ #synthesis.arguments postS}))
+ (check arg-value)))))
(test "Can read environment."
- (or (n/= +1 arity)
- (let [env (|> (list.n/range +0 cut-off)
- (list/map (|>> n/inc nat-to-int)))
- super-arity (n/inc cut-off)
- arg-var (if (n/<= cut-off arg)
- (|> arg n/inc nat-to-int (i/* -1))
- (|> arg n/inc (n/- super-arity) nat-to-int))
- sub-arity (|> arity (n/- super-arity))
- functionS (` ("lux function" (~ (code.nat super-arity)) []
- ("lux function" (~ (code.nat sub-arity)) [(~+ (list/map code.int env))]
- ((~ (code.int arg-var))))))]
- (|> (run (` ("lux call" (~ functionS) (~+ argsS))))
- (case> (#e.Success valueT)
- (f/= arg-value (:coerce Frac valueT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))))
+ (or (n/= 1 arity)
+ (let [environment (|> (list.n/range 0 cut-off)
+ (list/map (|>> #reference.Local)))
+ arity::super (inc cut-off)
+ argument (if (n/<= cut-off arg)
+ (synthesis.variable/foreign arg)
+ (synthesis.variable/local (n/- (dec arity::super) arg)))
+ arity::sub (|> arity (n/- arity::super))
+ functionS (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity arity::super
+ #synthesis.body (synthesis.function/abstraction
+ {#synthesis.environment environment
+ #synthesis.arity arity::sub
+ #synthesis.body argument})})]
+ (|> (run (synthesis.function/apply [functionS argsS]))
+ (check arg-value)))))
)))
(context: "[JVM] Function."
- (<| (times +100)
- (function-spec run-jvm)))
+ (<| (times 100)
+ (function-spec common.run-jvm)))
## (context: "[JS] Function."
-## (<| (times +100)
-## (function-spec run-js)))
+## (<| (times 100)
+## (function-spec common.run-js)))
## (context: "[Lua] Function."
-## (<| (times +100)
-## (function-spec run-lua)))
+## (<| (times 100)
+## (function-spec common.run-lua)))
## (context: "[Ruby] Function."
-## (<| (times +100)
-## (function-spec run-ruby)))
+## (<| (times 100)
+## (function-spec common.run-ruby)))
## (context: "[Python] Function."
-## (<| (times +100)
-## (function-spec run-python)))
+## (<| (times 100)
+## (function-spec common.run-python)))
## (context: "[R] Function."
-## (<| (times +100)
-## (function-spec run-r)))
+## (<| (times 100)
+## (function-spec common.run-r)))
## (context: "[Scheme] Function."
-## (<| (times +100)
-## (function-spec run-scheme)))
+## (<| (times 100)
+## (function-spec common.run-scheme)))
## (context: "[Common Lisp] Function."
-## (<| (times +100)
-## (function-spec run-common-lisp)))
+## (<| (times 100)
+## (function-spec common.run-common-lisp)))
## (context: "[PHP] Function."
-## (<| (times +100)
-## (function-spec run-php)))
+## (<| (times 100)
+## (function-spec common.run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux
index f4ff98287..12292e08c 100644
--- a/new-luxc/test/test/luxc/lang/translation/primitive.lux
+++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux
@@ -5,8 +5,8 @@
pipe]
[data
["." error]
- [bit ("bit/" Equivalence<Bit>)]
- [text ("text/" Equivalence<Text>)
+ [bit ("bit/." Equivalence<Bit>)]
+ [text ("text/." Equivalence<Text>)
format]]
[math
["r" random]]
@@ -23,11 +23,9 @@
(-> Runner Test)
(do r.Monad<Random>
[|bit| r.bit
- |nat| r.nat
- |int| r.int
- |rev| r.rev
- |frac| r.frac
- |text| (r.ascii +5)]
+ |i64| r.i64
+ |f64| r.frac
+ |text| (r.ascii 5)]
(`` ($_ seq
(~~ (do-template [<desc> <type> <synthesis> <sample> <test>]
[(test (format "Can translate " <desc> ".")
@@ -36,47 +34,46 @@
(<test> <sample> (:coerce <type> valueT))
(#error.Error error)
- (exec (log! error)
- #0))))]
+ false)))]
["bit" Bit synthesis.bit |bit| bit/=]
- ["int" Int synthesis.i64 |int| i/=]
- ["frac" Frac synthesis.f64 |frac| f/=]
+ ["int" Int synthesis.i64 |i64| i/=]
+ ["frac" Frac synthesis.f64 |f64| f/=]
["text" Text synthesis.text |text| text/=]))
))))
(context: "[JVM] Primitives."
- (<| (times +100)
+ (<| (times 100)
(spec run-jvm)))
## (context: "[JS] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-js)))
## (context: "[Lua] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-lua)))
## (context: "[Ruby] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-ruby)))
## (context: "[Python] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-python)))
## (context: "[R] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-r)))
## (context: "[Scheme] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-scheme)))
## (context: "[Common Lisp] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-common-lisp)))
## (context: "[PHP] Primitives."
-## (<| (times +100)
+## (<| (times 100)
## (spec run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux
index 3251844b7..cd1b88c9d 100644
--- a/new-luxc/test/test/luxc/lang/translation/structure.lux
+++ b/new-luxc/test/test/luxc/lang/translation/structure.lux
@@ -1,73 +1,81 @@
(.module:
- lux
- (lux [io #+ IO]
- (control [monad #+ do]
- pipe)
- (data ["e" error]
- [maybe]
- [bit "bit/" Eq<Bit>]
- [text "text/" Eq<Text>]
- text/format
- (coll [array]
- [list "list/" Functor<List>]))
- ["r" math/random "r/" Monad<Random>]
- [macro]
- (macro [code])
- [host]
- test)
- (luxc [lang]
- (lang [".L" host]
- [synthesis #+ Synthesis]))
- (test/luxc common))
-
-(host.import: java/lang/Integer)
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["." error]
+ ["." maybe]
+ [text ("text/." Equivalence<Text>)
+ format]
+ [collection
+ ["." array]
+ ["." list ("list/." Functor<List>)]]]
+ [math
+ ["r" random]]
+ ["." host (#+ import:)]
+ [compiler
+ [default
+ [phase
+ ["." analysis]
+ ["." synthesis]]]]
+ test]
+ [test
+ [luxc
+ common]])
+
+(import: java/lang/Integer)
(def: (tuples-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
- tuple-in (r.list size r.int)]
+ [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+ tuple-in (r.list size r.i64)]
(test "Can translate tuple."
- (|> (run (code.tuple (list/map code.int tuple-in)))
- (case> (#e.Success tuple-out)
+ (|> (run (synthesis.tuple (list/map (|>> synthesis.i64) tuple-in)))
+ (case> (#error.Success tuple-out)
(let [tuple-out (:coerce (Array Any) tuple-out)]
(and (n/= size (array.size tuple-out))
(list.every? (function (_ [left right])
(i/= left (:coerce Int right)))
(list.zip2 tuple-in (array.to-list tuple-out)))))
- (#e.Error error)
+ (#error.Error error)
(exec (log! error)
#0))))))
(def: (variants-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+ [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
tag-in (|> r.nat (:: @ map (n/% num-tags)))
- #let [last?-in (n/= (n/dec num-tags) tag-in)]
- value-in r.int]
+ #let [last?-in (|> num-tags dec (n/= tag-in))]
+ value-in r.i64]
(test "Can translate variant."
- (|> (run (` ((~ (code.nat tag-in)) (~ (code.bit last?-in)) (~ (code.int value-in)))))
- (case> (#e.Success valueT)
+ (|> (run (synthesis.variant {#analysis.lefts (if last?-in
+ (dec tag-in)
+ tag-in)
+ #analysis.right? last?-in
+ #analysis.value (synthesis.i64 value-in)}))
+ (case> (#error.Success valueT)
(let [valueT (:coerce (Array Any) valueT)]
- (and (n/= +3 (array.size valueT))
- (let [tag-out (:coerce Integer (maybe.assume (array.read +0 valueT)))
- last?-out (array.read +1 valueT)
- value-out (:coerce Any (maybe.assume (array.read +2 valueT)))
- same-tag? (n/= tag-in (|> tag-out host.int-to-long (:coerce Nat)))
+ (and (n/= 3 (array.size valueT))
+ (let [tag-out (:coerce Integer (maybe.assume (array.read 0 valueT)))
+ last?-out (array.read 1 valueT)
+ value-out (:coerce Any (maybe.assume (array.read 2 valueT)))
+ same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in))
same-flag? (case last?-out
(#.Some last?-out')
(and last?-in (text/= "" (:coerce Text last?-out')))
#.None
(not last?-in))
- same-value? (i/= value-in (:coerce Int value-out))]
+ same-value? (|> value-out (:coerce Int) (i/= value-in))]
(and same-tag?
same-flag?
same-value?))))
- (#e.Error error)
+ (#error.Error error)
(exec (log! error)
#0))))))
@@ -78,37 +86,37 @@
(variants-spec run)))
(context: "[JVM] Structures."
- (<| (times +100)
+ (<| (times 100)
(structure-spec run-jvm)))
## (context: "[JS] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-js)))
## (context: "[Lua] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-lua)))
## (context: "[Ruby] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-ruby)))
## (context: "[Python] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-python)))
## (context: "[R] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-r)))
## (context: "[Scheme] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-scheme)))
## (context: "[Common Lisp] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-common-lisp)))
## (context: "[PHP] Structures."
-## (<| (times +100)
+## (<| (times 100)
## (structure-spec run-php)))