aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/common-lisp
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp.lux34
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/case.jvm.lux10
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux44
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/primitive.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux2
6 files changed, 48 insertions, 48 deletions
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp.lux b/new-luxc/source/luxc/lang/translation/common-lisp.lux
index 36926833c..4341e5e4c 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp.lux
@@ -83,26 +83,26 @@
(Meta Any)
(function (_ compiler)
(#e.Success [(update@ #.host
- (|>> (:! Host)
+ (|>> (:coerce Host)
(set@ #module-buffer (#.Some (StringBuilder::new [])))
- (:! Nothing))
+ (:coerce Nothing))
compiler)
[]])))
(def: #export (with-sub-context expr)
(All [a] (-> (Meta a) (Meta [Text a])))
(function (_ compiler)
- (let [old (:! Host (get@ #.host compiler))
+ (let [old (:coerce Host (get@ #.host compiler))
[old-name old-sub] (get@ #context old)
new-name (format old-name "f___" (%i (.int old-sub)))]
(case (expr (set@ #.host
- (:! Nothing (set@ #context [new-name +0] old))
+ (:coerce Nothing (set@ #context [new-name +0] old))
compiler))
(#e.Success [compiler' output])
(#e.Success [(update@ #.host
- (|>> (:! Host)
+ (|>> (:coerce Host)
(set@ #context [old-name (inc old-sub)])
- (:! Nothing))
+ (:coerce Nothing))
compiler')
[new-name output]])
@@ -114,7 +114,7 @@
(function (_ compiler)
(#e.Success [compiler
(|> (get@ #.host compiler)
- (:! Host)
+ (:coerce Host)
(get@ #context)
(let> [name sub]
name))])))
@@ -122,15 +122,15 @@
(def: #export (with-anchor anchor expr)
(All [a] (-> Anchor (Meta a) (Meta a)))
(function (_ compiler)
- (let [old (:! Host (get@ #.host compiler))]
+ (let [old (:coerce Host (get@ #.host compiler))]
(case (expr (set@ #.host
- (:! Nothing (set@ #anchor (#.Some anchor) old))
+ (:coerce Nothing (set@ #anchor (#.Some anchor) old))
compiler))
(#e.Success [compiler' output])
(#e.Success [(update@ #.host
- (|>> (:! Host)
+ (|>> (:coerce Host)
(set@ #anchor (get@ #anchor old))
- (:! Nothing))
+ (:coerce Nothing))
compiler')
output])
@@ -140,7 +140,7 @@
(def: #export anchor
(Meta Anchor)
(function (_ compiler)
- (case (|> compiler (get@ #.host) (:! Host) (get@ #anchor))
+ (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor))
(#.Some anchor)
(#e.Success [compiler anchor])
@@ -150,7 +150,7 @@
(def: #export module-buffer
(Meta StringBuilder)
(function (_ compiler)
- (case (|> compiler (get@ #.host) (:! Host) (get@ #module-buffer))
+ (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer))
#.None
((lang.throw No-Active-Module-Buffer "") compiler)
@@ -160,13 +160,13 @@
(def: #export program-buffer
(Meta StringBuilder)
(function (_ compiler)
- (#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))])))
+ (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))])))
(do-template [<name> <field> <outputT>]
[(def: (<name> code)
(-> Expression (Meta <outputT>))
(function (_ compiler)
- (let [runner (|> compiler (get@ #.host) (:! Host) (get@ <field>))]
+ (let [runner (|> compiler (get@ #.host) (:coerce Host) (get@ <field>))]
(case (runner code)
(#e.Error error)
((lang.throw Cannot-Execute error) compiler)
@@ -190,7 +190,7 @@
(-> Expression (Meta Any))
(do macro.Monad<Meta>
[module-buffer module-buffer
- #let [_ (Appendable::append [(:! CharSequence (_.expression code))]
+ #let [_ (Appendable::append [(:coerce CharSequence (_.expression code))]
module-buffer)]]
(load! code)))
@@ -203,7 +203,7 @@
module-buffer module-buffer
program-buffer program-buffer
#let [module-code (StringBuilder::toString [] module-buffer)
- _ (Appendable::append [(:! CharSequence (format module-code "\n"))]
+ _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))]
program-buffer)]]
(wrap (ioC.write target
(format (lang.normalize-name module) "/" r-module-name)
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/case.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/case.jvm.lux
index d132ba0b8..41e93c13b 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp/case.jvm.lux
@@ -37,7 +37,7 @@
(let [method (if tail?
runtimeT.product//right
runtimeT.product//left)]
- (method source (_.int (:! Int idx)))))
+ (method source (_.int (:coerce Int idx)))))
valueO
pathP))))
@@ -116,21 +116,21 @@
(meta/wrap (_.when (|> value <format> (<=> cursor-top) _.not)
fail-pm!)))
([#.Bool _.bool _.equal]
- [#.Nat (<| _.int (:! Int)) _.=]
+ [#.Nat (<| _.int (:coerce Int)) _.=]
[#.Int _.int _.=]
- [#.Deg (<| _.int (:! Int)) _.=]
+ [#.Deg (<| _.int (:coerce Int)) _.=]
[#.Frac _.float _.=]
[#.Text _.string _.equal])
(^template [<pm> <getter>]
(^code (<pm> (~ [_ (#.Nat idx)])))
- (meta/wrap (push-cursor! (<getter> cursor-top (_.int (:! Int idx))))))
+ (meta/wrap (push-cursor! (<getter> cursor-top (_.int (:coerce Int idx))))))
(["lux case tuple left" runtimeT.product//left]
["lux case tuple right" runtimeT.product//right])
(^template [<pm> <flag>]
(^code (<pm> (~ [_ (#.Nat idx)])))
- (meta/wrap (_.progn (list (_.setq! $temp (runtimeT.sum//get cursor-top (_.int (:! Int idx)) <flag>))
+ (meta/wrap (_.progn (list (_.setq! $temp (runtimeT.sum//get cursor-top (_.int (:coerce Int idx)) <flag>))
(_.if (_.null (@@ $temp))
fail-pm!
(push-cursor! (@@ $temp)))))))
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux
index cb6f03d17..0108d2e83 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux
@@ -42,8 +42,8 @@
)
(exception: #export (Unknown-Kind-Of-Host-Object {host-object Object})
- (let [object-class (:! Text (Object::toString [] (Object::getClass [] (:! Object host-object))))
- text-representation (:! Text (Object::toString [] (:! Object host-object)))]
+ (let [object-class (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object host-object))))
+ text-representation (:coerce Text (Object::toString [] (:coerce Object host-object)))]
(format object-class " --- " text-representation)))
(host.import org/armedbear/lisp/LispObject)
@@ -72,21 +72,21 @@
(def: (parse-tuple lux-object host-object)
(-> (-> Object (Error Any)) SimpleVector (Error Any))
- (let [size (:! Nat (SimpleVector::length [] host-object))]
+ (let [size (:coerce Nat (SimpleVector::length [] host-object))]
(loop [idx +0
- output (:! (Array Any) (array.new size))]
+ output (:coerce (Array Any) (array.new size))]
(if (n/< size idx)
- (case (lux-object (SimpleVector::elt [(:! Int idx)] host-object))
+ (case (lux-object (SimpleVector::elt [(:coerce Int idx)] host-object))
(#e.Error error)
(#e.Error error)
(#e.Success lux-value)
- (recur (inc idx) (array.write idx (:! Any lux-value) output)))
+ (recur (inc idx) (array.write idx (:coerce Any lux-value) output)))
(#e.Success output)))))
(def: (variant tag flag value)
(-> Nat Bool Any Any)
- [(Long::intValue [] (:! Long tag))
+ [(Long::intValue [] (:coerce Long tag))
(: Any
(if flag
//.unit
@@ -101,52 +101,52 @@
(-> (-> Object (Error Any)) Cons (Error Any))
(let [variant-tag (Cons::car host-object)]
(if (and (host.instance? org/armedbear/lisp/Symbol variant-tag)
- (text/= //.variant-tag (Symbol::getName [] (:! Symbol variant-tag))))
+ (text/= //.variant-tag (Symbol::getName [] (:coerce Symbol variant-tag))))
(do e.Monad<Error>
- [#let [host-object (:! Cons (Cons::cdr host-object))]
+ [#let [host-object (:coerce Cons (Cons::cdr host-object))]
tag (lux-object (Cons::car host-object))
- #let [host-object (:! Cons (Cons::cdr host-object))]
+ #let [host-object (:coerce Cons (Cons::cdr host-object))]
#let [flag (host.instance? org/armedbear/lisp/SimpleString
(Cons::car host-object))]
value (lux-object (Cons::cdr host-object))]
- (wrap (..variant (:! Nat tag) flag value)))
- (ex.throw invalid-variant (:! Text (Object::toString [] (:! Object host-object)))))))
+ (wrap (..variant (:coerce Nat tag) flag value)))
+ (ex.throw invalid-variant (:coerce Text (Object::toString [] (:coerce Object host-object)))))))
(def: (lux-object host-object)
(-> Object (Error Any))
(cond (host.instance? org/armedbear/lisp/Bignum host-object)
- (#e.Success (Bignum::longValue [] (:! Bignum host-object)))
+ (#e.Success (Bignum::longValue [] (:coerce Bignum host-object)))
(host.instance? org/armedbear/lisp/Fixnum host-object)
- (#e.Success (Fixnum::longValue [] (:! Fixnum host-object)))
+ (#e.Success (Fixnum::longValue [] (:coerce Fixnum host-object)))
(host.instance? org/armedbear/lisp/DoubleFloat host-object)
- (#e.Success (DoubleFloat::doubleValue [] (:! DoubleFloat host-object)))
+ (#e.Success (DoubleFloat::doubleValue [] (:coerce DoubleFloat host-object)))
(host.instance? org/armedbear/lisp/Nil host-object)
(#e.Success false)
(host.instance? org/armedbear/lisp/Symbol host-object)
- (if (is? Symbol::T (:! Symbol host-object))
+ (if (is? Symbol::T (:coerce Symbol host-object))
(#e.Success true)
- (ex.throw Unknown-Kind-Of-Host-Object (:! Object host-object)))
+ (ex.throw Unknown-Kind-Of-Host-Object (:coerce Object host-object)))
(host.instance? org/armedbear/lisp/SimpleString host-object)
- (#e.Success (SimpleString::getStringValue [] (:! SimpleString host-object)))
+ (#e.Success (SimpleString::getStringValue [] (:coerce SimpleString host-object)))
(host.instance? org/armedbear/lisp/SimpleVector host-object)
- (parse-tuple lux-object (:! SimpleVector host-object))
+ (parse-tuple lux-object (:coerce SimpleVector host-object))
(host.instance? org/armedbear/lisp/Cons host-object)
- (parse-variant lux-object (:! Cons host-object))
+ (parse-variant lux-object (:coerce Cons host-object))
## else
- (ex.throw Unknown-Kind-Of-Host-Object (:! Object host-object))))
+ (ex.throw Unknown-Kind-Of-Host-Object (:coerce Object host-object))))
(def: #export (eval code)
(-> Expression (Meta Any))
(function (_ compiler)
- (let [interpreter (|> compiler (get@ #.host) (:! //.Host) (get@ #//.interpreter))]
+ (let [interpreter (|> compiler (get@ #.host) (:coerce //.Host) (get@ #//.interpreter))]
(case (interpreter code)
(#e.Error error)
(exec (log! (format "eval #e.Error\n"
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/primitive.jvm.lux
index 6bb4ec140..4e26c4218 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp/primitive.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp/primitive.jvm.lux
@@ -15,11 +15,11 @@
(def: #export translate-nat
(-> Nat (Meta Expression))
- (|>> (:! Int) _.int meta/wrap))
+ (|>> (:coerce Int) _.int meta/wrap))
(def: #export translate-deg
(-> Deg (Meta Expression))
- (|>> (:! Int) _.int meta/wrap))
+ (|>> (:coerce Int) _.int meta/wrap))
(def: #export translate-frac
(-> Frac (Meta Expression))
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux
index 1819a8601..cd12328e2 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp/runtime.jvm.lux
@@ -33,7 +33,7 @@
(def: #export (variant tag last? value)
(-> Nat Bool Expression Expression)
- (variant' (_.int (:! Int tag)) (flag last?) value))
+ (variant' (_.int (:coerce Int tag)) (flag last?) value))
(def: #export none
Expression
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux
index dab065e62..549142f3f 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp/statement.jvm.lux
@@ -34,7 +34,7 @@
(wrap [])
tags
- (moduleL.declare-tags tags (macro.export? metaV) (:! Type expressionV)))
+ (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV)))
(wrap []))
#let [_ (log! (format "DEF " (%ident def-ident)))]]
(wrap []))