aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux27
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux9
-rw-r--r--new-luxc/test/test/luxc/common.lux62
-rw-r--r--new-luxc/test/test/luxc/lang/translation/case.lux161
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux412
-rw-r--r--new-luxc/test/test/luxc/lang/translation/reference.lux111
-rw-r--r--stdlib/source/lux/compiler/default/phase/synthesis.lux3
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation.lux15
-rw-r--r--stdlib/source/lux/data/text/unicode.lux16
-rw-r--r--stdlib/source/lux/math/random.lux25
11 files changed, 459 insertions, 384 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux
index 8f4af43c6..3fd3d389b 100644
--- a/new-luxc/source/luxc/lang/translation/jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm.lux
@@ -8,7 +8,7 @@
["." atom (#+ Atom atom)]]
[data
["." error (#+ Error)]
- ["." text
+ ["." text ("text/." Hash<Text>)
format]
[collection
["." array]
@@ -160,13 +160,16 @@
(#error.Error error)
(ex.throw invalid-field [class-name ..value-field])))
-(def: (evaluate! store loader temp-label valueI)
+(def: module-separator "/")
+(def: class-path-separator ".")
+
+(def: (evaluate! store loader eval-class valueI)
(-> Store ClassLoader Text Inst (Error Any))
(do error.Monad<Error>
- [#let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))
+ [#let [bytecode-name (text.replace-all class-path-separator module-separator eval-class)
bytecode (def.class #jvm.V1_6
#jvm.Public jvm.noneC
- eval-class
+ bytecode-name
(list) ["java.lang.Object" (list)]
(list)
(|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
@@ -175,7 +178,7 @@
"<clinit>"
(type.method (list) #.None (list))
(|>> valueI
- (inst.PUTSTATIC eval-class ..value-field ..$Object)
+ (inst.PUTSTATIC bytecode-name ..value-field ..$Object)
inst.RETURN))))]
_ (..store! eval-class bytecode store)
class (..load! eval-class loader)]
@@ -187,14 +190,24 @@
[_ (..store! class-name class-bytecode store)]
(..load! class-name loader)))
+(def: (define! store loader [module name] valueI)
+ (-> Store ClassLoader Name Inst (Error Any))
+ (let [class-name (format (text.replace-all module-separator class-path-separator module)
+ class-path-separator (name.normalize name)
+ "___" (%n (text/hash name)))]
+ (evaluate! store loader class-name valueI)))
+
(def: #export init
(IO Host)
(io (let [store (: Store (atom (dictionary.new text.Hash<Text>)))
loader (memory-class-loader store)]
(: Host
(structure
- (def: evaluate! (..evaluate! store loader))
- (def: execute! (..execute! store loader)))))))
+ (def: (evaluate! temp-label valueI)
+ (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
+ (..evaluate! store loader eval-class valueI)))
+ (def: execute! (..execute! store loader))
+ (def: define! (..define! store loader)))))))
(def: #export runtime-class "LuxRuntime")
(def: #export function-class "LuxFunction")
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index 0eb815458..4f3193bbf 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -77,7 +77,7 @@
(^ (synthesis.path/i64 value))
(operation/wrap (|>> peekI
(_.unwrap #$.Long)
- (_.long value)
+ (_.long (.int value))
_.LCMP
(_.IFNE @else)))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
index c32e80d56..c46d4d495 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux
@@ -24,9 +24,10 @@
(do-template [<name> <type> <load> <wrap>]
[(def: #export (<name> value)
(-> <type> (Operation Inst))
- (operation/wrap (|>> (<load> value) <wrap>)))]
+ (let [loadI (|> value <load>)]
+ (operation/wrap (|>> loadI <wrap>))))]
- [i64 Int _.long (_.wrap #jvm.Long)]
- [f64 Frac _.double (_.wrap #jvm.Double)]
- [text Text _.string (<|)]
+ [i64 (I64 Any) (<| _.long .int) (_.wrap #jvm.Long)]
+ [f64 Frac _.double (_.wrap #jvm.Double)]
+ [text Text _.string (<|)]
)
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index 87ecaed5c..7b370ab21 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -9,11 +9,12 @@
["." code]]
[compiler
["." default
+ ["." reference]
["." init]
["." phase
["." analysis
["." module]]
- [synthesis (#+ Synthesis)]
+ ["." synthesis (#+ Synthesis)]
["." translation]
[extension
["." bundle]]]]]]
@@ -90,45 +91,40 @@
(translation.evaluate! program))
(phase.run [bundle (io.run state)]))))
-## (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: (definer generate-runtime translate bundle state)
+ (-> (Operation Any) Phase Bundle (IO State) Definer)
+ (function (_ name synthesis)
+ (|> (do phase.Monad<Operation>
+ [_ generate-runtime
+ valueS (translate synthesis)
+ _ (translation.define! name valueS)
+ program (translate (synthesis.constant name))]
+ (translation.evaluate! program))
+ (phase.run [bundle (io.run state)]))))
(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 def-jvm (definer runtime_jvm.translate expression_jvm.translate bundle.empty init-jvm))
-## (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-js (runner runtime_js.translate expression_js.translate bundle.empty init-js))
+## (def: #export def-js (definer runtime_js.translate expression_js.translate bundle.empty init-js))
-## (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-lua (runner runtime_lua.translate expression_lua.translate bundle.empty init-lua))
+## (def: #export def-lua (definer runtime_lua.translate expression_lua.translate bundle.empty init-lua))
-## (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-ruby (runner runtime_ruby.translate expression_ruby.translate bundle.empty init-ruby))
+## (def: #export def-ruby (definer runtime_ruby.translate expression_ruby.translate bundle.empty init-ruby))
-## (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-python (runner runtime_python.translate expression_python.translate bundle.empty init-python))
+## (def: #export def-python (definer runtime_python.translate expression_python.translate bundle.empty init-python))
-## (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-r (runner runtime_r.translate expression_r.translate bundle.empty init-r))
+## (def: #export def-r (definer runtime_r.translate expression_r.translate bundle.empty init-r))
-## (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-scheme (runner runtime_scheme.translate expression_scheme.translate bundle.empty init-scheme))
+## (def: #export def-scheme (definer runtime_scheme.translate expression_scheme.translate bundle.empty init-scheme))
-## (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-common-lisp (runner runtime_common-lisp.translate expression_common-lisp.translate bundle.empty init-common-lisp))
+## (def: #export def-common-lisp (definer runtime_common-lisp.translate expression_common-lisp.translate bundle.empty init-common-lisp))
-## (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))
+## (def: #export run-php (runner runtime_php.translate expression_php.translate bundle.empty init-php))
+## (def: #export def-php (definer runtime_php.translate expression_php.translate bundle.empty init-php))
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux
index 391dc5ad8..ed8529429 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/new-luxc/test/test/luxc/lang/translation/case.lux
@@ -1,62 +1,81 @@
(.module:
- lux
- (lux [io #+ IO]
- (control [monad #+ do]
- pipe)
- (data ["e" error]
- text/format
- (coll [list]))
- ["r" math/random]
- (lang ["//." synthesis #+ Path Synthesis])
- test)
- (test/luxc common))
-
-(def: struct-limit Nat +10)
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["e" error]
+ [text
+ format]
+ [collection
+ ["." list]]]
+ [math
+ ["r" random]]
+ [compiler
+ [default
+ ["." reference]
+ [phase
+ ["." analysis]
+ ["." synthesis (#+ Path Synthesis)]]]]
+ test]
+ [test
+ [luxc
+ ["." common (#+ Runner)]]]
+ [//
+ ["&" function]])
+
+(def: struct-limit Nat 10)
(def: (tail? size idx)
(-> Nat Nat Bit)
- (n/= (n/dec size) idx))
+ (n/= (dec size) idx))
(def: gen-case
(r.Random [Synthesis Path])
(<| r.rec (function (_ gen-case))
(`` ($_ r.either
(do r.Monad<Random>
- [value r.int]
- (wrap [(//synthesis.path/i64 value)
- //synthesis.path/pop]))
+ [value r.i64]
+ (wrap [(synthesis.i64 value)
+ synthesis.path/pop]))
(~~ (do-template [<gen> <synth> <path>]
[(do r.Monad<Random>
[value <gen>]
(wrap [(<synth> value)
(<path> value)]))]
- [r.bit //synthesis.bit //synthesis.path/bit]
- [r.int //synthesis.i64 //synthesis.path/i64]
- [r.frac //synthesis.f64 //synthesis.path/f64]
- [(r.unicode +5) //synthesis.text //synthesis.path/text]))
+ [r.bit synthesis.bit synthesis.path/bit]
+ [r.i64 synthesis.i64 synthesis.path/i64]
+ [r.frac synthesis.f64 synthesis.path/f64]
+ [(r.unicode 5) synthesis.text synthesis.path/text]))
(do r.Monad<Random>
- [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2))))
+ [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] gen-case
- #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' []))
- (list subS)
- (list.repeat (|> size n/dec (n/- idx)) (' [])))))])
- caseP (//synthesis.path/seq [(if (tail? size idx)
- (` ("lux case tuple right" (~ (code.nat idx))))
- (` ("lux case tuple left" (~ (code.nat idx)))))
- subP])]]
+ #let [unitS (synthesis.text synthesis.unit)
+ caseS (synthesis.tuple
+ (list.concat (list (list.repeat idx unitS)
+ (list subS)
+ (list.repeat (|> size dec (n/- idx)) unitS))))
+ caseP (synthesis.path/seq [(if (tail? size idx)
+ (synthesis.member/right idx)
+ (synthesis.member/left idx))
+ subP])]]
(wrap [caseS caseP]))
(do r.Monad<Random>
- [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2))))
+ [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
idx (|> r.nat (:: @ map (n/% size)))
[subS subP] gen-case
- #let [caseS (` ((~ (code.nat idx)) (~ (code.bit (tail? size idx))) (~ subS)))
- caseP (` ("lux case seq"
- (~ (if (tail? size idx)
- (` ("lux case variant right" (~ (code.nat idx))))
- (` ("lux case variant left" (~ (code.nat idx))))))
- (~ subP)))]]
+ #let [caseS (let [right? (tail? size idx)]
+ (synthesis.variant
+ {#analysis.lefts idx
+ #analysis.right? right?
+ #analysis.value subS}))
+ caseP (synthesis.path/seq
+ [(if (tail? size idx)
+ (synthesis.side/right idx)
+ (synthesis.side/left idx))
+ subP])]]
(wrap [caseS caseP]))
))))
@@ -64,65 +83,55 @@
(-> Runner Test)
(do r.Monad<Random>
[[valueS pathS] gen-case
- to-bind r.nat]
+ to-bind r.frac]
($_ seq
(test "Can translate pattern-matching."
- (|> (run (` ("lux case" (~ valueS)
- ("lux case alt"
- ("lux case seq" (~ pathS)
- ("lux case exec" #1))
- ("lux case seq" ("lux case bind" +0)
- ("lux case exec" #0))))))
- (case> (#e.Success valueT)
- (:coerce Bit valueT)
-
- (#e.Error error)
- (exec (log! error)
- #0))))
+ (|> (run (synthesis.branch/case
+ [valueS
+ (synthesis.path/alt [(synthesis.path/seq [pathS
+ (synthesis.path/then (synthesis.f64 to-bind))])
+ (synthesis.path/then (synthesis.f64 +0.0))])]))
+ (&.check to-bind)))
(test "Can bind values."
- (|> (run (` ("lux case" (~ (code.nat to-bind))
- ("lux case seq" ("lux case bind" +0)
- ("lux case exec" (0))))))
- (case> (#e.Success valueT)
- (n/= to-bind (:coerce Nat valueT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))
+ (|> (run (synthesis.branch/case
+ [(synthesis.f64 to-bind)
+ (synthesis.path/seq [(synthesis.path/bind 0)
+ (synthesis.path/then (synthesis.variable/local 0))])]))
+ (&.check to-bind)))
)))
(context: "[JVM] Pattern-matching."
- (<| (times +100)
- (pattern-matching-spec run-jvm)))
+ (<| (times 100)
+ (pattern-matching-spec common.run-jvm)))
## (context: "[JS] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-js)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-js)))
## (context: "[Lua] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-lua)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-lua)))
## (context: "[Ruby] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-ruby)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-ruby)))
## (context: "[Python] Function."
-## (<| (times +100)
-## (pattern-matching-spec run-python)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-python)))
## (context: "[R] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-r)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-r)))
## (context: "[Scheme] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-scheme)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-scheme)))
## (context: "[Common Lisp] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-common-lisp)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-common-lisp)))
## (context: "[PHP] Pattern-matching."
-## (<| (times +100)
-## (pattern-matching-spec run-php)))
+## (<| (times 100)
+## (pattern-matching-spec common.run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 769aea3f5..2641d8acd 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -1,34 +1,38 @@
(.module:
- lux
- (lux [io #+ IO]
- (control [monad #+ do]
- pipe)
- (data text/format
- [bit]
- ["e" error]
- [bit "bit/" Eq<Bit>]
- [text "text/" Eq<Text>]
- [number "int/" Number<Int> "frac/" Number<Frac> Interval<Frac>]
- (coll ["a" array]
- [list]))
- ["r" math/random]
- [macro]
- (macro [code])
- [host]
- test)
- (luxc [lang]
- (lang [synthesis #+ Synthesis]))
- (test/luxc common))
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["e" error]
+ [bit ("bit/." Equivalence<Bit>)]
+ [number ("frac/." Number<Frac> Interval<Frac>)
+ ["." i64]]
+ ["." text ("text/." Equivalence<Text>)
+ format]
+ [collection
+ ["." list]]]
+ [math
+ ["r" random]]
+ [compiler
+ [default
+ ["." reference]
+ [phase
+ ["." synthesis]]]]
+ test]
+ [test
+ [luxc
+ ["." common (#+ Runner)]]])
(def: (bit-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [param r.nat
- subject r.nat]
+ [param r.i64
+ subject r.i64]
(with-expansions [<binary> (do-template [<name> <reference> <param-expr>]
[(test <name>
- (|> (run (` (<name> (~ (code.nat subject))
- (~ (code.nat param)))))
+ (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject)
+ (synthesis.i64 param))))
(case> (#e.Success valueT)
(n/= (<reference> param subject) (:coerce Nat valueT))
@@ -37,39 +41,38 @@
#0))
(let [param <param-expr>])))]
- ["lux bit and" bit.and param]
- ["lux bit or" bit.or param]
- ["lux bit xor" bit.xor param]
- ["lux bit left-shift" bit.left-shift (n/% +64 param)]
- ["lux bit logical-right-shift" bit.logical-right-shift (n/% +64 param)]
+ ["lux bit and" i64.and param]
+ ["lux bit or" i64.or param]
+ ["lux bit xor" i64.xor param]
+ ["lux bit left-shift" i64.left-shift (n/% 64 param)]
+ ["lux bit logical-right-shift" i64.logical-right-shift (n/% 64 param)]
)]
($_ seq
<binary>
(test "lux bit arithmetic-right-shift"
- (|> (run (` ("lux bit arithmetic-right-shift"
- (~ (code.int (nat-to-int subject)))
- (~ (code.nat param)))))
+ (|> (run (#synthesis.Extension "lux bit arithmetic-right-shift"
+ (list (synthesis.i64 subject)
+ (synthesis.i64 param))))
(case> (#e.Success valueT)
- (i/= (bit.arithmetic-right-shift param (nat-to-int subject))
- (:coerce Int valueT))
+ ("lux i64 ="
+ (i64.arithmetic-right-shift param subject)
+ (:coerce I64 valueT))
(#e.Error error)
(exec (log! error)
#0))
- (let [param (n/% +64 param)])))
+ (let [param (n/% 64 param)])))
))))
-(def: (int-spec run)
+(def: (i64-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [param (|> r.int (r.filter (|>> (i/= 0) not)))
- subject r.int
- #let [_ (log! (format " param = " (%i param) "\n"
- "subject = " (%i subject) "\n"))]]
+ [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not)))
+ subject r.i64]
(`` ($_ seq
(~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>]
[(test <name>
- (|> (run (` (<name> (~ (code.int subject)))))
+ (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject))))
(case> (#e.Success valueT)
(<comp> (<prepare> subject) (:coerce <type> valueT))
@@ -78,16 +81,17 @@
#0))
(let [subject <subject-expr>])))]
- ["lux int to-frac" Frac int-to-frac f/= subject]
- ["lux int char" Text (|>> (:coerce Nat) text.from-code) text/= (|> subject
+ ["lux i64 to-frac" Frac int-to-frac f/= subject]
+ ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text/= (|> subject
(:coerce Nat)
- (n/% (bit.left-shift +8 +1))
+ (n/% (i64.left-shift 8 1))
(:coerce Int))]
))
(~~ (do-template [<name> <reference> <outputT> <comp>]
[(test <name>
(exec (log! <name>)
- (|> (run (` (<name> (~ (code.int subject)) (~ (code.int param)))))
+ (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject)
+ (synthesis.i64 param))))
(case> (#e.Success valueT)
(<comp> (<reference> param subject) (:coerce <outputT> valueT))
@@ -95,63 +99,66 @@
(exec (log! error)
#0)))))]
- ["lux int +" i/+ Int i/=]
- ["lux int -" i/- Int i/=]
- ["lux int *" i/* Int i/=]
- ["lux int /" i// Int i/=]
- ["lux int %" i/% Int i/=]
- ["lux int =" i/= Bit bit/=]
- ["lux int <" i/< Bit bit/=]
+ ["lux i64 +" i/+ Int i/=]
+ ["lux i64 -" i/- Int i/=]
+ ["lux i64 *" i/* Int i/=]
+ ["lux i64 /" i// Int i/=]
+ ["lux i64 %" i/% Int i/=]
+ ["lux i64 =" i/= Bit bit/=]
+ ["lux i64 <" i/< Bit bit/=]
))
))))
-(def: (frac-spec|0 run)
+(def: (f64-spec/0 run)
(-> Runner Test)
(do r.Monad<Random>
- [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
+ [param (|> r.frac (r.filter (|>> (f/= +0.0) not)))
subject r.frac]
(with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>]
[(test <name>
- (|> (run (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))
+ (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
+ (synthesis.f64 param))))
(case> (#e.Success valueT)
(<comp> (<reference> param subject) (:coerce <outputT> valueT))
_
#0)))]
- ["lux frac +" f/+ Frac f/=]
- ["lux frac -" f/- Frac f/=]
- ["lux frac *" f/* Frac f/=]
- ["lux frac /" f// Frac f/=]
- ["lux frac %" f/% Frac f/=]
- ["lux frac =" f/= Bit bit/=]
- ["lux frac <" f/< Bit bit/=]
+ ["lux f64 +" f/+ Frac f/=]
+ ["lux f64 -" f/- Frac f/=]
+ ["lux f64 *" f/* Frac f/=]
+ ["lux f64 /" f// Frac f/=]
+ ["lux f64 %" f/% Frac f/=]
+ ["lux f64 =" f/= Bit bit/=]
+ ["lux f64 <" f/< Bit bit/=]
)]
($_ seq
<binary>
))))
-(def: (frac-spec|1 run)
+(def: (f64-spec/1 run)
(-> Runner Test)
(do r.Monad<Random>
[subject r.frac]
(`` ($_ seq
(~~ (do-template [<name> <test>]
[(test <name>
- (|> (run (` (<name>)))
+ (|> (run (#synthesis.Extension <name> (list)))
(case> (#e.Success valueT)
(<test> (:coerce Frac valueT))
_
#0)))]
- ["lux frac min" (f/= frac/bottom)]
- ["lux frac max" (f/= frac/top)]
- ["lux frac smallest" (f/= ("lux frac smallest"))]
+ ["lux f64 min" (f/= frac/bottom)]
+ ["lux f64 max" (f/= frac/top)]
+ ["lux f64 smallest" (f/= ("lux frac smallest"))]
))
(~~ (do-template [<forward> <backward> <test>]
[(test <forward>
- (|> (run (` (<backward> (<forward> (~ (code.frac subject))))))
+ (|> (run (|> subject synthesis.f64
+ (list) (#synthesis.Extension <forward>)
+ (list) (#synthesis.Extension <backward>)))
(case> (#e.Success valueT)
(|> valueT (:coerce Frac) (f/- subject) frac/abs <test>)
@@ -159,113 +166,105 @@
(exec (log! error)
#0))))]
- ["lux frac to-int" "lux int to-frac" (f/< 1.0)]))
+ ["lux f64 to-int" "lux i64 to-frac" (f/< +1.0)]))
))))
-(def: (frac-spec run)
+(def: (f64-spec run)
(-> Runner Test)
($_ seq
- (frac-spec|0 run)
- (frac-spec|1 run)))
-
-(def: lower-alpha
- (r.Random Nat)
- (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +97)))))
-
-(def: upper-alpha
- (r.Random Nat)
- (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65)))))
-
-(def: alpha
- (r.Random Nat)
- (r.either lower-alpha
- upper-alpha))
+ (f64-spec/0 run)
+ (f64-spec/1 run)))
(def: (text-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [sample-size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
- sample0 (r.text' lower-alpha sample-size)
- sample1 (r.text' upper-alpha sample-size)
- sample2 (|> (r.text' alpha sample-size)
+ [sample-size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
+ sample0 (r.ascii/lower-alpha sample-size)
+ sample1 (r.ascii/upper-alpha sample-size)
+ sample2 (|> (r.ascii/alpha sample-size)
(r.filter (|>> (text/= sample1) not)))
char-idx (|> r.nat (:: @ map (n/% sample-size)))
- #let [sample0S (code.text sample0)
- sample1S (code.text sample1)
- sample2S (code.text sample2)
- concatenatedS (` ("lux text concat" (~ sample0S) (~ sample1S)))
+ #let [sample0S (synthesis.text sample0)
+ sample1S (synthesis.text sample1)
+ sample2S (synthesis.text sample2)
+ concatenatedS (#synthesis.Extension "lux text concat" (list sample0S sample1S))
pre-rep-once (format sample0 sample1)
post-rep-once (format sample0 sample2)
pre-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample1))
post-rep-all (|> (list.repeat sample-size sample0) (text.join-with sample2))]]
($_ seq
(test "Can compare texts for equality."
- (and (|> (run (` ("lux text =" (~ sample0S) (~ sample0S))))
+ (and (|> (run (#synthesis.Extension "lux text =" (list sample0S sample0S)))
(case> (#e.Success valueV)
(:coerce Bit valueV)
_
#0))
- (|> (run (` ("lux text =" (~ sample0S) (~ sample1S))))
+ (|> (run (#synthesis.Extension "lux text =" (list sample0S sample1S)))
(case> (#e.Success valueV)
(not (:coerce Bit valueV))
_
#0))))
(test "Can compare texts for order."
- (|> (run (` ("lux text <" (~ sample1S) (~ sample0S))))
+ (|> (run (#synthesis.Extension "lux text <" (list sample1S sample0S)))
(case> (#e.Success valueV)
(:coerce Bit valueV)
_
#0)))
(test "Can get length of text."
- (|> (run (` ("lux text size" (~ sample0S))))
+ (|> (run (#synthesis.Extension "lux text size" (list sample0S)))
(case> (#e.Success valueV)
(n/= sample-size (:coerce Nat valueV))
_
#0)))
(test "Can concatenate text."
- (|> (run (` ("lux text size" (~ concatenatedS))))
+ (|> (run (#synthesis.Extension "lux text size" (list concatenatedS)))
(case> (#e.Success valueV)
- (n/= (n/* +2 sample-size) (:coerce Nat valueV))
+ (n/= (n/* 2 sample-size) (:coerce Nat valueV))
_
#0)))
(test "Can find index of sub-text."
- (and (|> (run (` ("lux text index" (~ concatenatedS) (~ sample0S) +0)))
+ (and (|> (run (#synthesis.Extension "lux text index"
+ (list concatenatedS sample0S
+ (synthesis.i64 0))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
- (n/= +0 valueV)
+ (n/= 0 valueV)
_
#0))
- (|> (run (` ("lux text index" (~ concatenatedS) (~ sample1S) +0)))
+ (|> (run (#synthesis.Extension "lux text index"
+ (list concatenatedS sample1S
+ (synthesis.i64 0))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
(n/= sample-size valueV)
_
#0))))
- (let [test-clip (function (_ from to expected)
- (|> (run (` ("lux text clip"
- (~ concatenatedS)
- (~ (code.nat from))
- (~ (code.nat to)))))
- (case> (^multi (#e.Success valueV)
- [(:coerce (Maybe Text) valueV) (#.Some valueV)])
- (text/= expected valueV)
-
- _
- #0)))]
+ (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
+ (function (_ from to expected)
+ (|> (run (#synthesis.Extension "lux text clip"
+ (list concatenatedS
+ (synthesis.i64 from)
+ (synthesis.i64 to))))
+ (case> (^multi (#e.Success valueV)
+ [(:coerce (Maybe Text) valueV) (#.Some valueV)])
+ (text/= expected valueV)
+
+ _
+ #0))))]
(test "Can clip text to extract sub-text."
- (and (test-clip +0 sample-size sample0)
- (test-clip sample-size (n/* +2 sample-size) sample1))))
+ (and (test-clip 0 sample-size sample0)
+ (test-clip sample-size (n/* 2 sample-size) sample1))))
(test "Can extract individual characters from text."
- (|> (run (` ("lux text char"
- (~ sample0S)
- (~ (code.nat char-idx)))))
+ (|> (run (#synthesis.Extension "lux text char"
+ (list sample0S
+ (synthesis.i64 char-idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Int) valueV) (#.Some valueV)])
(text.contains? ("lux int char" valueV)
@@ -278,14 +277,19 @@
(def: (array-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1))))
+ [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
idx (|> r.nat (:: @ map (n/% size)))
value r.nat
- #let [array0S (` ("lux array new" (~ (code.nat size))))
- array1S (` ("lux array put" (~ array0S) (~ (code.nat idx)) (~ (code.nat value))))]]
+ #let [array0S (#synthesis.Extension "lux array new"
+ (list (synthesis.i64 size)))
+ array1S (#synthesis.Extension "lux array put"
+ (list array0S
+ (synthesis.i64 idx)
+ (synthesis.i64 value)))]]
($_ seq
(test "Can get size of array."
- (|> (run (` ("lux array size" (~ array0S))))
+ (|> (run (#synthesis.Extension "lux array size"
+ (list array0S)))
(case> (#e.Success valueV)
(n/= size (:coerce Nat valueV))
@@ -293,14 +297,16 @@
(exec (log! error)
#0))))
(test "Can get element from array (if it exists)."
- (and (|> (run (` ("lux array get" (~ array0S) (~ (code.nat idx)))))
+ (and (|> (run (#synthesis.Extension "lux array get"
+ (list array0S (synthesis.i64 idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) #.None])
#1
_
#0))
- (|> (run (` ("lux array get" (~ array1S) (~ (code.nat idx)))))
+ (|> (run (#synthesis.Extension "lux array get"
+ (list array1S (synthesis.i64 idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) (#.Some valueV)])
(n/= value valueV)
@@ -308,10 +314,11 @@
_
#0))))
(test "Can remove element from array."
- (|> (run (` ("lux array get"
- ("lux array remove" (~ array1S)
- (~ (code.nat idx)))
- (~ (code.nat idx)))))
+ (|> (run (#synthesis.Extension "lux array get"
+ (list (#synthesis.Extension "lux array remove"
+ (list array1S
+ (synthesis.i64 idx)))
+ (synthesis.i64 idx))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Nat) valueV) #.None])
#1
@@ -328,7 +335,7 @@
(`` ($_ seq
(~~ (do-template [<name>]
[(test (format "Can apply '" <name> "' procedure.")
- (|> (run (` (<name> (~ (code.frac subject)))))
+ (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject))))
(case> (#e.Success valueV)
#1
@@ -348,7 +355,8 @@
["lux math floor"]))
(~~ (do-template [<name>]
[(test (format "Can apply '" <name> "' procedure.")
- (|> (run (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))
+ (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
+ (synthesis.f64 param))))
(case> (#e.Success valueV)
#1
@@ -362,10 +370,11 @@
(def: (io-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [message (r.text' alpha +5)]
+ [message (r.ascii/alpha 5)]
($_ seq
(test "Can log messages."
- (|> (run (` ("lux io log" (~ (code.text (format "LOG: " message))))))
+ (|> (run (#synthesis.Extension "lux io log"
+ (list (synthesis.text (format "LOG: " message)))))
(case> (#e.Success valueV)
#1
@@ -373,16 +382,24 @@
(exec (log! error)
#0))))
(test "Can throw runtime errors."
- (and (|> (run (` ("lux try" ("lux function" +1 []
- ("lux io error" (~ (code.text message)))))))
+ (and (|> (run (#synthesis.Extension "lux try"
+ (list (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (#synthesis.Extension "lux io error"
+ (list (synthesis.text message)))}))))
(case> (^multi (#e.Success valueV)
[(:coerce (e.Error Text) valueV) (#e.Error error)])
(text.contains? message error)
_
#0))
- (|> (run (` ("lux try" ("lux function" +1 []
- (~ (code.text message))))))
+ (|> (run (#synthesis.Extension "lux try"
+ (list (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (#synthesis.Extension "lux io error"
+ (list (synthesis.text message)))}))))
(case> (^multi (#e.Success valueV)
[(:coerce (e.Error Text) valueV) (#e.Success valueV)])
(text/= message valueV)
@@ -390,7 +407,8 @@
_
#0))))
(test "Can obtain current time in milli-seconds."
- (|> (run (` [("lux io current-time") ("lux io current-time")]))
+ (|> (run (synthesis.tuple (list (#synthesis.Extension "lux io current-time" (list))
+ (#synthesis.Extension "lux io current-time" (list)))))
(case> (#e.Success valueV)
(let [[pre post] (:coerce [Nat Nat] valueV)]
(n/>= pre post))
@@ -405,12 +423,12 @@
(do r.Monad<Random>
[pre r.nat
post (|> r.nat (r.filter (|>> (n/= pre) not)))
- #let [preS (code.nat pre)
- postS (code.nat post)
- atomS (` ("lux atom new" (~ preS)))]]
+ #let [preS (synthesis.i64 pre)
+ postS (synthesis.i64 post)
+ atomS (#synthesis.Extension "lux atom new" (list preS))]]
($_ seq
(test "Can read atoms."
- (|> (run (` ("lux atom read" (~ atomS))))
+ (|> (run (#synthesis.Extension "lux atom read" (list atomS)))
(case> (#e.Success valueV)
(n/= pre (:coerce Nat valueV))
@@ -418,10 +436,18 @@
(exec (log! error)
#0))))
(test "Can compare-and-swap atoms."
- (and (|> (run (` ("lux let" +0 (~ preS)
- ("lux let" +1 ("lux atom new" (0))
- [("lux atom compare-and-swap" (1) (0) (~ postS))
- ("lux atom read" (1))]))))
+ (and (|> (run (synthesis.branch/let
+ [preS 0
+ (synthesis.branch/let
+ [(#synthesis.Extension "lux atom new"
+ (list (synthesis.variable/local 0)))
+ 1
+ (synthesis.tuple
+ (list (#synthesis.Extension "lux atom compare-and-swap"
+ (list (synthesis.variable/local 1)
+ (synthesis.variable/local 0)
+ postS))
+ (#synthesis.Extension "lux atom read" (list (synthesis.variable/local 1)))))])]))
(case> (#e.Success valueV)
(let [[swapped? current-value] (:coerce [Bit Nat] valueV)]
(and swapped?
@@ -430,10 +456,18 @@
(#e.Error error)
(exec (log! error)
#0)))
- (|> (run (` ("lux let" +0 (~ preS)
- ("lux let" +1 ("lux atom new" (0))
- [("lux atom compare-and-swap" (1) (~ postS) (~ postS))
- ("lux atom read" (1))]))))
+ (|> (run (synthesis.branch/let
+ [preS 0
+ (synthesis.branch/let
+ [(#synthesis.Extension "lux atom new"
+ (list (synthesis.variable/local 0)))
+ 1
+ (synthesis.tuple
+ (list (#synthesis.Extension "lux atom compare-and-swap"
+ (list (synthesis.variable/local 1)
+ postS
+ postS))
+ (#synthesis.Extension "lux atom read" (list (synthesis.variable/local 1)))))])]))
(case> (#e.Success valueV)
(let [[swapped? current-value] (:coerce [Bit Nat] valueV)]
(and (not swapped?)
@@ -449,12 +483,13 @@
(do r.Monad<Random>
[pre r.nat
post (|> r.nat (r.filter (|>> (n/= pre) not)))
- #let [preS (code.nat pre)
- postS (code.nat post)
- boxS (` ("lux box new" (~ preS)))]]
+ #let [preS (synthesis.i64 pre)
+ postS (synthesis.i64 post)
+ boxS (#synthesis.Extension "lux box new"
+ (list preS))]]
($_ seq
(test "Can read boxes."
- (|> (run (` ("lux box read" (~ boxS))))
+ (|> (run (#synthesis.Extension "lux box read" (list boxS)))
(case> (#e.Success valueV)
(n/= pre (:coerce Nat valueV))
@@ -462,9 +497,15 @@
(exec (log! error)
#0))))
(test "Can write boxes."
- (|> (run (` ("lux let" +0 (~ boxS)
- ("lux let" +1 ("lux box write" (~ postS) (0))
- ("lux box read" (0))))))
+ (|> (run (synthesis.branch/let
+ [boxS
+ 0
+ (synthesis.branch/let
+ [(#synthesis.Extension "lux box write"
+ (list postS (synthesis.variable/local 0)))
+ 1
+ (#synthesis.Extension "lux box read"
+ (list (synthesis.variable/local 0)))])]))
(case> (#e.Success valueV)
(n/= post (:coerce Nat valueV))
@@ -477,21 +518,24 @@
(-> Runner Test)
($_ seq
(test "Can query the concurrency level of the machine."
- (|> (run (` ("lux process parallelism-level")))
+ (|> (run (#synthesis.Extension "lux process parallelism-level" (list)))
(case> (#e.Success valueV)
- (n/>= +1 (:coerce Nat valueV))
+ (n/>= 1 (:coerce Nat valueV))
(#e.Error error)
(exec (log! error)
#0))))
(do r.Monad<Random>
- [delay (|> r.nat (:: @ map (n/% +10)))
- message (r.text +5)]
+ [delay (|> r.nat (:: @ map (n/% 10)))
+ message (r.ascii/upper-alpha 5)]
(test "Can schedule I/O operations for future execution."
- (|> (run (` ("lux process schedule"
- (~ (code.nat delay))
- ("lux function" +1 []
- ("lux io log" (~ (code.text (format "SCHEDULE: " message))))))))
+ (|> (run (#synthesis.Extension "lux process schedule"
+ (list (synthesis.i64 delay)
+ (synthesis.function/abstraction
+ {#synthesis.environment (list)
+ #synthesis.arity 1
+ #synthesis.body (#synthesis.Extension "lux io log"
+ (list (synthesis.text (format "SCHEDULE: " message))))}))))
(case> (#e.Success valueV)
#1
@@ -504,8 +548,8 @@
(-> Runner Test)
($_ seq
(bit-spec run)
- (int-spec run)
- (frac-spec run)
+ (i64-spec run)
+ (f64-spec run)
(text-spec run)
(array-spec run)
(math-spec run)
@@ -516,37 +560,37 @@
))
(context: "[JVM] Common procedures."
- (<| (times +100)
- (all-specs run-jvm)))
+ (<| (times 100)
+ (all-specs common.run-jvm)))
## (context: "[JS] Common procedures."
-## (<| (times +100)
-## (all-specs run-js)))
+## (<| (times 100)
+## (all-specs common.run-js)))
## (context: "[Lua] Common procedures."
-## (<| (times +100)
-## (all-specs run-lua)))
+## (<| (times 100)
+## (all-specs common.run-lua)))
## (context: "[Ruby] Common procedures."
-## (<| (times +100)
-## (all-specs run-ruby)))
+## (<| (times 100)
+## (all-specs common.run-ruby)))
## (context: "[Python] Common procedures."
-## (<| (times +100)
-## (all-specs run-python)))
+## (<| (times 100)
+## (all-specs common.run-python)))
## (context: "[R] Common procedures."
-## (<| (times +100)
-## (all-specs run-r)))
+## (<| (times 100)
+## (all-specs common.run-r)))
## (context: "[Scheme] Common procedures."
-## (<| (times +100)
-## (all-specs run-scheme)))
+## (<| (times 100)
+## (all-specs common.run-scheme)))
## (context: "[Common Lisp] Common procedures."
-## (<| (times +100)
-## (all-specs run-common-lisp)))
+## (<| (times 100)
+## (all-specs common.run-common-lisp)))
## (context: "[PHP] Common procedures."
-## (<| (times +100)
-## (all-specs run-php)))
+## (<| (times 100)
+## (all-specs common.run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux
index 4aaed8124..a10e98ae6 100644
--- a/new-luxc/test/test/luxc/lang/translation/reference.lux
+++ b/new-luxc/test/test/luxc/lang/translation/reference.lux
@@ -1,61 +1,48 @@
(.module:
- lux
- (lux (control [monad #+ do]
- pipe)
- (data ["e" error]
- [text])
- (lang ["//." synthesis])
- ["r" math/random]
- test)
- (luxc (lang (translation (jvm [".T_jvm" statement])
- ## (js [".T_js" statement])
- ## (lua [".T_lua" statement])
- ## (ruby [".T_ruby" statement])
- ## (python [".T_python" statement])
- ## (r [".T_r" statement])
- ## (scheme [".T_scheme" statement])
- ## (common-lisp [".T_common-lisp" statement])
- ## (php [".T_php" statement])
- )))
- (test/luxc common))
+ [lux #*
+ [control
+ [monad (#+ do)]
+ pipe]
+ [data
+ ["e" error]
+ ["." text]]
+ [compiler
+ [default
+ ["." reference]
+ [phase
+ ["." synthesis]]]]
+ [math
+ ["r" random]]
+ test]
+ [test
+ [luxc
+ ["." common (#+ Runner Definer)]]]
+ [//
+ ["&" function]])
(def: name-part
(r.Random Text)
- (|> (r.ascii +5)
- (r.filter (function (_ sample)
- (not (or (text.contains? "/" sample)
- (text.contains? "[" sample)
- (text.contains? "]" sample)))))))
+ (r.ascii/alpha 5))
(def: (definitions-spec define)
(-> Definer Test)
(do r.Monad<Random>
- [def-name (r.seq name-part name-part)
- def-value r.int]
+ [name (r.and name-part name-part)
+ value r.frac]
(test "Can refer to definitions."
- (|> (define def-name (//synthesis.i64 def-value))
- (case> (#e.Success valueT)
- (i/= def-value (:coerce Int valueT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))))
+ (|> (define name (synthesis.f64 value))
+ (&.check value)))))
(def: (variables-spec run)
(-> Runner Test)
(do r.Monad<Random>
- [register (|> r.nat (:: @ map (n/% +100)))
- value r.int]
+ [register (|> r.nat (:: @ map (n/% 100)))
+ value r.frac]
(test "Can refer to local variables/registers."
- (|> (run (//synthesis.branch/let [(//synthesis.i64 value)
- register
- (//synthesis.variable/local register)]))
- (case> (#e.Success outputT)
- (i/= value (:coerce Int outputT))
-
- (#e.Error error)
- (exec (log! error)
- #0))))))
+ (|> (run (synthesis.branch/let [(synthesis.f64 value)
+ register
+ (synthesis.variable/local register)]))
+ (&.check value)))))
(def: (references-spec run define)
(-> Runner Definer Test)
@@ -63,37 +50,37 @@
(variables-spec run)))
(context: "[JVM] References."
- (<| (times +100)
- (references-spec run-jvm def-jvm)))
+ (<| (times 100)
+ (references-spec common.run-jvm common.def-jvm)))
## (context: "[JS] References."
-## (<| (times +100)
-## (references-spec run-js def-js)))
+## (<| (times 100)
+## (references-spec common.run-js common.def-js)))
## (context: "[Lua] References."
-## (<| (times +100)
-## (references-spec run-lua def-lua)))
+## (<| (times 100)
+## (references-spec common.run-lua common.def-lua)))
## (context: "[Ruby] References."
-## (<| (times +100)
-## (references-spec run-ruby def-ruby)))
+## (<| (times 100)
+## (references-spec common.run-ruby common.def-ruby)))
## (context: "[Python] References."
-## (<| (times +100)
-## (references-spec run-python def-python)))
+## (<| (times 100)
+## (references-spec common.run-python common.def-python)))
## (context: "[R] References."
-## (<| (times +100)
-## (references-spec run-r def-r)))
+## (<| (times 100)
+## (references-spec common.run-r common.def-r)))
## (context: "[Scheme] References."
-## (<| (times +100)
-## (references-spec run-scheme def-scheme)))
+## (<| (times 100)
+## (references-spec common.run-scheme common.def-scheme)))
## (context: "[Common Lisp] References."
-## (<| (times +100)
-## (references-spec run-common-lisp def-common-lisp)))
+## (<| (times 100)
+## (references-spec common.run-common-lisp common.def-common-lisp)))
## (context: "[PHP] References."
-## (<| (times +100)
-## (references-spec run-php def-php)))
+## (<| (times 100)
+## (references-spec common.run-php common.def-php)))
diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux
index 99111d2a7..2ee018be4 100644
--- a/stdlib/source/lux/compiler/default/phase/synthesis.lux
+++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux
@@ -32,7 +32,7 @@
(type: #export Primitive
(#Bit Bit)
- (#I64 I64)
+ (#I64 (I64 Any))
(#F64 Frac)
(#Text Text))
@@ -151,6 +151,7 @@
[(template: #export (<name> content)
(<tag> content))]
+ [path/bind #..Bind]
[path/alt #..Alt]
[path/seq #..Seq]
[path/then #..Then]
diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux
index e79645e63..d8a58ca84 100644
--- a/stdlib/source/lux/compiler/default/phase/translation.lux
+++ b/stdlib/source/lux/compiler/default/phase/translation.lux
@@ -56,7 +56,9 @@
(: (-> Text expression (Error Any))
evaluate!)
(: (-> Text statement (Error Any))
- execute!))
+ execute!)
+ (: (-> Name expression (Error Any))
+ define!))
(type: #export (Buffer statement) (Row [Name statement]))
@@ -194,6 +196,17 @@
[execute! statement]
)
+(def: #export (define! name code)
+ (All [anchor expression statement]
+ (-> Name expression (Operation anchor expression statement Any)))
+ (function (_ (^@ stateE [bundle state]))
+ (case (:: (get@ #host state) define! name code)
+ (#error.Error error)
+ (ex.throw cannot-interpret error)
+
+ (#error.Success output)
+ (#error.Success [stateE output]))))
+
(def: #export (save! name code)
(All [anchor expression statement]
(-> Name statement (Operation anchor expression statement Any)))
diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux
index ebd54c02b..4cc1f66bc 100644
--- a/stdlib/source/lux/data/text/unicode.lux
+++ b/stdlib/source/lux/data/text/unicode.lux
@@ -59,6 +59,7 @@
(do-template [<name> <start> <end>]
[(def: #export <name> Segment (..segment (hex <start>) (hex <end>)))]
+ ## Normal segments
[basic-latin "0000" "007F"]
[latin-1-supplement "00A0" "00FF"]
[latin-extended-a "0100" "017F"]
@@ -181,6 +182,10 @@
[cjk-unified-ideographs-extension-b "20000" "2A6DF"]
[cjk-compatibility-ideographs-supplement "2F800" "2FA1F"]
[tags "E0000" "E007F"]
+
+ ## Specialized segments
+ [basic-latin/upper-alpha "0041" "005A"]
+ [basic-latin/lower-alpha "0061" "007A"]
)
(type: #export Set (Tree Segment []))
@@ -342,6 +347,11 @@
Set
(finger.branch (set half/0) (set half/1)))
-(def: #export ascii
- Set
- (set (list basic-latin)))
+(do-template [<name> <segments>]
+ [(def: #export <name> Set (set <segments>))]
+
+ [ascii (list basic-latin)]
+ [ascii/alpha (list basic-latin/upper-alpha basic-latin/lower-alpha)]
+ [ascii/upper-alpha (list basic-latin/upper-alpha)]
+ [ascii/lower-alpha (list basic-latin/lower-alpha)]
+ )
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index e441fc0f2..826846aac 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -99,17 +99,15 @@
(i64.left-shift 32)
("lux i64 +" right))])))
-(def: #export nat
- (Random Nat)
- (:: Monad<Random> map .nat ..i64))
-
-(def: #export int
- (Random Int)
- (:: Monad<Random> map .int ..i64))
+(do-template [<name> <type> <cast>]
+ [(def: #export <name>
+ (Random <type>)
+ (:: Monad<Random> map <cast> ..i64))]
-(def: #export rev
- (Random Rev)
- (:: Monad<Random> map .rev ..i64))
+ [nat Nat .nat]
+ [int Int .int]
+ [rev Rev .rev]
+ )
(def: #export frac
(Random Frac)
@@ -143,8 +141,11 @@
(-> Nat (Random Text))
(text (char <set>)))]
- [unicode unicode.full]
- [ascii unicode.ascii]
+ [unicode unicode.full]
+ [ascii unicode.ascii]
+ [ascii/alpha unicode.ascii/alpha]
+ [ascii/upper-alpha unicode.ascii/upper-alpha]
+ [ascii/lower-alpha unicode.ascii/lower-alpha]
)
(do-template [<name> <type> <ctor> <gen>]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:28:31 +0000