aboutsummaryrefslogtreecommitdiff
path: root/lux-lua
diff options
context:
space:
mode:
Diffstat (limited to 'lux-lua')
-rw-r--r--lux-lua/commands.md16
-rw-r--r--lux-lua/project.lux16
-rw-r--r--lux-lua/source/program.lux1438
3 files changed, 750 insertions, 720 deletions
diff --git a/lux-lua/commands.md b/lux-lua/commands.md
index 769ea10d8..0fdd12b75 100644
--- a/lux-lua/commands.md
+++ b/lux-lua/commands.md
@@ -1,3 +1,7 @@
+# Notes
+
+* TODO: Switch to [neolua](https://github.com/neolithos/neolua) ASAP. Rembulan is too immature of an implementation.
+
# Test
```
@@ -9,16 +13,10 @@ cd ~/lux/lux-lua/ && lein clean && lein lux auto test
```
## Develop
-cd ~/lux/lux-lua/ \
-&& lein clean \
-&& lein lux auto build
-
-## Build JVM-based compiler
## NOTE: Must set lux/control/concurrency/thread.parallelism = 1 before compiling to make sure Rembulan doesn't cause trouble.
cd ~/lux/lux-lua/ \
&& lein clean \
-&& lein lux build \
-&& mv target/program.jar jvm_based_compiler.jar
+&& lein lux auto build
```
# Try
@@ -27,7 +25,7 @@ cd ~/lux/lux-lua/ \
## Compile Lux's Standard Library's tests using a JVM-based compiler.
cd ~/lux/stdlib/ \
&& lein clean \
-&& java -jar ~/lux/lux-lua/jvm_based_compiler.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \
+&& java -jar ~/lux/lux-lua/target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux \
&& ~/lua-5.4.2/install/bin/lua ~/lux/stdlib/target/program.lua
```
@@ -35,6 +33,6 @@ cd ~/lux/stdlib/ \
```
cd ~/lux/lux-lua/ \
-&& mvn install:install-file -Dfile=jvm_based_compiler.jar -DgroupId=com.github.luxlang -DartifactId=lux-lua -Dversion=0.6.0-SNAPSHOT -Dpackaging=jar
+&& mvn install:install-file -Dfile=target/program.jar -DgroupId=com.github.luxlang -DartifactId=lux-lua -Dversion=0.6.0-SNAPSHOT -Dpackaging=jar
```
diff --git a/lux-lua/project.lux b/lux-lua/project.lux
new file mode 100644
index 000000000..855257f3f
--- /dev/null
+++ b/lux-lua/project.lux
@@ -0,0 +1,16 @@
+{""
+ {#identity ["com.github.luxlang" "lux-lua" "0.6.0-SNAPSHOT"]
+
+ #deploy_repositories {"snapshots" "https://oss.sonatype.org/content/repositories/snapshots/"
+ "releases" "https://oss.sonatype.org/service/local/staging/deploy/maven2/"}
+
+ #repositories ["https://oss.sonatype.org/content/repositories/snapshots/"
+ "https://oss.sonatype.org/service/local/staging/deploy/maven2/"]
+
+ #compiler ["com.github.luxlang" "lux-jvm" "0.6.0-SNAPSHOT" "jar"]
+ #dependencies [["com.github.luxlang" "stdlib" "0.6.0-SNAPSHOT" "tar"]
+ ["net.sandius.rembulan" "rembulan-runtime" "0.1-SNAPSHOT" "jar"]
+ ["net.sandius.rembulan" "rembulan-stdlib" "0.1-SNAPSHOT" "jar"]
+ ["net.sandius.rembulan" "rembulan-compiler" "0.1-SNAPSHOT" "jar"]]
+
+ #program "program"}}
diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux
index 4667088cb..c5c03f32a 100644
--- a/lux-lua/source/program.lux
+++ b/lux-lua/source/program.lux
@@ -65,729 +65,740 @@
["#." cli]
["#." static]]])
-(for {@.old
- (as_is (ffi.import: java/lang/String)
+(with_expansions [<jvm> (as_is (ffi.import: java/lang/String)
- (ffi.import: (java/lang/Class a))
-
- (ffi.import: java/lang/Object
- ["#::."
- (toString [] java/lang/String)
- (getClass [] (java/lang/Class java/lang/Object))])
-
- (ffi.import: java/lang/Long
- ["#::."
- (intValue [] java/lang/Integer)])
-
- (ffi.import: net/sandius/rembulan/StateContext)
-
- (ffi.import: net/sandius/rembulan/impl/StateContexts
- ["#::."
- (#static newDefaultInstance [] net/sandius/rembulan/StateContext)])
-
- (ffi.import: net/sandius/rembulan/env/RuntimeEnvironment)
-
- (ffi.import: net/sandius/rembulan/env/RuntimeEnvironments
- ["#::."
- (#static system [] net/sandius/rembulan/env/RuntimeEnvironment)])
-
- (ffi.import: net/sandius/rembulan/Table
- ["#::."
- (rawget #as get_idx [long] #? java/lang/Object)
- (rawget #as get_key [java/lang/Object] #? java/lang/Object)
- (rawlen [] long)])
-
- (ffi.import: net/sandius/rembulan/ByteString
- ["#::."
- (decode [] java/lang/String)])
-
- (ffi.import: net/sandius/rembulan/impl/DefaultTable)
-
- (ffi.import: net/sandius/rembulan/impl/ImmutableTable)
-
- (ffi.import: net/sandius/rembulan/impl/ImmutableTable$Builder
- ["#::."
- (new [])
- (build [] net/sandius/rembulan/impl/ImmutableTable)])
-
- (ffi.import: net/sandius/rembulan/lib/StandardLibrary
- ["#::."
- (#static in [net/sandius/rembulan/env/RuntimeEnvironment] net/sandius/rembulan/lib/StandardLibrary)
- (installInto [net/sandius/rembulan/StateContext] net/sandius/rembulan/Table)])
-
- (ffi.import: net/sandius/rembulan/Variable
- ["#::."
- (new [java/lang/Object])])
-
- (ffi.import: net/sandius/rembulan/runtime/ReturnBuffer
- ["#::."
- (setTo [java/lang/Object] void)])
-
- (ffi.import: net/sandius/rembulan/runtime/ExecutionContext
- ["#::."
- (getReturnBuffer [] net/sandius/rembulan/runtime/ReturnBuffer)])
-
- (ffi.import: net/sandius/rembulan/runtime/LuaFunction)
-
- (ffi.import: net/sandius/rembulan/load/ChunkLoader
- ["#::."
- (loadTextChunk [net/sandius/rembulan/Variable
- java/lang/String
- java/lang/String]
- #try net/sandius/rembulan/runtime/LuaFunction)])
-
- (ffi.import: net/sandius/rembulan/compiler/CompilerChunkLoader
- ["#::."
- (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)])
-
- (ffi.import: net/sandius/rembulan/runtime/SchedulingContext)
-
- (ffi.import: net/sandius/rembulan/runtime/SchedulingContextFactory)
-
- (ffi.import: net/sandius/rembulan/exec/DirectCallExecutor
- ["#::."
- (#static newExecutor [] net/sandius/rembulan/exec/DirectCallExecutor)
- (schedulingContextFactory [] net/sandius/rembulan/runtime/SchedulingContextFactory)
- (call [net/sandius/rembulan/StateContext java/lang/Object [java/lang/Object]] #try [java/lang/Object])])
-
- (exception: (unknown_kind_of_object {object java/lang/Object})
- (exception.report
- ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
- ["Object" (java/lang/Object::toString object)]))
-
- (template [<name>]
- [(ffi.interface: <name>
- (getValue [] java/lang/Object))
-
- (`` (ffi.import: (~~ (template.identifier ["program/" <name>]))
- ["#::."
- (getValue [] java/lang/Object)]))]
-
- [StructureValue]
- )
-
- (def: (lux_structure value)
- (-> (Array java/lang/Object) program/StructureValue)
- (let [re_wrap (function (_ unwrapped)
- (case (ffi.check [java/lang/Object] unwrapped)
- (#.Some sub_value)
- (|> sub_value (:as (Array java/lang/Object)) lux_structure (:as java/lang/Object))
-
- #.None
- unwrapped))]
- (ffi.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue]
- []
- ... Methods
- (program/StructureValue
- [] (getValue self) java/lang/Object
- (:as (Array java/lang/Object) value))
-
- (net/sandius/rembulan/impl/DefaultTable
- [] (rawlen self) long
- (|> value array.size (:as java/lang/Long)))
-
- (net/sandius/rembulan/impl/DefaultTable
- [] (rawget self {idx long}) java/lang/Object
- (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap))
-
- (net/sandius/rembulan/impl/DefaultTable
- [] (rawget self {field java/lang/Object}) java/lang/Object
- (case (ffi.check net/sandius/rembulan/ByteString field)
- (#.Some field)
- (case (net/sandius/rembulan/ByteString::decode field)
- (^ (static runtime.variant_tag_field))
- (|> value (array.read! 0) maybe.trusted)
-
- (^ (static runtime.variant_flag_field))
- (case (array.read! 1 value)
- (#.Some _)
- ""
-
- #.None
- (ffi.null))
-
- (^ (static runtime.variant_value_field))
- (|> value (array.read! 2) maybe.trusted re_wrap)
-
- _
- (panic! (exception.construct ..unknown_kind_of_object field)))
-
- #.None
- (case (ffi.check java/lang/Long field)
- (#.Some idx)
- (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap)
-
- #.None
- (panic! (exception.construct ..unknown_kind_of_object field)))))
- )))
-
- (type: Translator
- (-> java/lang/Object (Try Any)))
-
- (def: (read_variant read host_object)
- (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
- (case [(net/sandius/rembulan/Table::get_key runtime.variant_tag_field host_object)
- (net/sandius/rembulan/Table::get_key runtime.variant_flag_field host_object)
- (net/sandius/rembulan/Table::get_key runtime.variant_value_field host_object)]
- (^multi [(#.Some tag) ?flag (#.Some value)]
- {(read value)
- (#.Some value)})
- (#try.Success [(java/lang/Long::intValue (:as java/lang/Long tag))
- (: Any (case ?flag (#.Some _) "" #.None (ffi.null)))
- value])
-
- _
- (exception.throw ..unknown_kind_of_object host_object)))
-
- (def: (read_tuple read host_object)
- (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
- (let [init_num_keys (.nat (net/sandius/rembulan/Table::rawlen host_object))]
- (loop [num_keys init_num_keys
- idx 0
- output (: (Array java/lang/Object)
- (array.new init_num_keys))]
- (if (n.< num_keys idx)
- (case (net/sandius/rembulan/Table::get_idx (:as java/lang/Long (++ idx)) host_object)
- #.None
- (recur num_keys (++ idx) output)
-
- (#.Some member)
- (case (read member)
- (#try.Success parsed_member)
- (recur num_keys (++ idx) (array.write! idx (:as java/lang/Object parsed_member) output))
-
- (#try.Failure error)
- (#try.Failure error)))
- (#try.Success output)))))
-
- (exception: .public nil_has_no_lux_representation)
-
- (def: (read host_object)
- Translator
- (`` (<| (if (ffi.null? host_object)
- (exception.throw ..nil_has_no_lux_representation []))
- (~~ (template [<class> <post_processing>]
- [(case (ffi.check <class> host_object)
- (#.Some typed_object)
- (|> typed_object <post_processing>)
-
- _)]
-
- [java/lang/Boolean #try.Success]
- [java/lang/Long #try.Success]
- [java/lang/Double #try.Success]
- [java/lang/String #try.Success]
- [net/sandius/rembulan/runtime/LuaFunction #try.Success]
- [net/sandius/rembulan/ByteString (<| #try.Success net/sandius/rembulan/ByteString::decode)]
- [program/StructureValue (<| #try.Success program/StructureValue::getValue)]
- ))
- (case (ffi.check net/sandius/rembulan/impl/DefaultTable host_object)
- (#.Some typed_object)
- (case (read_variant read typed_object)
- (#try.Success value)
- (#try.Success value)
-
- (#try.Failure error)
- (read_tuple read typed_object))
-
- _)
- (exception.throw ..unknown_kind_of_object host_object)
- )))
-
- (exception: (cannot_apply_a_non_function {object java/lang/Object})
- (exception.report
- ["Non-function" (java/lang/Object::toString object)]))
-
- (def: ensure_function
- (-> Macro (Maybe net/sandius/rembulan/runtime/LuaFunction))
- (|>> (:as java/lang/Object) (ffi.check net/sandius/rembulan/runtime/LuaFunction)))
-
- (type: Baggage
- [net/sandius/rembulan/StateContext
- net/sandius/rembulan/exec/DirectCallExecutor])
-
- (def: (call_macro [state_context executor] inputs lux macro)
- (-> Baggage (List Code) Lux net/sandius/rembulan/runtime/LuaFunction (Try Any))
- (do try.monad
- [output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
- (:as java/lang/Object macro)
- (|> (array.new 2)
- (array.write! 0 ... (:as java/lang/Object inputs)
- ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
- (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) inputs))))
- (array.write! 1 ... (:as java/lang/Object lux)
- ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
- (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) lux)))))
- executor)]
- (|> output (array.read! 0) maybe.trusted (:as java/lang/Object) ..read)))
-
- (def: (expander baggage macro inputs lux)
- (-> Baggage Expander)
- (case (..ensure_function macro)
- (#.Some macro)
- (case (..call_macro baggage inputs lux macro)
- (#try.Success output)
- (|> output
- (:as (Try [Lux (List Code)]))
- #try.Success)
-
- (#try.Failure error)
- (#try.Failure error))
-
- #.None
- (exception.throw ..cannot_apply_a_non_function (:as java/lang/Object macro)))))
-
- @.lua
- (def: (expander macro inputs lux)
- Expander
- (#try.Success ((:as Macro' macro) inputs lux)))})
-
-(for {@.old (as_is (with_expansions [$var_args (_.var "...")
- $str_rel_to_abs (_.var "_utf8_str_rel_to_abs")
- $decode (_.var "_utf8_decode")]
- (template.let [(!int <hex>)
- [(_.int (.int (hex <hex>)))]
-
- (!&| <or> <and> <raw>)
- [(|> <raw>
- (_.bit_and (!int <and>))
- (_.bit_or (!int <or>)))]
-
- (!&|< <or> <and> <shift> <raw>)
- [(|> <raw>
- (_.bit_shr (_.int <shift>))
- (_.bit_and (!int <and>))
- (_.bit_or (!int <or>)))]]
- (as_is (def: rembulan//char
- (let [$buffer (_.var "buffer")
- $k (_.var "k")
- $v (_.var "v")
- $b1 (_.var "b1")
- $b2 (_.var "b2")
- $b3 (_.var "b3")
- $b4 (_.var "b4")
- table/insert (_.apply/2 (_.var "table.insert"))]
- (_.function (_.var "utf8.char") (list $var_args)
- ($_ _.then
- (_.local/1 $buffer (_.array (list)))
- (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args))))
- ($_ _.then
- (_.when (_.or (_.< (_.int +0) $v)
- (_.> (!int "10FFFF") $v))
- (_.statement (_.error/2 (|> (_.string "bad argument #")
- (_.concat $k)
- (_.concat (_.string " to char (out of range)")))
- (_.int +2))))
- (<| (_.if (_.< (!int "80") $v)
- ... Single-byte sequence
- (_.statement (|> (_.var "string.char")
- (_.apply/* (list $v))
- (table/insert $buffer))))
- (_.if (_.< (!int "800") $v)
- ... Two-byte sequence
- (_.statement (|> (_.var "string.char")
- (_.apply/* (list (!&|< "C0" "1F" +6 $v)
- (!&| "80" "3F" $v)))
- (table/insert $buffer))))
- (_.if (_.< (!int "10000") $v)
- ... Three-byte sequence
- (_.statement (|> (_.var "string.char")
- (_.apply/* (list (!&|< "E0" "0F" +12 $v)
- (!&|< "80" "3F" +6 $v)
- (!&| "80" "3F" $v)))
- (table/insert $buffer))))
- ... Four-byte sequence
- (_.statement (|> (_.var "string.char")
- (_.apply/* (list (!&|< "F0" "07" +18 $v)
- (!&|< "80" "3F" +12 $v)
- (!&|< "80" "3F" +6 $v)
- (!&| "80" "3F" $v)))
- (table/insert $buffer))))
- ))
- (_.return (_.apply/2 (_.var "table.concat") $buffer (_.string "")))
- ))))
-
- ... (def: rembulan//str_rel_to_abs
- ... (let [$string (_.var "string")
- ... $args (_.var "args")
- ... $k (_.var "k")
- ... $v (_.var "v")]
- ... (<| (_.local_function $str_rel_to_abs (list $string $var_args))
- ... ($_ _.then
- ... (_.local/1 $args (_.array (list $var_args)))
- ... (<| (_.for_in (list $k $v) (_.ipairs/1 $args))
- ... ($_ _.then
- ... (_.if (_.> (_.int +0) $v)
- ... (_.set (list $v) $v)
- ... (_.set (list $v) (|> $v (_.+ (_.length $string)) (_.+ (_.int +1)))))
- ... (_.when (_.or (_.< (_.int +1) $v)
- ... (_.> (_.length $string) $v))
- ... (_.statement (_.error/2 (_.string "bad index to string (out of range)") (_.int +3))))
- ... (_.set (list (_.nth $k $args)) $v)))
- ... (_.return (_.apply/1 (_.var "table.unpack") $args))
- ... ))))
-
- ... (def: rembulan//decode
- ... (let [$string (_.var "string")
- ... $start (_.var "start")
- ... $b1 (_.var "b1")
- ... $idx (_.var "idx")
- ... $bx (_.var "bx")
- ... $end (_.var "_end")]
- ... (<| (_.local_function $decode (list $string $start))
- ... ($_ _.then
- ... (_.set (list $start) (_.apply/2 $str_rel_to_abs $string (_.or (_.int +1) $start)))
- ... (_.local/1 $b1 (_.do "byte" (list $start $start) $string))
- ... (<| (_.if (_.< (!int "80") $b1)
- ... ... Single-byte sequence
- ... (_.return (_.multi (list $start $start))))
- ... ... Validate first byte of multi-byte sequence
- ... (_.if (_.or (_.> (!int "F4") $b1)
- ... (_.< (!int "C2") $b1))
- ... (_.return _.nil))
- ... ... Get 'supposed' amount of continuation bytes from primary byte
- ... ($_ _.then
- ... (_.local/1 $end (|> (|> $b1 (_.>= (!int "F0")) (_.and (_.int +3)))
- ... (_.or (|> $b1 (_.>= (!int "E0")) (_.and (_.int +2))))
- ... (_.or (|> $b1 (_.>= (!int "C0")) (_.and (_.int +1))))
- ... (_.+ $start)))
- ... ... Validate our continuation bytes
- ... (<| (_.for_in (list $idx $bx) (_.ipairs/1 (_.array (list (_.do "byte"
- ... (list (_.+ (_.int +1) $start) $end)
- ... $string)))))
- ... (_.when (|> $bx
- ... (_.bit_and (!int "C0"))
- ... (_.= (!int "80"))
- ... _.not)
- ... (_.return _.nil)))
- ... (_.return (_.multi (list $start $end)))
- ... ))
- ... ))))
-
- ... (def: rembulan//codes
- ... (let [$string (_.var "string")
- ... $i (_.var "i")
- ... $start (_.var "start")
- ... $end (_.var "_end")]
- ... (_.function (_.var "utf8.codes") (list $string)
- ... ($_ _.then
- ... (_.local/1 $i (_.int +1))
- ... (_.return (<| (_.closure (list))
- ... (_.if (_.> (_.length $string) $i)
- ... (_.return _.nil)
- ... ($_ _.then
- ... (_.let (list $start $end) (_.apply/2 $decode $string $i))
- ... (_.if (_.not $start)
- ... (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2)))
- ... ($_ _.then
- ... (_.set (list $i) (_.+ (_.int +1) $end))
- ... (_.return (_.multi (list $start (_.do "sub" (list $start $end) $string))))
- ... ))
- ... ))))
- ... ))))
-
- ... (def: rembulan//len
- ... (let [$string (_.var "string")
- ... $start (_.var "start")
- ... $end (_.var "_end")
- ... $seq_start (_.var "seq_start")
- ... $seq_end (_.var "seq_end")
- ... $size (_.var "size")]
- ... (_.function (_.var "utf8.len") (list $string $start $end)
- ... ($_ _.then
- ... (_.set (list $start $end) (_.apply/3 $str_rel_to_abs $string (_.or (_.int +1) $start) (_.or (_.int -1) $end)))
- ... (_.local/1 $size (_.int +0))
- ... (_.repeat (_.>= $end $seq_end)
- ... ($_ _.then
- ... (_.let (list $seq_start $seq_end) (_.apply/2 $decode $string $start))
- ... (_.if (_.not $seq_start)
- ... ... Hit an invalid sequence!
- ... (_.return (_.multi (list (_.bool false) $start)))
- ... ($_ _.then
- ... (_.set (list $start) (_.+ (_.int +1) $seq_end))
- ... (_.set (list $size) (_.+ (_.int +1) $size))
- ... ))
- ... ))
- ... (_.return $size)
- ... ))))
-
- ... (def: rembulan//charpattern
- ... (_.set (list (_.var "utf8.charpattern"))
- ... (_.string "[%z\x01-\x7F\xC2-\xF4][\x80-\xBF]*")))
-
- (def: rembulan_prelude
- _.Statement
- ($_ _.then
- (_.function (_.var "os.time") (list)
- (_.return (_.int +0)))
-
- ... Ported from https://github.com/meepen/Lua-5.1-UTF-8
- ..rembulan//char
- ... ..rembulan//str_rel_to_abs
- ... ..rembulan//decode
- ... ..rembulan//codes
- ... ..rembulan//len
- ... ..rembulan//charpattern
- )))))
-
- (def: host
- (IO [Baggage (Host _.Expression _.Statement)])
- (io (let [runtime_env (net/sandius/rembulan/env/RuntimeEnvironments::system)
- std_lib (net/sandius/rembulan/lib/StandardLibrary::in runtime_env)
- state_context (net/sandius/rembulan/impl/StateContexts::newDefaultInstance)
- table (net/sandius/rembulan/lib/StandardLibrary::installInto state_context std_lib)
- variable (net/sandius/rembulan/Variable::new table)
- loader (net/sandius/rembulan/compiler/CompilerChunkLoader::of "_lux_definition")
- executor (net/sandius/rembulan/exec/DirectCallExecutor::newExecutor)
- scheduling_context (net/sandius/rembulan/exec/DirectCallExecutor::schedulingContextFactory executor)
- run! (: (-> _.Statement (Try Any))
- (function (_ code)
- (do try.monad
- [lua_function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable "lux compilation" (_.code code) loader)
- output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (:as java/lang/Object lua_function) (array.new 0)
- executor)]
- (case (array.read! 0 output)
- #.None
- (wrap [])
-
- (#.Some value)
- (read value)))))
- _ (try.trusted (run! ..rembulan_prelude))]
- [[state_context executor]
- (: (Host _.Expression _.Statement)
- (implementation
- (def: (evaluate! context code)
- (run! (_.return code)))
-
- (def: execute! run!)
-
- (def: (define! context custom input)
- (let [global (maybe.default (reference.artifact context)
- custom)
- @global (_.var global)]
- (do try.monad
- [#let [definition (_.set (list @global) input)]
- _ (run! definition)
- value (run! (_.return @global))]
- (wrap [global value definition]))))
-
- (def: (ingest context content)
- (|> content (\ utf8.codec decoded) try.trusted (:as _.Statement)))
-
- (def: (re_learn context custom content)
- (run! content))
-
- (def: (re_load context custom content)
- (do try.monad
- [_ (run! content)]
- (run! (_.return (_.var (reference.artifact context))))))))]))))
- @.lua (as_is (ffi.import: (load [ffi.String] #try ffi.Function))
- (def: host
- (IO (Host _.Expression _.Statement))
- (io (let [run! (: (-> _.Statement (Try Any))
- (function (_ code)
- (do try.monad
- [lua_function (..load (_.code code))]
- (let [output ("lua apply" lua_function)]
- (#try.Success (if ("lua object nil?" output)
- []
- output))))))]
- (: (Host _.Expression _.Statement)
- (implementation
- (def: (evaluate! context code)
- (run! (_.return code)))
-
- (def: execute! run!)
-
- (def: (define! context custom input)
- (let [global (maybe.default (reference.artifact context)
- custom)
- @global (_.var global)]
- (do try.monad
- [#let [definition (_.set (list @global) input)]
- _ (run! definition)
- value (run! (_.return @global))]
- (wrap [global value definition]))))
+ (ffi.import: (java/lang/Class a))
+
+ (ffi.import: java/lang/Object
+ ["#::."
+ (toString [] java/lang/String)
+ (getClass [] (java/lang/Class java/lang/Object))])
+
+ (ffi.import: java/lang/Long
+ ["#::."
+ (intValue [] java/lang/Integer)])
+
+ (ffi.import: net/sandius/rembulan/StateContext)
+
+ (ffi.import: net/sandius/rembulan/impl/StateContexts
+ ["#::."
+ (#static newDefaultInstance [] net/sandius/rembulan/StateContext)])
+
+ (ffi.import: net/sandius/rembulan/env/RuntimeEnvironment)
+
+ (ffi.import: net/sandius/rembulan/env/RuntimeEnvironments
+ ["#::."
+ (#static system [] net/sandius/rembulan/env/RuntimeEnvironment)])
+
+ (ffi.import: net/sandius/rembulan/Table
+ ["#::."
+ (rawget #as get_idx [long] #? java/lang/Object)
+ (rawget #as get_key [java/lang/Object] #? java/lang/Object)
+ (rawlen [] long)])
+
+ (ffi.import: net/sandius/rembulan/ByteString
+ ["#::."
+ (decode [] java/lang/String)])
- (def: (ingest context content)
- (|> content (\ utf8.codec decoded) try.trusted (:as _.Statement)))
+ (ffi.import: net/sandius/rembulan/impl/DefaultTable)
- (def: (re_learn context custom content)
- (run! content))
+ (ffi.import: net/sandius/rembulan/impl/ImmutableTable)
+
+ (ffi.import: net/sandius/rembulan/impl/ImmutableTable$Builder
+ ["#::."
+ (new [])
+ (build [] net/sandius/rembulan/impl/ImmutableTable)])
+
+ (ffi.import: net/sandius/rembulan/lib/StandardLibrary
+ ["#::."
+ (#static in [net/sandius/rembulan/env/RuntimeEnvironment] net/sandius/rembulan/lib/StandardLibrary)
+ (installInto [net/sandius/rembulan/StateContext] net/sandius/rembulan/Table)])
+
+ (ffi.import: net/sandius/rembulan/Variable
+ ["#::."
+ (new [java/lang/Object])])
+
+ (ffi.import: net/sandius/rembulan/runtime/ReturnBuffer
+ ["#::."
+ (setTo [java/lang/Object] void)])
- (def: (re_load context custom content)
+ (ffi.import: net/sandius/rembulan/runtime/ExecutionContext
+ ["#::."
+ (getReturnBuffer [] net/sandius/rembulan/runtime/ReturnBuffer)])
+
+ (ffi.import: net/sandius/rembulan/runtime/LuaFunction)
+
+ (ffi.import: net/sandius/rembulan/load/ChunkLoader
+ ["#::."
+ (loadTextChunk [net/sandius/rembulan/Variable
+ java/lang/String
+ java/lang/String]
+ #try net/sandius/rembulan/runtime/LuaFunction)])
+
+ (ffi.import: net/sandius/rembulan/compiler/CompilerChunkLoader
+ ["#::."
+ (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)])
+
+ (ffi.import: net/sandius/rembulan/runtime/SchedulingContext)
+
+ (ffi.import: net/sandius/rembulan/runtime/SchedulingContextFactory)
+
+ (ffi.import: net/sandius/rembulan/exec/DirectCallExecutor
+ ["#::."
+ (#static newExecutor [] net/sandius/rembulan/exec/DirectCallExecutor)
+ (schedulingContextFactory [] net/sandius/rembulan/runtime/SchedulingContextFactory)
+ (call [net/sandius/rembulan/StateContext java/lang/Object [java/lang/Object]] #try [java/lang/Object])])
+
+ (exception: (unknown_kind_of_object {object java/lang/Object})
+ (exception.report
+ ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
+ ["Object" (java/lang/Object::toString object)]))
+
+ (template [<name>]
+ [(ffi.interface: <name>
+ (getValue [] java/lang/Object))
+
+ (`` (ffi.import: (~~ (template.identifier ["program/" <name>]))
+ ["#::."
+ (getValue [] java/lang/Object)]))]
+
+ [StructureValue]
+ )
+
+ (def: (lux_structure value)
+ (-> (Array java/lang/Object) program/StructureValue)
+ (let [re_wrap (: (-> java/lang/Object java/lang/Object)
+ (function (_ unwrapped)
+ (case (ffi.check [java/lang/Object] unwrapped)
+ (#.Some sub_value)
+ (|> sub_value (:as (Array java/lang/Object)) lux_structure (:as java/lang/Object))
+
+ #.None
+ unwrapped)))]
+ (:as program/StructureValue
+ (ffi.object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue]
+ []
+ ... Methods
+ (program/StructureValue
+ [] (getValue self) java/lang/Object
+ (:as java/lang/Object value))
+
+ (net/sandius/rembulan/impl/DefaultTable
+ [] (rawlen self) long
+ (|> value array.size (:as java/lang/Long)))
+
+ (net/sandius/rembulan/impl/DefaultTable
+ [] (rawget self {idx long}) java/lang/Object
+ (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap))
+
+ (net/sandius/rembulan/impl/DefaultTable
+ [] (rawget self {field java/lang/Object}) java/lang/Object
+ (case (ffi.check net/sandius/rembulan/ByteString field)
+ (#.Some field)
+ (case (net/sandius/rembulan/ByteString::decode field)
+ (^ (static runtime.variant_tag_field))
+ (|> value (array.read! 0) maybe.trusted)
+
+ (^ (static runtime.variant_flag_field))
+ (case (array.read! 1 value)
+ (#.Some _)
+ (:as java/lang/Object "")
+
+ #.None
+ (ffi.null))
+
+ (^ (static runtime.variant_value_field))
+ (|> value (array.read! 2) maybe.trusted re_wrap)
+
+ _
+ (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/Object field)])))
+
+ #.None
+ (case (ffi.check java/lang/Long field)
+ (#.Some idx)
+ (|> value (array.read! (|> idx (:as Nat) --)) maybe.trusted re_wrap)
+
+ #.None
+ (panic! (exception.error ..unknown_kind_of_object [(:as java/lang/Object field)])))))
+ ))))
+
+ (type: Translator
+ (-> java/lang/Object (Try Any)))
+
+ (def: (read_variant read host_object)
+ (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
+ (case [(net/sandius/rembulan/Table::get_key (:as java/lang/Object runtime.variant_tag_field) host_object)
+ (net/sandius/rembulan/Table::get_key (:as java/lang/Object runtime.variant_flag_field) host_object)
+ (net/sandius/rembulan/Table::get_key (:as java/lang/Object runtime.variant_value_field) host_object)]
+ (^multi [(#.Some tag) ?flag (#.Some value)]
+ {(read value)
+ (#try.Success value)})
+ (#try.Success [(: Any (|> tag (:as java/lang/Long) java/lang/Long::intValue))
+ (: Any (case ?flag
+ (#.Some _) (: Any "")
+ #.None (:as Any (ffi.null))))
+ (: Any value)])
+
+ _
+ (exception.except ..unknown_kind_of_object [(:as java/lang/Object host_object)])))
+
+ (def: (read_tuple read host_object)
+ (-> Translator net/sandius/rembulan/impl/DefaultTable (Try Any))
+ (let [init_num_keys (.nat (net/sandius/rembulan/Table::rawlen host_object))]
+ (loop [num_keys init_num_keys
+ idx 0
+ output (: (Array java/lang/Object)
+ (array.empty init_num_keys))]
+ (if (n.< num_keys idx)
+ (case (net/sandius/rembulan/Table::get_idx (:as java/lang/Long (++ idx)) host_object)
+ #.None
+ (recur num_keys (++ idx) output)
+
+ (#.Some member)
+ (case (read member)
+ (#try.Success parsed_member)
+ (recur num_keys (++ idx) (array.write! idx (:as java/lang/Object parsed_member) output))
+
+ (#try.Failure error)
+ (#try.Failure error)))
+ (#try.Success output)))))
+
+ (exception: .public nil_has_no_lux_representation)
+
+ (def: (read host_object)
+ Translator
+ (`` (<| (if (ffi.null? host_object)
+ (exception.except ..nil_has_no_lux_representation []))
+ (~~ (template [<class> <post_processing>]
+ [(case (ffi.check <class> host_object)
+ (#.Some typed_object)
+ (|> typed_object <post_processing>)
+
+ _)]
+
+ [java/lang/Boolean #try.Success]
+ [java/lang/Long #try.Success]
+ [java/lang/Double #try.Success]
+ [java/lang/String #try.Success]
+ [net/sandius/rembulan/runtime/LuaFunction #try.Success]
+ [net/sandius/rembulan/ByteString (<| #try.Success net/sandius/rembulan/ByteString::decode)]
+ [program/StructureValue (<| #try.Success program/StructureValue::getValue)]
+ ))
+ (case (ffi.check net/sandius/rembulan/impl/DefaultTable host_object)
+ (#.Some typed_object)
+ (case (read_variant read typed_object)
+ (#try.Success value)
+ (#try.Success value)
+
+ (#try.Failure error)
+ (read_tuple read typed_object))
+
+ _)
+ (exception.except ..unknown_kind_of_object [host_object])
+ )))
+
+ (exception: (cannot_apply_a_non_function {object java/lang/Object})
+ (exception.report
+ ["Non-function" (java/lang/Object::toString object)]))
+
+ (def: ensure_function
+ (-> Macro (Maybe net/sandius/rembulan/runtime/LuaFunction))
+ (|>> (:as java/lang/Object) (ffi.check net/sandius/rembulan/runtime/LuaFunction)))
+
+ (type: Baggage
+ [net/sandius/rembulan/StateContext
+ net/sandius/rembulan/exec/DirectCallExecutor])
+
+ (def: (call_macro [state_context executor] inputs lux macro)
+ (-> Baggage (List Code) Lux net/sandius/rembulan/runtime/LuaFunction (Try Any))
(do try.monad
- [_ (run! content)]
- (run! (_.return (_.var (reference.artifact context))))))))))))})
-
-(for {@.old
- (as_is (exception: .public (invaid_phase_application {partial_application (List Any)}
- {arity Nat})
- (exception.report
- ["Partial Application" (%.nat (list.size partial_application))]
- ["Arity" (%.nat arity)]))
-
- (def: to_host
- (-> Any java/lang/Object)
- (|>> (:as (Array java/lang/Object)) ..lux_structure (:as java/lang/Object)))
-
- (def: (return ec value)
- (-> net/sandius/rembulan/runtime/ExecutionContext Any Any)
- (|> ec
- net/sandius/rembulan/runtime/ExecutionContext::getReturnBuffer
- (net/sandius/rembulan/runtime/ReturnBuffer::setTo (:as java/lang/Object value))))
-
- (def: (host_phase partial_application phase)
- (All [s i o]
- (-> (List Any) (Phase [extension.Bundle s] i o)
- java/lang/Object))
- (ffi.object [] net/sandius/rembulan/runtime/LuaFunction []
- []
- ... Methods
- (net/sandius/rembulan/runtime/LuaFunction
- [] (invoke self
- {% net/sandius/rembulan/runtime/ExecutionContext})
- void
- (<| (..return %)
- (host_phase partial_application phase)))
-
- (net/sandius/rembulan/runtime/LuaFunction
- [] (invoke self
- {% net/sandius/rembulan/runtime/ExecutionContext}
- {input/0 java/lang/Object})
- void
- (<| (..return %)
- try.trusted
- (do try.monad
- [input/0 (..read input/0)]
- (case partial_application
- (^ (list partial/0 partial/1))
- (wrap (..to_host ((:as (-> Any Any Any Any) phase)
- partial/0
- partial/1
- input/0)))
-
- (^ (list partial/0))
- (wrap (host_phase (list partial/0 input/0) phase))
-
- (^ (list))
- (wrap (host_phase (list input/0) phase))
-
- _
- (exception.throw ..invaid_phase_application [partial_application 2])))))
-
- (net/sandius/rembulan/runtime/LuaFunction
- [] (invoke self
- {% net/sandius/rembulan/runtime/ExecutionContext}
- {input/0 java/lang/Object}
- {input/1 java/lang/Object})
- void
- (<| (..return %)
- try.trusted
- (do try.monad
- [input/0 (..read input/0)
- input/1 (..read input/1)]
- (case partial_application
- (^ (list partial/0))
- (wrap (..to_host ((:as (-> Any Any Any Any) phase)
- partial/0
- input/0
- input/1)))
-
- (^ (list))
- (wrap (host_phase (list input/0 input/1) phase))
-
- _
- (exception.throw ..invaid_phase_application [partial_application 2])))))
-
- (net/sandius/rembulan/runtime/LuaFunction
- [] (invoke self
- {% net/sandius/rembulan/runtime/ExecutionContext}
- {input/0 java/lang/Object}
- {input/1 java/lang/Object}
- {input/2 java/lang/Object})
- void
- (<| (..return %)
- try.trusted
- (do try.monad
- [input/0 (..read input/0)
- input/1 (..read input/1)
- input/2 (..read input/2)]
- (case partial_application
- (^ (list))
- (wrap (..to_host ((:as (-> Any Any Any Any) phase)
- input/0
- input/1
- input/2)))
-
- _
- (exception.throw ..invaid_phase_application [partial_application 3])))))))
-
- (def: (extender [state_context executor] phase_wrapper)
- (-> Baggage (-> platform.Phase_Wrapper Extender))
- ... TODO: Stop relying on coercions ASAP.
- (<| (:as Extender)
- (function (@self handler))
- (:as Handler)
- (function (@self name phase))
- (:as Phase)
- (function (@self archive parameters))
- (:as Operation)
- (function (@self state))
- (:as Try)
- try.trusted
- (:as Try)
- (do try.monad
- [handler (try.of_maybe (..ensure_function handler))
- output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
- (:as java/lang/Object handler)
- (|> (array.new 5)
- (array.write! 0 name)
- (array.write! 1 (:as java/lang/Object (phase_wrapper phase)))
- (array.write! 2 (..to_host archive))
- (array.write! 3 (..to_host parameters))
- (array.write! 4 (..to_host state)))
- executor)]
- (|> output
- (array.read! 0)
- maybe.trusted
- (:as java/lang/Object)
- ..read)))))
-
- @.lua
- (def: (extender phase_wrapper handler)
- (-> platform.Phase_Wrapper Extender)
- (:expected handler))})
+ [output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
+ (:as java/lang/Object macro)
+ (|> (array.empty 2)
+ (array.write! 0 ... (:as java/lang/Object inputs)
+ ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
+ (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) inputs))))
+ (array.write! 1 ... (:as java/lang/Object lux)
+ ... (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new))
+ (:as java/lang/Object (lux_structure (:as (Array java/lang/Object) lux)))))
+ executor)]
+ (|> output (array.read! 0) maybe.trusted (:as java/lang/Object) ..read)))
+
+ (def: (expander baggage macro inputs lux)
+ (-> Baggage Expander)
+ (case (..ensure_function macro)
+ (#.Some macro)
+ (case (..call_macro baggage inputs lux macro)
+ (#try.Success output)
+ (|> output
+ (:as (Try [Lux (List Code)]))
+ #try.Success)
+
+ (#try.Failure error)
+ (#try.Failure error))
+
+ #.None
+ (exception.except ..cannot_apply_a_non_function (:as java/lang/Object macro)))))]
+ (for {@.old (as_is <jvm>)
+ @.jvm (as_is <jvm>)
+
+ @.lua
+ (def: (expander macro inputs lux)
+ Expander
+ (#try.Success ((:as Macro' macro) inputs lux)))}))
+
+(with_expansions [<jvm> (as_is (with_expansions [$var_args (_.var "...")
+ $str_rel_to_abs (_.var "_utf8_str_rel_to_abs")
+ $decode (_.var "_utf8_decode")]
+ (template.let [(!int <hex>)
+ [(_.int (.int (hex <hex>)))]
+
+ (!&| <or> <and> <raw>)
+ [(|> <raw>
+ (_.bit_and (!int <and>))
+ (_.bit_or (!int <or>)))]
+
+ (!&|< <or> <and> <shift> <raw>)
+ [(|> <raw>
+ (_.bit_shr (_.int <shift>))
+ (_.bit_and (!int <and>))
+ (_.bit_or (!int <or>)))]]
+ (as_is (def: rembulan//char
+ (let [$buffer (_.var "buffer")
+ $k (_.var "k")
+ $v (_.var "v")
+ $b1 (_.var "b1")
+ $b2 (_.var "b2")
+ $b3 (_.var "b3")
+ $b4 (_.var "b4")
+ table/insert (_.apply/2 (_.var "table.insert"))]
+ (_.function (_.var "utf8.char") (list $var_args)
+ ($_ _.then
+ (_.local/1 $buffer (_.array (list)))
+ (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args))))
+ ($_ _.then
+ (_.when (_.or (_.< (_.int +0) $v)
+ (_.> (!int "10FFFF") $v))
+ (_.statement (_.error/2 (|> (_.string "bad argument #")
+ (_.concat $k)
+ (_.concat (_.string " to char (out of range)")))
+ (_.int +2))))
+ (<| (_.if (_.< (!int "80") $v)
+ ... Single-byte sequence
+ (_.statement (|> (_.var "string.char")
+ (_.apply/* (list $v))
+ (table/insert $buffer))))
+ (_.if (_.< (!int "800") $v)
+ ... Two-byte sequence
+ (_.statement (|> (_.var "string.char")
+ (_.apply/* (list (!&|< "C0" "1F" +6 $v)
+ (!&| "80" "3F" $v)))
+ (table/insert $buffer))))
+ (_.if (_.< (!int "10000") $v)
+ ... Three-byte sequence
+ (_.statement (|> (_.var "string.char")
+ (_.apply/* (list (!&|< "E0" "0F" +12 $v)
+ (!&|< "80" "3F" +6 $v)
+ (!&| "80" "3F" $v)))
+ (table/insert $buffer))))
+ ... Four-byte sequence
+ (_.statement (|> (_.var "string.char")
+ (_.apply/* (list (!&|< "F0" "07" +18 $v)
+ (!&|< "80" "3F" +12 $v)
+ (!&|< "80" "3F" +6 $v)
+ (!&| "80" "3F" $v)))
+ (table/insert $buffer))))
+ ))
+ (_.return (_.apply/2 (_.var "table.concat") $buffer (_.string "")))
+ ))))
+
+ ... (def: rembulan//str_rel_to_abs
+ ... (let [$string (_.var "string")
+ ... $args (_.var "args")
+ ... $k (_.var "k")
+ ... $v (_.var "v")]
+ ... (<| (_.local_function $str_rel_to_abs (list $string $var_args))
+ ... ($_ _.then
+ ... (_.local/1 $args (_.array (list $var_args)))
+ ... (<| (_.for_in (list $k $v) (_.ipairs/1 $args))
+ ... ($_ _.then
+ ... (_.if (_.> (_.int +0) $v)
+ ... (_.set (list $v) $v)
+ ... (_.set (list $v) (|> $v (_.+ (_.length $string)) (_.+ (_.int +1)))))
+ ... (_.when (_.or (_.< (_.int +1) $v)
+ ... (_.> (_.length $string) $v))
+ ... (_.statement (_.error/2 (_.string "bad index to string (out of range)") (_.int +3))))
+ ... (_.set (list (_.nth $k $args)) $v)))
+ ... (_.return (_.apply/1 (_.var "table.unpack") $args))
+ ... ))))
+
+ ... (def: rembulan//decode
+ ... (let [$string (_.var "string")
+ ... $start (_.var "start")
+ ... $b1 (_.var "b1")
+ ... $idx (_.var "idx")
+ ... $bx (_.var "bx")
+ ... $end (_.var "_end")]
+ ... (<| (_.local_function $decode (list $string $start))
+ ... ($_ _.then
+ ... (_.set (list $start) (_.apply/2 $str_rel_to_abs $string (_.or (_.int +1) $start)))
+ ... (_.local/1 $b1 (_.do "byte" (list $start $start) $string))
+ ... (<| (_.if (_.< (!int "80") $b1)
+ ... ... Single-byte sequence
+ ... (_.return (_.multi (list $start $start))))
+ ... ... Validate first byte of multi-byte sequence
+ ... (_.if (_.or (_.> (!int "F4") $b1)
+ ... (_.< (!int "C2") $b1))
+ ... (_.return _.nil))
+ ... ... Get 'supposed' amount of continuation bytes from primary byte
+ ... ($_ _.then
+ ... (_.local/1 $end (|> (|> $b1 (_.>= (!int "F0")) (_.and (_.int +3)))
+ ... (_.or (|> $b1 (_.>= (!int "E0")) (_.and (_.int +2))))
+ ... (_.or (|> $b1 (_.>= (!int "C0")) (_.and (_.int +1))))
+ ... (_.+ $start)))
+ ... ... Validate our continuation bytes
+ ... (<| (_.for_in (list $idx $bx) (_.ipairs/1 (_.array (list (_.do "byte"
+ ... (list (_.+ (_.int +1) $start) $end)
+ ... $string)))))
+ ... (_.when (|> $bx
+ ... (_.bit_and (!int "C0"))
+ ... (_.= (!int "80"))
+ ... _.not)
+ ... (_.return _.nil)))
+ ... (_.return (_.multi (list $start $end)))
+ ... ))
+ ... ))))
+
+ ... (def: rembulan//codes
+ ... (let [$string (_.var "string")
+ ... $i (_.var "i")
+ ... $start (_.var "start")
+ ... $end (_.var "_end")]
+ ... (_.function (_.var "utf8.codes") (list $string)
+ ... ($_ _.then
+ ... (_.local/1 $i (_.int +1))
+ ... (_.return (<| (_.closure (list))
+ ... (_.if (_.> (_.length $string) $i)
+ ... (_.return _.nil)
+ ... ($_ _.then
+ ... (_.let (list $start $end) (_.apply/2 $decode $string $i))
+ ... (_.if (_.not $start)
+ ... (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2)))
+ ... ($_ _.then
+ ... (_.set (list $i) (_.+ (_.int +1) $end))
+ ... (_.return (_.multi (list $start (_.do "sub" (list $start $end) $string))))
+ ... ))
+ ... ))))
+ ... ))))
+
+ ... (def: rembulan//len
+ ... (let [$string (_.var "string")
+ ... $start (_.var "start")
+ ... $end (_.var "_end")
+ ... $seq_start (_.var "seq_start")
+ ... $seq_end (_.var "seq_end")
+ ... $size (_.var "size")]
+ ... (_.function (_.var "utf8.len") (list $string $start $end)
+ ... ($_ _.then
+ ... (_.set (list $start $end) (_.apply/3 $str_rel_to_abs $string (_.or (_.int +1) $start) (_.or (_.int -1) $end)))
+ ... (_.local/1 $size (_.int +0))
+ ... (_.repeat (_.>= $end $seq_end)
+ ... ($_ _.then
+ ... (_.let (list $seq_start $seq_end) (_.apply/2 $decode $string $start))
+ ... (_.if (_.not $seq_start)
+ ... ... Hit an invalid sequence!
+ ... (_.return (_.multi (list (_.bool false) $start)))
+ ... ($_ _.then
+ ... (_.set (list $start) (_.+ (_.int +1) $seq_end))
+ ... (_.set (list $size) (_.+ (_.int +1) $size))
+ ... ))
+ ... ))
+ ... (_.return $size)
+ ... ))))
+
+ ... (def: rembulan//charpattern
+ ... (_.set (list (_.var "utf8.charpattern"))
+ ... (_.string "[%z\x01-\x7F\xC2-\xF4][\x80-\xBF]*")))
+
+ (def: rembulan_prelude
+ _.Statement
+ ($_ _.then
+ (_.function (_.var "os.time") (list)
+ (_.return (_.int +0)))
+
+ ... Ported from https://github.com/meepen/Lua-5.1-UTF-8
+ ..rembulan//char
+ ... ..rembulan//str_rel_to_abs
+ ... ..rembulan//decode
+ ... ..rembulan//codes
+ ... ..rembulan//len
+ ... ..rembulan//charpattern
+ )))))
+
+ (def: host
+ (IO [Baggage (Host _.Expression _.Statement)])
+ (io (let [runtime_env (net/sandius/rembulan/env/RuntimeEnvironments::system)
+ std_lib (net/sandius/rembulan/lib/StandardLibrary::in runtime_env)
+ state_context (net/sandius/rembulan/impl/StateContexts::newDefaultInstance)
+ table (net/sandius/rembulan/lib/StandardLibrary::installInto state_context std_lib)
+ variable (net/sandius/rembulan/Variable::new table)
+ loader (net/sandius/rembulan/compiler/CompilerChunkLoader::of "_lux_definition")
+ executor (net/sandius/rembulan/exec/DirectCallExecutor::newExecutor)
+ scheduling_context (net/sandius/rembulan/exec/DirectCallExecutor::schedulingContextFactory executor)
+ run! (: (-> _.Statement (Try Any))
+ (function (_ code)
+ (do try.monad
+ [lua_function (net/sandius/rembulan/load/ChunkLoader::loadTextChunk variable "lux compilation" (_.code code) loader)
+ output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context (:as java/lang/Object lua_function) (array.empty 0)
+ executor)]
+ (case (array.read! 0 output)
+ #.None
+ (in [])
+
+ (#.Some value)
+ (read value)))))
+ _ (try.trusted (run! ..rembulan_prelude))]
+ [[state_context executor]
+ (: (Host _.Expression _.Statement)
+ (implementation
+ (def: (evaluate! context code)
+ (run! (_.return code)))
+
+ (def: execute! run!)
+
+ (def: (define! context custom input)
+ (let [global (maybe.else (reference.artifact context)
+ custom)
+ @global (_.var global)]
+ (do try.monad
+ [.let [definition (_.set (list @global) input)]
+ _ (run! definition)
+ value (run! (_.return @global))]
+ (in [global value definition]))))
+
+ (def: (ingest context content)
+ (|> content (\ utf8.codec decoded) try.trusted (:as _.Statement)))
+
+ (def: (re_learn context custom content)
+ (run! content))
+
+ (def: (re_load context custom content)
+ (do try.monad
+ [_ (run! content)]
+ (run! (_.return (_.var (reference.artifact context))))))))]))))]
+ (for {@.old (as_is <jvm>)
+ @.jvm (as_is <jvm>)
+ @.lua (as_is (ffi.import: (load [ffi.String] #try ffi.Function))
+ (def: host
+ (IO (Host _.Expression _.Statement))
+ (io (let [run! (: (-> _.Statement (Try Any))
+ (function (_ code)
+ (do try.monad
+ [lua_function (..load (_.code code))]
+ (let [output ("lua apply" lua_function)]
+ (#try.Success (if ("lua object nil?" output)
+ []
+ output))))))]
+ (: (Host _.Expression _.Statement)
+ (implementation
+ (def: (evaluate! context code)
+ (run! (_.return code)))
+
+ (def: execute! run!)
+
+ (def: (define! context custom input)
+ (let [global (maybe.else (reference.artifact context)
+ custom)
+ @global (_.var global)]
+ (do try.monad
+ [.let [definition (_.set (list @global) input)]
+ _ (run! definition)
+ value (run! (_.return @global))]
+ (in [global value definition]))))
+
+ (def: (ingest context content)
+ (|> content (\ utf8.codec decoded) try.trusted (:as _.Statement)))
+
+ (def: (re_learn context custom content)
+ (run! content))
+
+ (def: (re_load context custom content)
+ (do try.monad
+ [_ (run! content)]
+ (run! (_.return (_.var (reference.artifact context))))))))))))}))
+
+(with_expansions [<jvm> (as_is (exception: .public (invaid_phase_application {partial_application (List Any)}
+ {arity Nat})
+ (exception.report
+ ["Partial Application" (%.nat (list.size partial_application))]
+ ["Arity" (%.nat arity)]))
+
+ (def: to_host
+ (-> Any java/lang/Object)
+ (|>> (:as (Array java/lang/Object)) ..lux_structure (:as java/lang/Object)))
+
+ (def: (return ec value)
+ (-> net/sandius/rembulan/runtime/ExecutionContext Any Any)
+ (|> ec
+ net/sandius/rembulan/runtime/ExecutionContext::getReturnBuffer
+ (net/sandius/rembulan/runtime/ReturnBuffer::setTo (:as java/lang/Object value))))
+
+ (def: (host_phase partial_application phase)
+ (All [s i o]
+ (-> (List Any) (Phase [extension.Bundle s] i o)
+ java/lang/Object))
+ (ffi.object [] net/sandius/rembulan/runtime/LuaFunction []
+ []
+ ... Methods
+ (net/sandius/rembulan/runtime/LuaFunction
+ [] (invoke self
+ {% net/sandius/rembulan/runtime/ExecutionContext})
+ void
+ (<| (..return %)
+ (host_phase partial_application phase)))
+
+ (net/sandius/rembulan/runtime/LuaFunction
+ [] (invoke self
+ {% net/sandius/rembulan/runtime/ExecutionContext}
+ {input/0 java/lang/Object})
+ void
+ (<| (..return %)
+ try.trusted
+ (do try.monad
+ [input/0 (..read input/0)]
+ (case partial_application
+ (^ (list partial/0 partial/1))
+ (in (..to_host ((:as (-> Any Any Any Any) phase)
+ partial/0
+ partial/1
+ input/0)))
+
+ (^ (list partial/0))
+ (in (host_phase (list partial/0 input/0) phase))
+
+ (^ (list))
+ (in (host_phase (list input/0) phase))
+
+ _
+ (exception.except ..invaid_phase_application [partial_application 2])))))
+
+ (net/sandius/rembulan/runtime/LuaFunction
+ [] (invoke self
+ {% net/sandius/rembulan/runtime/ExecutionContext}
+ {input/0 java/lang/Object}
+ {input/1 java/lang/Object})
+ void
+ (<| (..return %)
+ try.trusted
+ (do try.monad
+ [input/0 (..read input/0)
+ input/1 (..read input/1)]
+ (case partial_application
+ (^ (list partial/0))
+ (in (..to_host ((:as (-> Any Any Any Any) phase)
+ partial/0
+ input/0
+ input/1)))
+
+ (^ (list))
+ (in (host_phase (list input/0 input/1) phase))
+
+ _
+ (exception.except ..invaid_phase_application [partial_application 2])))))
+
+ (net/sandius/rembulan/runtime/LuaFunction
+ [] (invoke self
+ {% net/sandius/rembulan/runtime/ExecutionContext}
+ {input/0 java/lang/Object}
+ {input/1 java/lang/Object}
+ {input/2 java/lang/Object})
+ void
+ (<| (..return %)
+ try.trusted
+ (do try.monad
+ [input/0 (..read input/0)
+ input/1 (..read input/1)
+ input/2 (..read input/2)]
+ (case partial_application
+ (^ (list))
+ (in (..to_host ((:as (-> Any Any Any Any) phase)
+ input/0
+ input/1
+ input/2)))
+
+ _
+ (exception.except ..invaid_phase_application [partial_application 3])))))))
+
+ (def: (extender [state_context executor] phase_wrapper)
+ (-> Baggage (-> phase.Wrapper Extender))
+ ... TODO: Stop relying on coercions ASAP.
+ (<| (:as Extender)
+ (function (@self handler))
+ (:as Handler)
+ (function (@self name phase))
+ (:as Phase)
+ (function (@self archive parameters))
+ (:as Operation)
+ (function (@self state))
+ (:as Try)
+ try.trusted
+ (:as Try)
+ (do try.monad
+ [handler (try.of_maybe (..ensure_function handler))
+ output (net/sandius/rembulan/exec/DirectCallExecutor::call state_context
+ (:as java/lang/Object handler)
+ (|> (array.empty 5)
+ (array.write! 0 name)
+ (array.write! 1 (:as java/lang/Object (phase_wrapper phase)))
+ (array.write! 2 (..to_host archive))
+ (array.write! 3 (..to_host parameters))
+ (array.write! 4 (..to_host state)))
+ executor)]
+ (|> output
+ (array.read! 0)
+ maybe.trusted
+ (:as java/lang/Object)
+ ..read)))))]
+ (for {@.old (as_is <jvm>)
+ @.jvm (as_is <jvm>)
+
+ @.lua
+ (def: (extender phase_wrapper handler)
+ (-> phase.Wrapper Extender)
+ (:expected handler))}))
(def: (phase_wrapper archive)
- (-> Archive (runtime.Operation platform.Phase_Wrapper))
+ (-> Archive (runtime.Operation phase.Wrapper))
(do phase.monad
[]
- (wrap (:as platform.Phase_Wrapper
- (for {@.old (..host_phase (list))
- @.lua (|>>)})))))
-
-(for {@.old (def: platform
- (IO [Baggage (Platform [Register _.Label] _.Expression _.Statement)])
- (do io.monad
- [[baggage host] ..host]
- (wrap [baggage
- {#platform.&file_system (file.async file.default)
- #platform.host host
- #platform.phase lua.generate
- #platform.runtime runtime.generate
- #platform.phase_wrapper ..phase_wrapper
- #platform.write (|>> _.code (\ utf8.codec encoded))}])))
- @.lua (def: platform
- (IO (Platform [Register _.Label] _.Expression _.Statement))
- (do io.monad
- [host ..host]
- (wrap {#platform.&file_system (file.async file.default)
+ (in (:as phase.Wrapper
+ (for {@.old (..host_phase (list))
+ @.jvm (..host_phase (list))
+ @.lua (|>>)})))))
+
+(with_expansions [<jvm> (def: platform
+ (IO [Baggage (Platform [Register _.Label] _.Expression _.Statement)])
+ (do io.monad
+ [[baggage host] ..host]
+ (in [baggage
+ {#platform.&file_system (file.async file.default)
+ #platform.host host
+ #platform.phase lua.generate
+ #platform.runtime runtime.generate
+ #platform.phase_wrapper ..phase_wrapper
+ #platform.write (|>> _.code (\ utf8.codec encoded))}])))]
+ (for {@.old <jvm>
+ @.jvm <jvm>
+ @.lua (def: platform
+ (IO (Platform [Register _.Label] _.Expression _.Statement))
+ (do io.monad
+ [host ..host]
+ (in {#platform.&file_system (file.async file.default)
#platform.host host
#platform.phase lua.generate
#platform.runtime runtime.generate
#platform.phase_wrapper ..phase_wrapper
- #platform.write (|>> _.code (\ utf8.codec encoded))})))})
+ #platform.write (|>> _.code (\ utf8.codec encoded))})))}))
(def: (program context program)
(Program _.Expression _.Statement)
@@ -804,6 +815,7 @@
(let [extension ".lua"]
(do io.monad
[(~~ (for {@.old [baggage platform]
+ @.jvm [baggage platform]
@.lua platform}))
..platform]
(exec (do async.monad
@@ -812,14 +824,18 @@
#/static.target (/cli.target service)
#/static.artifact_extension extension}
(for {@.old (..expander baggage)
+ @.jvm (..expander baggage)
@.lua ..expander})
analysis.bundle
(io.io platform)
generation.bundle
(function.constant extension/bundle.empty)
..program
- [(& Register _.Label) _.Expression _.Statement]
+ [(type [Register _.Label])
+ _.Expression
+ _.Statement]
(for {@.old (..extender baggage)
+ @.jvm (..extender baggage)
@.lua ..extender})
service
[(packager.package (_.manual "")