aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc')
-rw-r--r--new-luxc/source/luxc/base.lux2
-rw-r--r--new-luxc/source/luxc/host.jvm.lux44
-rw-r--r--new-luxc/source/luxc/host/jvm/def.lux3
-rw-r--r--new-luxc/source/luxc/lang/analysis/procedure/common.lux2
-rw-r--r--new-luxc/source/luxc/lang/synthesis/case.lux22
-rw-r--r--new-luxc/source/luxc/lang/synthesis/expression.lux44
-rw-r--r--new-luxc/source/luxc/lang/translation/case.jvm.lux1
-rw-r--r--new-luxc/source/luxc/lang/translation/common.jvm.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/function.jvm.lux89
-rw-r--r--new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux27
-rw-r--r--new-luxc/source/luxc/lang/translation/reference.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/variable.lux4
-rw-r--r--new-luxc/test/test/luxc/lang/analysis/procedure/common.lux4
-rw-r--r--new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux114
14 files changed, 237 insertions, 129 deletions
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index 7418f8124..580f5593f 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -229,5 +229,5 @@
(loop [idx (n.dec (text;size name))
output ""]
(if (n.= underflow idx)
- (text;replace-all "/+" "$" output)
+ output
(recur (n.dec idx) (format (|> (text;nth idx name) maybe;assume normalize-char) output)))))
diff --git a/new-luxc/source/luxc/host.jvm.lux b/new-luxc/source/luxc/host.jvm.lux
index b2bf07d32..e8dc4e17a 100644
--- a/new-luxc/source/luxc/host.jvm.lux
+++ b/new-luxc/source/luxc/host.jvm.lux
@@ -1,6 +1,7 @@
(;module:
lux
(lux (control [monad #+ do]
+ ["ex" exception #+ exception:]
pipe)
(concurrency ["A" atom])
(data ["e" error]
@@ -12,7 +13,10 @@
[host #+ do-to object]
[io])
(luxc ["&" base]
- (lang (translation [";T" common]))))
+ (lang [";L" variable #+ Register]
+ (translation [";T" common]))))
+
+(host;import org.objectweb.asm.Label)
(host;import java.lang.reflect.AccessibleObject
(setAccessible [boolean] void))
@@ -85,14 +89,46 @@
{#commonT;loader (memory-class-loader store)
#commonT;store store
#commonT;artifacts (dict;new text;Hash<Text>)
- #commonT;context ["" +0]})))
+ #commonT;context ["" +0]
+ #commonT;anchor #;None})))
+
+(def: #export (with-anchor anchor expr)
+ (All [a] (-> [Label Register] (Meta a) (Meta a)))
+ (;function [compiler]
+ (let [old (:! commonT;Host (get@ #;host compiler))]
+ (case (expr (set@ #;host
+ (:! Void (set@ #commonT;anchor (#;Some anchor) old))
+ compiler))
+ (#e;Success [compiler' output])
+ (#e;Success [(update@ #;host
+ (|>. (:! commonT;Host)
+ (set@ #commonT;anchor (get@ #commonT;anchor old))
+ (:! Void))
+ compiler')
+ output])
+
+ (#e;Error error)
+ (#e;Error error)))))
+
+(exception: #export No-Anchor)
+
+(def: #export anchor
+ (Meta [Label Register])
+ (;function [compiler]
+ (case (|> compiler (get@ #;host) (:! commonT;Host) (get@ #commonT;anchor))
+ (#;Some anchor)
+ (#e;Success [compiler
+ anchor])
+
+ #;None
+ ((&;throw No-Anchor "") compiler))))
(def: #export (with-context name expr)
(All [a] (-> Text (Meta a) (Meta a)))
(;function [compiler]
(let [old (:! commonT;Host (get@ #;host compiler))]
(case (expr (set@ #;host
- (:! Void (set@ #commonT;context [name +0] old))
+ (:! Void (set@ #commonT;context [(&;normalize-name name) +0] old))
compiler))
(#e;Success [compiler' output])
(#e;Success [(update@ #;host
@@ -110,7 +146,7 @@
(;function [compiler]
(let [old (:! commonT;Host (get@ #;host compiler))
[old-name old-sub] (get@ #commonT;context old)
- new-name (format old-name "/" (%n old-sub))]
+ new-name (format old-name "$" (%i (nat-to-int old-sub)))]
(case (expr (set@ #;host
(:! Void (set@ #commonT;context [new-name +0] old))
compiler))
diff --git a/new-luxc/source/luxc/host/jvm/def.lux b/new-luxc/source/luxc/host/jvm/def.lux
index 1d50ba9f6..60009fb5c 100644
--- a/new-luxc/source/luxc/host/jvm/def.lux
+++ b/new-luxc/source/luxc/host/jvm/def.lux
@@ -150,7 +150,8 @@
Int
($_ i.+
ClassWriter.COMPUTE_MAXS
- ClassWriter.COMPUTE_FRAMES))
+ ## ClassWriter.COMPUTE_FRAMES
+ ))
(do-template [<name> <flag>]
[(def: #export (<name> version visibility config name parameters super interfaces
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
index f3c296b2b..c8e3e3b38 100644
--- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux
@@ -277,7 +277,7 @@
(|> (dict;new text;Hash<Text>)
(install "=" (binary Text Text Bool))
(install "<" (binary Text Text Bool))
- (install "prepend" (binary Text Text Text))
+ (install "concat" (binary Text Text Text))
(install "index" (trinary Text Text Nat (type (Maybe Nat))))
(install "size" (unary Text Nat))
(install "hash" (unary Text Nat))
diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux
index 8bc1e43f9..e230e2799 100644
--- a/new-luxc/source/luxc/lang/synthesis/case.lux
+++ b/new-luxc/source/luxc/lang/synthesis/case.lux
@@ -6,8 +6,10 @@
[number]
(coll [list "list/" Fold<List>]))
(meta [code "code/" Eq<Code>]))
- (luxc (lang ["la" analysis]
- ["ls" synthesis])))
+ (luxc (lang [";L" variable #+ Variable]
+ ["la" analysis]
+ ["ls" synthesis]
+ (synthesis [";S" function]))))
(def: #export (path outer-arity pattern)
(-> ls;Arity la;Pattern ls;Path)
@@ -44,8 +46,8 @@
(^code ("lux case bind" (~ [_ (#;Nat register)])))
(` ("lux case seq"
- ("lux case bind" (~ (if (n.> +1 outer-arity)
- (code;nat (n.+ (n.dec outer-arity) register))
+ ("lux case bind" (~ (if (functionS;nested? outer-arity)
+ (code;nat (|> register variableL;local (functionS;adjust-var outer-arity) variableL;local-register))
(code;nat register))))
("lux case pop")))
@@ -69,16 +71,16 @@
["lux case variant left"]
["lux case variant right"])
- (^ [[_ (#;Form (list [_ (#;Text "lux case seq")] left-pre left-post))]
- [_ (#;Form (list [_ (#;Text "lux case seq")] right-pre right-post))]])
- (case (weave left-pre right-pre)
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] _ _))])
+ (^ [(^code ("lux case seq" (~ preL) (~ postL)))
+ (^code ("lux case seq" (~ preR) (~ postR)))])
+ (case (weave preL preR)
+ (^code ("lux case alt" (~ thenP) (~ elseP)))
<default>
weavedP
- (` ("lux case seq" (~ weavedP) (~ (weave left-post right-post)))))
+ (` ("lux case seq" (~ weavedP) (~ (weave postL postR)))))
_
(if (code/= leftP rightP)
- leftP
+ rightP
<default>))))
diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux
index 9ea397576..f761fb57c 100644
--- a/new-luxc/source/luxc/lang/synthesis/expression.lux
+++ b/new-luxc/source/luxc/lang/synthesis/expression.lux
@@ -23,7 +23,7 @@
(def: init-resolver (Dict Int Int) (dict;new number;Hash<Int>))
(def: (prepare-body inner-arity arity body)
- (-> Nat Nat ls;Synthesis ls;Synthesis)
+ (-> ls;Arity ls;Arity ls;Synthesis ls;Synthesis)
(if (functionS;nested? inner-arity)
body
(loopS;reify-recursion arity body)))
@@ -73,7 +73,11 @@
inputS
(^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA]))
- (let$ register inputS (synthesize bodyA))
+ (let$ (if (functionS;nested? outer-arity)
+ (|> register variableL;local (functionS;adjust-var outer-arity) variableL;local-register)
+ register)
+ inputS
+ (synthesize bodyA))
(^or (^ (list [(^code true) thenA] [(^code false) elseA]))
(^ (list [(^code false) elseA] [(^code true) thenA])))
@@ -121,16 +125,17 @@
(-> la;Analysis ls;Synthesis)
(loop [outer-arity +0
resolver init-resolver
+ direct? false
num-locals +0
expressionA expressionA]
(case expressionA
(^code [(~ _left) (~ _right)])
- (` [(~@ (list/map (recur outer-arity resolver num-locals) (la;unfold-tuple expressionA)))])
+ (` [(~@ (list/map (recur outer-arity resolver false num-locals) (la;unfold-tuple expressionA)))])
(^or (^code ("lux sum left" (~ _)))
(^code ("lux sum right" (~ _))))
(let [[tag last? value] (maybe;assume (la;unfold-variant expressionA))]
- (variant$ tag last? (recur outer-arity resolver num-locals value)))
+ (variant$ tag last? (recur outer-arity resolver false num-locals value)))
(^code ((~ [_ (#;Int var)])))
(if (variableL;local? var)
@@ -143,17 +148,34 @@
(var$ (maybe;default var (dict;get var resolver))))
(^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)])))
- (synthesize-case (recur outer-arity resolver num-locals) outer-arity inputA branchesA)
+ (synthesize-case (recur outer-arity resolver false num-locals) outer-arity inputA branchesA)
(^multi (^code ("lux function" [(~@ scope)] (~ bodyA)))
[(s;run scope (p;some s;int)) (#e;Success raw-env)])
- (let [inner-arity (n.inc outer-arity)
- env (list/map (function [var] (maybe;default var (dict;get var resolver))) raw-env)
+ (let [inner-arity (if direct?
+ (n.inc outer-arity)
+ +1)
+ env (list/map (function [closure]
+ (case (dict;get closure resolver)
+ (#;Some resolved)
+ (if (and (variableL;local? resolved)
+ (functionS;nested? outer-arity)
+ (|> resolved variableL;local-register (n.>= outer-arity)))
+ (functionS;adjust-var outer-arity resolved)
+ resolved)
+
+ #;None
+ (if (and (variableL;local? closure)
+ (functionS;nested? outer-arity))
+ (functionS;adjust-var outer-arity closure)
+ closure)))
+ raw-env)
env-vars (: (List Variable)
(case raw-env
#;Nil (list)
_ (|> (list;size raw-env) n.dec (list;n.range +0) (list/map variableL;captured))))
- resolver' (if (functionS;nested? inner-arity)
+ resolver' (if (and (functionS;nested? inner-arity)
+ direct?)
(list/fold (function [[from to] resolver']
(dict;put from to resolver'))
init-resolver
@@ -162,7 +184,7 @@
(dict;put var var resolver'))
init-resolver
env-vars))]
- (case (recur inner-arity resolver' num-locals bodyA)
+ (case (recur inner-arity resolver' true num-locals bodyA)
(^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat arity')] env' bodyS'))])
(let [arity (n.inc arity')]
(function$ arity env (prepare-body inner-arity arity bodyS')))
@@ -171,10 +193,10 @@
(function$ +1 env (prepare-body inner-arity +1 bodyS))))
(^code ("lux apply" (~@ _)))
- (synthesize-apply (recur outer-arity resolver num-locals) outer-arity num-locals expressionA)
+ (synthesize-apply (recur outer-arity resolver false num-locals) outer-arity num-locals expressionA)
(^code ((~ [_ (#;Text name)]) (~@ args)))
- (procedure$ name (list/map (recur outer-arity resolver num-locals) args))
+ (procedure$ name (list/map (recur outer-arity resolver false num-locals) args))
_
expressionA)))
diff --git a/new-luxc/source/luxc/lang/translation/case.jvm.lux b/new-luxc/source/luxc/lang/translation/case.jvm.lux
index 3e05ba334..7821db70d 100644
--- a/new-luxc/source/luxc/lang/translation/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/case.jvm.lux
@@ -204,6 +204,7 @@
(<| $i;with-label (function [@else])
$i;with-label (function [@end])
(|>. testI
+ ($i;unwrap #$;Boolean)
($i;IFEQ @else)
thenI
($i;GOTO @end)
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index f9825614a..baafc233a 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -9,7 +9,8 @@
(coll [dict #+ Dict]))
[host]
(world [blob #+ Blob]))
- (luxc (host ["$" jvm]
+ (luxc (lang [";L" variable #+ Register])
+ (host ["$" jvm]
(jvm ["$t" type]
["$d" def]
["$i" inst]))))
@@ -17,6 +18,8 @@
(host;import org.objectweb.asm.Opcodes
(#static V1_6 int))
+(host;import org.objectweb.asm.Label)
+
(host;import java.lang.Object)
(host;import (java.lang.Class a))
@@ -34,7 +37,8 @@
{#loader ClassLoader
#store Class-Store
#artifacts Artifacts
- #context [Text Nat]})
+ #context [Text Nat]
+ #anchor (Maybe [Label Register])})
(exception: Unknown-Class)
(exception: Class-Already-Stored)
diff --git a/new-luxc/source/luxc/lang/translation/function.jvm.lux b/new-luxc/source/luxc/lang/translation/function.jvm.lux
index eceaecd9d..bbf295d18 100644
--- a/new-luxc/source/luxc/lang/translation/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/function.jvm.lux
@@ -267,42 +267,42 @@
$i;ARETURN
))))
-(def: #export (with-function class env arity bodyI)
- (-> Text (List Variable) ls;Arity $;Inst
- (Meta [$;Def $;Inst]))
- (do meta;Monad<Meta>
- [@begin $i;make-label
- #let [env-size (list;size env)
- applyD (: $;Def
- (if (poly-arg? arity)
- (|> (n.min arity runtimeT;num-apply-variants)
- (list;n.range +1)
- (list/map (with-apply class env arity @begin bodyI))
- (list& (with-implementation arity @begin bodyI))
- $d;fuse)
- ($d;method #$;Public $;strictM runtimeT;apply-method (runtimeT;apply-signature +1)
- (|>. ($i;label @begin)
- bodyI
- $i;ARETURN))))
- functionD (: $;Def
- (|>. ($d;int-field #$;Public ($_ $;++F $;staticF $;finalF) arity-field (nat-to-int arity))
- (with-captured env)
- (with-partial arity)
- (with-init class env arity)
- (with-reset class arity env)
- applyD))
- instanceI (instance class arity env)]]
- (wrap [functionD instanceI])))
-
-(def: #export (translate-function translate env arity body)
+(def: #export (with-function @begin class env arity bodyI)
+ (-> $;Label Text (List Variable) ls;Arity $;Inst
+ [$;Def $;Inst])
+ (let [env-size (list;size env)
+ applyD (: $;Def
+ (if (poly-arg? arity)
+ (|> (n.min arity runtimeT;num-apply-variants)
+ (list;n.range +1)
+ (list/map (with-apply class env arity @begin bodyI))
+ (list& (with-implementation arity @begin bodyI))
+ $d;fuse)
+ ($d;method #$;Public $;strictM runtimeT;apply-method (runtimeT;apply-signature +1)
+ (|>. ($i;label @begin)
+ bodyI
+ $i;ARETURN))))
+ functionD (: $;Def
+ (|>. ($d;int-field #$;Public ($_ $;++F $;staticF $;finalF) arity-field (nat-to-int arity))
+ (with-captured env)
+ (with-partial arity)
+ (with-init class env arity)
+ (with-reset class arity env)
+ applyD
+ ))
+ instanceI (instance class arity env)]
+ [functionD instanceI]))
+
+(def: #export (translate-function translate env arity bodyS)
(-> (-> ls;Synthesis (Meta $;Inst))
(List Variable) ls;Arity ls;Synthesis
(Meta $;Inst))
(do meta;Monad<Meta>
- [[context bodyI] (hostL;with-sub-context
- (translate body))
- #let [function-class (&;normalize-name context)]
- [functionD instanceI] (with-function function-class env arity bodyI)
+ [@begin $i;make-label
+ [function-class bodyI] (hostL;with-sub-context
+ (hostL;with-anchor [@begin +1]
+ (translate bodyS)))
+ #let [[functionD instanceI] (with-function @begin function-class env arity bodyI)]
_ (commonT;store-class function-class
($d;class #$;V1.6 #$;Public $;finalC
function-class (list)
@@ -332,3 +332,28 @@
$i;fuse)]]
(wrap (|>. functionI
applyI))))
+
+(def: #export (translate-recur translate argsS)
+ (-> (-> ls;Synthesis (Meta $;Inst))
+ (List ls;Synthesis)
+ (Meta $;Inst))
+ (do meta;Monad<Meta>
+ [[@begin offset] hostL;anchor
+ argsI (monad;map @ (function [[register argS]]
+ (let [register' (n.+ offset register)]
+ (: (Meta $;Inst)
+ (case argS
+ (^multi (^code ((~ [_ (#;Int var)])))
+ (i.= (variableL;local register')
+ var))
+ (wrap id)
+
+ _
+ (do @
+ [argI (translate argS)]
+ (wrap (|>. argI
+ ($i;ASTORE register'))))))))
+ (list;zip2 (list;n.range +0 (n.dec (list;size argsS)))
+ argsS))]
+ (wrap (|>. ($i;fuse argsI)
+ ($i;GOTO @begin)))))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
index 7c049a99f..77ce7f6fa 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux
@@ -18,7 +18,8 @@
(lang ["la" analysis]
["ls" synthesis]
(translation [";T" runtime]
- [";T" case]))))
+ [";T" case]
+ [";T" function]))))
(host;import java.lang.Long
(#static MIN_VALUE Long)
@@ -32,11 +33,11 @@
(#static NEGATIVE_INFINITY Double))
## [Types]
-(type: #export Generator
+(type: #export Translator
(-> ls;Synthesis (Meta $;Inst)))
(type: #export Proc
- (-> Generator (List ls;Synthesis) (Meta $;Inst)))
+ (-> Translator (List ls;Synthesis) (Meta $;Inst)))
(type: #export Bundle
(Dict Text Proc))
@@ -48,6 +49,7 @@
(type: #export Unary (-> (Vector +1 $;Inst) $;Inst))
(type: #export Binary (-> (Vector +2 $;Inst) $;Inst))
(type: #export Trinary (-> (Vector +3 $;Inst) $;Inst))
+(type: #export Variadic (-> (List $;Inst) $;Inst))
## [Utils]
(def: $Object $;Type ($t;class "java.lang.Object" (list)))
@@ -100,6 +102,14 @@
(arity: binary +2)
(arity: trinary +3)
+(def: #export (variadic proc)
+ (-> Variadic (-> Text Proc))
+ (function [proc-name]
+ (function [translate inputsS]
+ (do meta;Monad<Meta>
+ [inputsI (monad;map @ translate inputsS)]
+ (wrap (proc inputsI))))))
+
## [Instructions]
(def: lux-intI $;Inst (|>. $i;I2L ($i;wrap #$;Long)))
(def: jvm-intI $;Inst (|>. ($i;unwrap #$;Long) $i;L2I))
@@ -150,6 +160,12 @@
Unary
valueI)
+(def: lux//recur
+ (-> Text Proc)
+ (function [proc-name]
+ (function [translate inputsS]
+ (functionT;translate-recur translate inputsS))))
+
## [[Bits]]
(do-template [<name> <op>]
[(def: (<name> [inputI maskI])
@@ -363,7 +379,7 @@
[text//lt ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
($i;INVOKEVIRTUAL "java.lang.String" "compareTo" ($t;method (list $String) (#;Some $t;int) (list)) false)
(predicateI $i;IF_ICMPEQ)]
- [text//append ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
+ [text//concat ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false)
id]
[text//contains? ($i;CHECKCAST "java.lang.String") ($i;CHECKCAST "java.lang.String")
@@ -544,6 +560,7 @@
(install "is" (binary lux//is))
(install "try" (unary lux//try))
(install "if" (trinary lux//if))
+ (install "recur" lux//recur)
))
(def: bit-procs
@@ -630,7 +647,7 @@
(|> (dict;new text;Hash<Text>)
(install "text =" (binary text//eq))
(install "text <" (binary text//lt))
- (install "text append" (binary text//append))
+ (install "text concat" (binary text//concat))
(install "text index" (trinary text//index))
(install "text size" (unary text//size))
(install "text hash" (unary text//hash))
diff --git a/new-luxc/source/luxc/lang/translation/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
index c9243cae3..3e835f8e1 100644
--- a/new-luxc/source/luxc/lang/translation/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/reference.jvm.lux
@@ -19,7 +19,7 @@
(do meta;Monad<Meta>
[function-class hostL;context]
(wrap (|>. ($i;ALOAD +0)
- ($i;GETFIELD (&;normalize-name function-class)
+ ($i;GETFIELD function-class
(|> variable i.inc (i.* -1) int-to-nat functionT;captured)
commonT;$Object)))))
diff --git a/new-luxc/source/luxc/lang/variable.lux b/new-luxc/source/luxc/lang/variable.lux
index c04269e63..f766ffdcf 100644
--- a/new-luxc/source/luxc/lang/variable.lux
+++ b/new-luxc/source/luxc/lang/variable.lux
@@ -6,11 +6,11 @@
(def: #export Register Nat)
(def: #export (captured register)
- (-> Nat Variable)
+ (-> Register Variable)
(|> register n.inc nat-to-int (i.* -1)))
(def: #export (local register)
- (-> Nat Variable)
+ (-> Register Variable)
(nat-to-int register))
(def: #export (local-register variable)
diff --git a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
index 134421732..b992ca2d6 100644
--- a/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
+++ b/new-luxc/test/test/luxc/lang/analysis/procedure/common.lux
@@ -230,8 +230,8 @@
(check-success+ "lux text =" (list subjectC paramC) Bool))
(test "Compare texts in lexicographical order."
(check-success+ "lux text <" (list subjectC paramC) Bool))
- (test "Can prepend one text to another."
- (check-success+ "lux text prepend" (list subjectC paramC) Text))
+ (test "Can concatenate one text to another."
+ (check-success+ "lux text concat" (list subjectC paramC) Text))
(test "Can find the index of a piece of text inside a larger one that (may) contain it."
(check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat))))
(test "Can query the size/length of a text."
diff --git a/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux
index e15627851..38036e420 100644
--- a/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux
+++ b/new-luxc/test/test/luxc/lang/translation/procedure/common.jvm.lux
@@ -41,16 +41,16 @@
_
false)))]
- ["bit and" bit;and]
- ["bit or" bit;or]
- ["bit xor" bit;xor]
- ["bit shift-left" bit;shift-left]
- ["bit unsigned-shift-right" bit;shift-right]
+ ["lux bit and" bit;and]
+ ["lux bit or" bit;or]
+ ["lux bit xor" bit;xor]
+ ["lux bit shift-left" bit;shift-left]
+ ["lux bit unsigned-shift-right" bit;shift-right]
)]
($_ seq
(test "bit count"
(|> (do meta;Monad<Meta>
- [sampleI (expressionT;translate (` ("bit count" (~ (code;nat subject)))))]
+ [sampleI (expressionT;translate (` ("lux bit count" (~ (code;nat subject)))))]
(@eval;eval sampleI))
(meta;run (init-compiler []))
(case> (#e;Success valueT)
@@ -62,7 +62,7 @@
<binary>
(test "bit shift-right"
(|> (do meta;Monad<Meta>
- [sampleI (expressionT;translate (` ("bit shift-right"
+ [sampleI (expressionT;translate (` ("lux bit shift-right"
(~ (code;int (nat-to-int subject)))
(~ (code;nat param)))))]
(@eval;eval sampleI))
@@ -93,8 +93,8 @@
_
false)))]
- ["nat min" nat/bottom]
- ["nat max" nat/top]
+ ["lux nat min" nat/bottom]
+ ["lux nat max" nat/top]
))
(~~ (do-template [<name> <type> <prepare> <comp>]
[(test <name>
@@ -108,8 +108,8 @@
_
false)))]
- ["nat to-int" Int nat-to-int i.=]
- ["nat to-char" Text text;from-code text/=]
+ ["lux nat to-int" Int nat-to-int i.=]
+ ["lux nat to-char" Text text;from-code text/=]
))
(~~ (do-template [<name> <reference> <outputT> <comp>]
[(test <name>
@@ -124,13 +124,13 @@
_
false)))]
- ["nat +" n.+ Nat n.=]
- ["nat -" n.- Nat n.=]
- ["nat *" n.* Nat n.=]
- ["nat /" n./ Nat n.=]
- ["nat %" n.% Nat n.=]
- ["nat =" n.= Bool bool/=]
- ["nat <" n.< Bool bool/=]
+ ["lux nat +" n.+ Nat n.=]
+ ["lux nat -" n.- Nat n.=]
+ ["lux nat *" n.* Nat n.=]
+ ["lux nat /" n./ Nat n.=]
+ ["lux nat %" n.% Nat n.=]
+ ["lux nat =" n.= Bool bool/=]
+ ["lux nat <" n.< Bool bool/=]
))
)))))
@@ -151,8 +151,8 @@
_
false)))]
- ["int min" int/bottom]
- ["int max" int/top]
+ ["lux int min" int/bottom]
+ ["lux int max" int/top]
)
<unary> (do-template [<name> <type> <prepare> <comp>]
[(test <name>
@@ -166,8 +166,8 @@
_
false)))]
- ["int to-nat" Nat int-to-nat n.=]
- ["int to-frac" Frac int-to-frac f.=]
+ ["lux int to-nat" Nat int-to-nat n.=]
+ ["lux int to-frac" Frac int-to-frac f.=]
)
<binary> (do-template [<name> <reference> <outputT> <comp>]
[(test <name>
@@ -182,13 +182,13 @@
_
false)))]
- ["int +" i.+ Int i.=]
- ["int -" i.- Int i.=]
- ["int *" i.* Int i.=]
- ["int /" i./ Int i.=]
- ["int %" i.% Int i.=]
- ["int =" i.= Bool bool/=]
- ["int <" i.< Bool bool/=]
+ ["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.= Bool bool/=]
+ ["lux int <" i.< Bool bool/=]
)]
($_ seq
<nullary>
@@ -214,13 +214,13 @@
_
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/=]
+ ["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.= Bool bool/=]
+ ["lux frac <" f.< Bool bool/=]
)]
($_ seq
<binary>
@@ -243,12 +243,12 @@
_
false)))]
- ["frac min" (f.= real/bottom)]
- ["frac max" (f.= real/top)]
- ["frac not-a-number" number;not-a-number?]
- ["frac positive-infinity" (f.= number;positive-infinity)]
- ["frac negative-infinity" (f.= number;negative-infinity)]
- ["frac smallest" (f.= (_lux_proc [ "frac" "smallest-value"] []))]
+ ["lux frac min" (f.= real/bottom)]
+ ["lux frac max" (f.= real/top)]
+ ["lux frac not-a-number" number;not-a-number?]
+ ["lux frac positive-infinity" (f.= number;positive-infinity)]
+ ["lux frac negative-infinity" (f.= number;negative-infinity)]
+ ["lux frac smallest" (f.= ("lux frac smallest-value"))]
)
<unary> (do-template [<name> <type> <prepare> <comp>]
[(test <name>
@@ -263,8 +263,8 @@
_
false)))]
- ["frac to-int" Int frac-to-int i.=]
- ["frac to-deg" Deg frac-to-deg d.=]
+ ["lux frac to-int" Int frac-to-int i.=]
+ ["lux frac to-deg" Deg frac-to-deg d.=]
)]
($_ seq
<nullary>
@@ -272,7 +272,7 @@
(test "frac encode|decode"
(|> (do meta;Monad<Meta>
[runtime-bytecode @runtime;translate
- sampleI (expressionT;translate (` ("frac decode" ("frac encode" (~ (code;frac subject))))))]
+ sampleI (expressionT;translate (` ("lux frac decode" ("lux frac encode" (~ (code;frac subject))))))]
(@eval;eval sampleI))
(meta;run (init-compiler []))
(case> (^multi (#e;Success valueT)
@@ -309,8 +309,8 @@
_
false)))]
- ["deg min" deg/bottom]
- ["deg max" deg/top]
+ ["lux deg min" deg/bottom]
+ ["lux deg max" deg/top]
))
(~~ (do-template [<name> <type> <prepare> <comp>]
[(test <name>
@@ -325,7 +325,7 @@
_
false)))]
- ["deg to-frac" Frac deg-to-frac f.=]
+ ["lux deg to-frac" Frac deg-to-frac f.=]
))
(~~ (do-template [<name> <reference> <outputT> <comp>]
[(test <name>
@@ -340,13 +340,13 @@
_
false)))]
- ["deg +" d.+ Deg d.=]
- ["deg -" d.- Deg d.=]
- ["deg *" d.* Deg d.=]
- ["deg /" d./ Deg d.=]
- ["deg %" d.% Deg d.=]
- ["deg =" d.= Bool bool/=]
- ["deg <" d.< Bool bool/=]
+ ["lux deg +" d.+ Deg d.=]
+ ["lux deg -" d.- Deg d.=]
+ ["lux deg *" d.* Deg d.=]
+ ["lux deg /" d./ Deg d.=]
+ ["lux deg %" d.% Deg d.=]
+ ["lux deg =" d.= Bool bool/=]
+ ["lux deg <" d.< Bool bool/=]
))
(~~ (do-template [<name> <reference> <outputT> <comp>]
[(test <name>
@@ -361,7 +361,7 @@
_
false)))]
- ["deg scale" d.scale Deg d.=]
- ["deg reciprocal" d.reciprocal Deg d.=]
+ ["lux deg scale" d.scale Deg d.=]
+ ["lux deg reciprocal" d.reciprocal Deg d.=]
))
)))))