aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/target/jvm/type.lux205
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux24
-rw-r--r--stdlib/source/lux/world/console.lux118
-rw-r--r--stdlib/source/program/compositor.lux2
4 files changed, 277 insertions, 72 deletions
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
new file mode 100644
index 000000000..23925e468
--- /dev/null
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -0,0 +1,205 @@
+(.module:
+ [lux (#- Type int char)
+ [data
+ ["." maybe ("#@." functor)]
+ ["." text
+ format]
+ [collection
+ ["." list ("#@." functor)]]]])
+
+(def: array-prefix "[")
+(def: binary-void-name "V")
+(def: binary-boolean-name "Z")
+(def: binary-byte-name "B")
+(def: binary-short-name "S")
+(def: binary-int-name "I")
+(def: binary-long-name "J")
+(def: binary-float-name "F")
+(def: binary-double-name "D")
+(def: binary-char-name "C")
+(def: binary-object-prefix "L")
+(def: binary-object-suffix ";")
+(def: object-class "java.lang.Object")
+
+(type: #export Bound
+ #Upper
+ #Lower)
+
+(type: #export Primitive
+ #Boolean
+ #Byte
+ #Short
+ #Int
+ #Long
+ #Float
+ #Double
+ #Char)
+
+(type: #export #rec Generic
+ (#Var Text)
+ (#Wildcard (Maybe [Bound Generic]))
+ (#Class Text (List Generic)))
+
+(type: #export Class
+ [Text (List Generic)])
+
+(type: #export Parameter
+ [Text Class (List Class)])
+
+(type: #export #rec Type
+ (#Primitive Primitive)
+ (#Generic Generic)
+ (#Array Type))
+
+(type: #export Method
+ {#args (List Type)
+ #return (Maybe Type)
+ #exceptions (List Generic)})
+
+(template [<name> <primitive>]
+ [(def: #export <name> Type (#Primitive <primitive>))]
+
+ [boolean #Boolean]
+ [byte #Byte]
+ [short #Short]
+ [int #Int]
+ [long #Long]
+ [float #Float]
+ [double #Double]
+ [char #Char]
+ )
+
+(template: #export (class name params)
+ (#..Generic (#..Class name params)))
+
+(template: #export (var name)
+ (#..Generic (#..Var name)))
+
+(template: #export (wildcard bound)
+ (#..Generic (#..Wildcard bound)))
+
+(def: #export (array depth elemT)
+ (-> Nat Type Type)
+ (case depth
+ 0 elemT
+ _ (#Array (array (dec depth) elemT))))
+
+(def: #export binary-name
+ (-> Text Text)
+ (text.replace-all "." "/"))
+
+(def: #export (descriptor type)
+ (-> Type Text)
+ (case type
+ (#Primitive prim)
+ (case prim
+ #Boolean ..binary-boolean-name
+ #Byte ..binary-byte-name
+ #Short ..binary-short-name
+ #Int ..binary-int-name
+ #Long ..binary-long-name
+ #Float ..binary-float-name
+ #Double ..binary-double-name
+ #Char ..binary-char-name)
+
+ (#Array sub)
+ (format ..array-prefix (descriptor sub))
+
+ (#Generic generic)
+ (case generic
+ (#Class class params)
+ (format ..binary-object-prefix (binary-name class) ..binary-object-suffix)
+
+ (^or (#Var name) (#Wildcard ?bound))
+ (descriptor (#Generic (#Class ..object-class (list)))))
+ ))
+
+(def: #export (class-name type)
+ (-> Type (Maybe Text))
+ (case type
+ (#Primitive prim)
+ #.None
+
+ (#Array sub)
+ (#.Some (descriptor type))
+
+ (#Generic generic)
+ (case generic
+ (#Class class params)
+ (#.Some class)
+
+ (^or (#Var name) (#Wildcard ?bound))
+ (#.Some ..object-class))
+ ))
+
+(def: #export (signature type)
+ (-> Type Text)
+ (case type
+ (#Primitive prim)
+ (case prim
+ #Boolean ..binary-boolean-name
+ #Byte ..binary-byte-name
+ #Short ..binary-short-name
+ #Int ..binary-int-name
+ #Long ..binary-long-name
+ #Float ..binary-float-name
+ #Double ..binary-double-name
+ #Char ..binary-char-name)
+
+ (#Array sub)
+ (format ..array-prefix (signature sub))
+
+ (#Generic generic)
+ (case generic
+ (#Class class params)
+ (let [=params (if (list.empty? params)
+ ""
+ (format "<"
+ (|> params
+ (list@map (|>> #Generic signature))
+ (text.join-with ""))
+ ">"))]
+ (format ..binary-object-prefix (binary-name class) =params ..binary-object-suffix))
+
+ (#Var name)
+ (format "T" name ..binary-object-suffix)
+
+ (#Wildcard #.None)
+ "*"
+
+ (^template [<tag> <prefix>]
+ (#Wildcard (#.Some [<tag> bound]))
+ (format <prefix> (signature (#Generic bound))))
+ ([#Upper "+"]
+ [#Lower "-"]))
+ ))
+
+(def: #export (method args return exceptions)
+ (-> (List Type) (Maybe Type) (List Generic) Method)
+ {#args args #return return #exceptions exceptions})
+
+(def: method-args
+ (text.enclose ["(" ")"]))
+
+(def: #export (method-descriptor method)
+ (-> Method Text)
+ (format (|> (get@ #args method) (list@map descriptor) (text.join-with "") ..method-args)
+ (case (get@ #return method)
+ #.None
+ ..binary-void-name
+
+ (#.Some return)
+ (descriptor return))))
+
+(def: #export (method-signature method)
+ (-> Method Text)
+ (format (|> (get@ #args method) (list@map signature) (text.join-with "") ..method-args)
+ (case (get@ #return method)
+ #.None
+ ..binary-void-name
+
+ (#.Some return)
+ (signature return))
+ (|> (get@ #exceptions method)
+ (list@map (|>> #Generic signature (format "^")))
+ (text.join-with ""))))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index b60616f03..bd1efd73b 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -1,5 +1,6 @@
(.module:
[lux (#- Module Code)
+ ["@" target]
[abstract
[monad (#+ Monad do)]]
[control
@@ -19,8 +20,7 @@
["#/" // #_
[archive
[descriptor (#+ Module)]]
- ["#/" // (#+ Input)
- ["#." host]]]])
+ ["#/" // (#+ Input)]]])
(template [<name>]
[(exception: #export (<name> {module Module})
@@ -38,16 +38,16 @@
(def: partial-host-extension
Extension
- (`` (for {(~~ (static ////host.common-lisp)) ".cl"
- (~~ (static ////host.js)) ".js"
- (~~ (static ////host.old)) ".jvm"
- (~~ (static ////host.jvm)) ".jvm"
- (~~ (static ////host.lua)) ".lua"
- (~~ (static ////host.php)) ".php"
- (~~ (static ////host.python)) ".py"
- (~~ (static ////host.r)) ".r"
- (~~ (static ////host.ruby)) ".rb"
- (~~ (static ////host.scheme)) ".scm"})))
+ (`` (for {(~~ (static @.common-lisp)) ".cl"
+ (~~ (static @.js)) ".js"
+ (~~ (static @.old)) ".jvm"
+ (~~ (static @.jvm)) ".jvm"
+ (~~ (static @.lua)) ".lua"
+ (~~ (static @.php)) ".php"
+ (~~ (static @.python)) ".py"
+ (~~ (static @.r)) ".r"
+ (~~ (static @.ruby)) ".rb"
+ (~~ (static @.scheme)) ".scm"})))
(def: full-host-extension
Extension
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index effcff8a3..cc5258724 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -1,5 +1,7 @@
(.module:
[lux #*
+ [host (#+ import:)]
+ ["@" target]
[abstract
[monad (#+ do)]]
[control
@@ -12,11 +14,7 @@
[data
["." error (#+ Error)]
["." text
- format]]
- [host (#+ import:)]
- [tool
- [compiler
- ["." host]]]])
+ format]]])
(template [<name>]
[(exception: #export (<name>)
@@ -57,59 +55,63 @@
[can-write ..can-write]
[can-close ..can-close])))))
-(`` (for {(~~ (static host.old))
- (as-is (import: java/lang/String)
-
- (import: #long java/io/Console
- (readLine [] #io #try String))
-
- (import: java/io/InputStream
- (read [] #io #try int))
-
- (import: java/io/PrintStream
- (print [String] #io #try void))
-
- (import: java/lang/System
- (#static console [] #io #? java/io/Console)
- (#static in java/io/InputStream)
- (#static out java/io/PrintStream))
-
- (def: #export system
- (IO (Error (Console IO)))
- (do io.monad
- [?jvm-console (System::console)]
- (case ?jvm-console
- #.None
- (wrap (ex.throw cannot-open []))
-
- (#.Some jvm-console)
- (let [jvm-input (System::in)
- jvm-output (System::out)]
- (<| wrap
- ex.return
- (: (Console IO)) ## TODO: Remove ASAP
- (structure
- (def: can-read
- (..can-read
- (function (_ _)
- (|> jvm-input
- InputStream::read
- (:: (error.with io.monad) map .nat)))))
-
- (def: can-read-line
- (..can-read
- (function (_ _)
- (java/io/Console::readLine jvm-console))))
-
- (def: can-write
- (..can-write
- (function (_ message)
- (PrintStream::print message jvm-output))))
-
- (def: can-close
- (..can-close
- (|>> (ex.throw cannot-close) wrap))))))))))
- }))
+(with-expansions [<form-jvm> (as-is (import: java/lang/String)
+
+ (import: #long java/io/Console
+ (readLine [] #io #try String))
+
+ (import: java/io/InputStream
+ (read [] #io #try int))
+
+ (import: java/io/PrintStream
+ (print [String] #io #try void))
+
+ (import: java/lang/System
+ (#static console [] #io #? java/io/Console)
+ (#static in java/io/InputStream)
+ (#static out java/io/PrintStream))
+
+ (def: #export system
+ (IO (Error (Console IO)))
+ (do io.monad
+ [?jvm-console (System::console)]
+ (case ?jvm-console
+ #.None
+ (wrap (ex.throw cannot-open []))
+
+ (#.Some jvm-console)
+ (let [jvm-input (System::in)
+ jvm-output (System::out)]
+ (<| wrap
+ ex.return
+ (: (Console IO)) ## TODO: Remove ASAP
+ (structure
+ (def: can-read
+ (..can-read
+ (function (_ _)
+ (|> jvm-input
+ InputStream::read
+ (:: (error.with io.monad) map .nat)))))
+
+ (def: can-read-line
+ (..can-read
+ (function (_ _)
+ (java/io/Console::readLine jvm-console))))
+
+ (def: can-write
+ (..can-write
+ (function (_ message)
+ (PrintStream::print message jvm-output))))
+
+ (def: can-close
+ (..can-close
+ (|>> (ex.throw cannot-close) wrap))))))))))]
+ (`` (for {(~~ (static @.old))
+ (as-is <form-jvm>)
+
+ (~~ (static @.jvm))
+ (as-is <form-jvm>)
+ })))
(def: #export (write-line message console)
(All [!] (-> Text (Console !) (! Any)))
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 5dd2fd1ba..c39544019 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -20,8 +20,6 @@
["." list ("#@." functor fold)]]]
[time
["." instant (#+ Instant)]]
- [host
- ["_" js]]
[world
["." file (#+ File)]
["." console]]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 09:33:50 +0000