aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux5
-rw-r--r--new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux5
-rw-r--r--new-luxc/test/test/luxc/lang/translation/jvm.lux52
-rw-r--r--stdlib/source/lux/type/abstract.lux65
10 files changed, 50 insertions, 107 deletions
diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux
index 43ef5c384..b7dd1b58a 100644
--- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux
@@ -105,10 +105,6 @@
Trinary
(caseT.translate-if testO thenO elseO))
-(def: (lux//noop valueO)
- Unary
- valueO)
-
(exception: #export (Wrong-Syntax {message Text})
message)
@@ -138,7 +134,6 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary runtimeT.lux//try))
(install "if" (trinary lux//if))
diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
index 7b4a19b91..1d4e0e5c4 100644
--- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux
@@ -116,10 +116,6 @@
Unary
(format runtimeT.lux//try "(" riskyJS ")"))
-(def: (lux//noop valueJS)
- Unary
- valueJS)
-
(exception: #export (Wrong-Syntax {message Text})
message)
@@ -413,7 +409,6 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary lux//try))
(install "if" (trinary lux//if))
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 7daf35fb5..db92bc413 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -164,10 +164,6 @@
($t.method (list $Function) (#.Some $Object-Array) (list))
false)))
-(def: (lux//noop valueI)
- Unary
- valueI)
-
(exception: #export (Wrong-Syntax {message Text})
message)
@@ -553,7 +549,6 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary lux//try))
(install "if" (trinary lux//if))
diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
index b49d4951c..21baddcfc 100644
--- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux
@@ -108,10 +108,6 @@
Unary
(runtimeT.lux//try riskyO))
-(def: (lux//noop valueO)
- Unary
- valueO)
-
(exception: #export (Wrong-Syntax {message Text})
message)
@@ -402,7 +398,6 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary lux//try))
(install "if" (trinary lux//if))
diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
index 0e0931b1e..8ce6fe1ef 100644
--- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux
@@ -109,10 +109,6 @@
## Unary
## (runtimeT.lux//try riskyO))
-## (def: (lux//noop valueO)
-## Unary
-## valueO)
-
## (exception: #export (Wrong-Syntax {message Text})
## message)
@@ -142,7 +138,6 @@
## (def: lux-procs
## Bundle
## (|> (dict.new text.Hash<Text>)
-## (install "noop" (unary lux//noop))
## (install "is" (binary lux//is))
## (install "try" (unary lux//try))
## (install "if" (trinary lux//if))
diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
index a83a897d1..f63371bd1 100644
--- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux
@@ -109,10 +109,6 @@
Unary
(runtimeT.lux//try riskyO))
-(def: (lux//noop valueO)
- Unary
- valueO)
-
(exception: #export (Wrong-Syntax {message Text})
message)
@@ -142,7 +138,6 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary lux//try))
(install "if" (trinary lux//if))
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
index 885837078..022e1ea16 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
@@ -110,10 +110,6 @@
Unary
(runtimeT.lux//try riskyO))
-(def: (lux//noop valueO)
- Unary
- valueO)
-
(exception: #export (Wrong-Syntax {message Text})
message)
@@ -143,7 +139,6 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary lux//try))
(install "if" (trinary lux//if))
diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
index f26cefad6..7a9dfcb08 100644
--- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux
@@ -108,10 +108,6 @@
Unary
(runtimeT.lux//try riskyO))
-(def: (lux//noop valueO)
- Unary
- valueO)
-
(exception: #export (Wrong-Syntax {message Text})
message)
@@ -141,7 +137,6 @@
(def: lux-procs
Bundle
(|> (dict.new text.Hash<Text>)
- (install "noop" (unary lux//noop))
(install "is" (binary lux//is))
(install "try" (unary lux//try))
(install "if" (trinary lux//if))
diff --git a/new-luxc/test/test/luxc/lang/translation/jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm.lux
index ae66b68af..6652c8484 100644
--- a/new-luxc/test/test/luxc/lang/translation/jvm.lux
+++ b/new-luxc/test/test/luxc/lang/translation/jvm.lux
@@ -130,9 +130,9 @@
(with-expansions [<tests> (do-template [<procedure> <reference>]
[(test <procedure>
(|> (do macro.Monad<Meta>
- [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>))
- (<pre> (~ (<tag> subject)))
- (<pre> (~ (<tag> param)))))))]
+ [sampleI (expressionT.translate (<post> ((code.text <procedure>)
+ (<pre> (<tag> subject))
+ (<pre> (<tag> param)))))]
(evalT.eval sampleI))
(lang.with-current-module "")
(macro.run (io.run init-jvm))
@@ -154,9 +154,9 @@
)))))]
["int" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "jvm convert long-to-int" "jvm convert int-to-long"]
- ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% "lux noop" "lux noop"]
+ ["long" gen-int code.int Int i/= (i/* 10) i/+ i/- i/* i// i/% id id]
["float" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "jvm convert double-to-float" "jvm convert float-to-double"]
- ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% "lux noop" "lux noop"]
+ ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% id id]
)
(do-template [<domain> <post> <convert>]
@@ -169,9 +169,9 @@
(~~ (do-template [<procedure> <reference>]
[(test <procedure>
(|> (do macro.Monad<Meta>
- [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>))
- (<convert> (~ (code.nat subject)))
- (<convert> (~ (code.nat param)))))))]
+ [sampleI (expressionT.translate (<post> ((code.text <procedure>)
+ (<convert> (code.nat subject))
+ (<convert> (code.nat param)))))]
(evalT.eval sampleI))
(lang.with-current-module "")
(macro.run (io.run init-jvm))
@@ -189,7 +189,7 @@
)))))]
["int" "jvm convert int-to-long" "jvm convert long-to-int"]
- ["long" "lux noop" "lux noop"]
+ ["long" id id]
)
(do-template [<domain> <post> <convert>]
@@ -203,9 +203,9 @@
(~~ (do-template [<procedure> <reference> <type> <test> <pre-subject> <pre>]
[(test <procedure>
(|> (do macro.Monad<Meta>
- [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>))
- (<convert> (~ (<pre> subject)))
- ("jvm convert long-to-int" (~ (code.nat shift)))))))]
+ [sampleI (expressionT.translate (<post> ((code.text <procedure>)
+ (<convert> (<pre> subject))
+ ("jvm convert long-to-int" (code.nat shift)))))]
(evalT.eval sampleI))
(lang.with-current-module "")
(macro.run (io.run init-jvm))
@@ -223,7 +223,7 @@
)))))]
["int" "jvm convert int-to-long" "jvm convert long-to-int"]
- ["long" "lux noop" "lux noop"]
+ ["long" id id]
)
(do-template [<domain> <generator> <tag> <=> <<> <pre>]
@@ -235,9 +235,9 @@
(with-expansions [<tests> (do-template [<procedure> <reference>]
[(test <procedure>
(|> (do macro.Monad<Meta>
- [sampleI (expressionT.translate (` ((~ (code.text <procedure>))
- (<pre> (~ (<tag> subject)))
- (<pre> (~ (<tag> param))))))]
+ [sampleI (expressionT.translate ((code.text <procedure>)
+ (<pre> (<tag> subject))
+ (<pre> (<tag> param))))]
(evalT.eval sampleI))
(lang.with-current-module "")
(macro.run (io.run init-jvm))
@@ -256,9 +256,9 @@
)))))]
["int" gen-int code.int i/= i/< "jvm convert long-to-int"]
- ["long" gen-int code.int i/= i/< "lux noop"]
+ ["long" gen-int code.int i/= i/< id]
["float" gen-frac code.frac f/= f/< "jvm convert double-to-float"]
- ["double" gen-frac code.frac f/= f/< "lux noop"]
+ ["double" gen-frac code.frac f/= f/< id]
["char" gen-int code.int i/= i/< "jvm convert long-to-char"]
)
@@ -293,9 +293,7 @@
[sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size)
(jvm//array//write <class> idx <input>)
(jvm//array//read <class> idx)
- (~)
- <post>
- (`)))]
+ <post>))]
(evalT.eval sampleI))
(lang.with-current-module "")
(macro.run (io.run init-jvm))
@@ -306,7 +304,7 @@
false)))]
["boolean" Bool valueZ bool/= (code.bool valueZ)
- "lux noop"]
+ id]
["byte" Int valueB i/= (|> (code.int valueB) (~) "jvm convert long-to-byte" (`))
"jvm convert byte-to-long"]
["short" Int valueS i/= (|> (code.int valueS) (~) "jvm convert long-to-short" (`))
@@ -314,11 +312,11 @@
["int" Int valueI i/= (|> (code.int valueI) (~) "jvm convert long-to-int" (`))
"jvm convert int-to-long"]
["long" Int valueL i/= (code.int valueL)
- "lux noop"]
+ id]
["float" Frac valueF f/= (|> (code.frac valueF) (~) "jvm convert double-to-float" (`))
"jvm convert float-to-double"]
["double" Frac valueD f/= (code.frac valueD)
- "lux noop"]
+ id]
)]
($_ seq
<array>
@@ -343,9 +341,7 @@
[sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size)
(jvm//array//write <class> idx <input>)
(jvm//array//read <class> idx)
- (~)
- <post>
- (`)))]
+ <post>))]
(evalT.eval sampleI))
(lang.with-current-module "")
(macro.run (io.run init-jvm))
@@ -360,7 +356,7 @@
"jvm convert char-to-long"]
["java.lang.Long" Int valueL i/=
(code.int valueL)
- "lux noop"]
+ id]
)]
($_ seq
<array>
diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux
index 0cbe49087..70a71c60b 100644
--- a/stdlib/source/lux/type/abstract.lux
+++ b/stdlib/source/lux/type/abstract.lux
@@ -3,9 +3,9 @@
(lux (control [monad #+ do Monad]
["p" parser])
(data [text "text/" Eq<Text> Monoid<Text>]
- ["E" error]
+ [error]
(coll [list "list/" Functor<List> Monoid<List>]))
- [macro]
+ [macro #+ "meta/" Monad<Meta>]
(macro [code]
["s" syntax #+ syntax:]
(syntax ["cs" common]
@@ -57,43 +57,36 @@
(|>> ($_ text/compose "{" kind "@" module "}")
(let [[module kind] (ident-for #..Representation)])))
+(def: (cast name type-vars input-declaration output-declaration)
+ (-> Text (List Code) Code Code Macro)
+ (function (_ tokens)
+ (case tokens
+ (^ (list value))
+ (meta/wrap (list (` ((: (All [(~+ type-vars)]
+ (-> (~ input-declaration) (~ output-declaration)))
+ (|>> :assume))
+ (~ value)))))
+
+ _
+ (macro.fail ($_ text/compose "Wrong syntax for " name)))))
+
(def: (install-casts' this-module-name name type-vars)
(-> Text Text (List Text) (Meta Any))
(do macro.Monad<Meta>
[this-module (macro.find-module this-module-name)
#let [type-varsC (list/map code.local-symbol type-vars)
- abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
+ abstraction-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~+ type-varsC)))
this-module (|> this-module
(update@ #.definitions (put down-cast (: Definition
[Macro macro-anns
- (: Macro
- (function (_ tokens)
- (case tokens
- (^ (list value))
- (wrap (list (` ((: (All [(~+ type-varsC)]
- (-> (~ representation-declaration) (~ abstract-declaration)))
- (|>> :assume))
- (~ value)))))
-
- _
- (macro.fail ($_ text/compose "Wrong syntax for " down-cast)))))])))
+ (cast down-cast type-varsC representation-declaration abstraction-declaration)])))
(update@ #.definitions (put up-cast (: Definition
[Macro macro-anns
- (: Macro
- (function (_ tokens)
- (case tokens
- (^ (list value))
- (wrap (list (` ((: (All [(~+ type-varsC)]
- (-> (~ abstract-declaration) (~ representation-declaration)))
- (|>> :assume))
- (~ value)))))
-
- _
- (macro.fail ($_ text/compose "Wrong syntax for " up-cast)))))]))))]]
+ (cast up-cast type-varsC abstraction-declaration representation-declaration)]))))]]
(function (_ compiler)
- (#E.Success [(update@ #.modules (put this-module-name this-module) compiler)
- []]))))
+ (#error.Success [(update@ #.modules (put this-module-name this-module) compiler)
+ []]))))
(def: (un-install-casts' this-module-name)
(-> Text (Meta Any))
@@ -103,8 +96,8 @@
(update@ #.definitions (remove down-cast))
(update@ #.definitions (remove up-cast)))]]
(function (_ compiler)
- (#E.Success [(update@ #.modules (put this-module-name this-module) compiler)
- []]))))
+ (#error.Success [(update@ #.modules (put this-module-name this-module) compiler)
+ []]))))
(syntax: (install-casts {name s.local-symbol}
{type-vars (s.tuple (p.some s.local-symbol))})
@@ -119,10 +112,7 @@
(wrap (list)))
_
- (macro.fail ($_ text/compose
- "Cannot temporarily define casting functions ("
- down-cast " & " up-cast
- ") because definitions like that already exist.")))))
+ (macro.fail ($_ text/compose "Cannot temporarily define casting functions (" down-cast " & " up-cast ") because definitions like that already exist.")))))
(syntax: (un-install-casts)
(do macro.Monad<Meta>
@@ -136,10 +126,7 @@
(wrap (list)))
_
- (macro.fail ($_ text/compose
- "Cannot un-define casting functions ("
- down-cast " & " up-cast
- ") because they do not exist.")))))
+ (macro.fail ($_ text/compose "Cannot un-define casting functions (" down-cast " & " up-cast ") because they do not exist.")))))
(def: declaration
(s.Syntax [Text (List Text)])
@@ -154,9 +141,9 @@
{primitives (p.some s.any)})
(let [hidden-name (representation-name name)
type-varsC (list/map code.local-symbol type-vars)
- abstract-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
+ abstraction-declaration (` ((~ (code.local-symbol name)) (~+ type-varsC)))
representation-declaration (` ((~ (code.local-symbol hidden-name)) (~+ type-varsC)))]
- (wrap (list& (` (type: (~+ (csw.export export)) (~ abstract-declaration)
+ (wrap (list& (` (type: (~+ (csw.export export)) (~ abstraction-declaration)
(~ (csw.annotations annotations))
(primitive (~ (code.text hidden-name)) [(~+ type-varsC)])))
(` (type: (~+ (csw.export export)) (~ representation-declaration)