diff options
Diffstat (limited to '')
7 files changed, 301 insertions, 93 deletions
diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index 180757de6..0dc8c5564 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -20,7 +20,7 @@ [macro ["." template]] [math - [number + [number (#+ hex) ["n" nat] ["." i64]]] ["." world #_ @@ -329,55 +329,244 @@ Expander (#try.Success ((:coerce Macro' macro) inputs lux)))}) -(for {@.old (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) +(for {@.old (as_is (with_expansions [$var_args (_.var "...") + $str_rel_to_abs (_.var "_utf8_str_rel_to_abs") + $decode (_.var "_utf8_decode")] + (template.with [(!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 (:coerce java/lang/Object lua_function) (array.new 0) + executor)] + (case (array.read 0 output) + #.None + (wrap []) + + (#.Some value) + (read value))))) + _ (try.assume (run! ..rembulan_prelude))] + [[state_context executor] + (: (Host _.Expression _.Statement) + (structure + (def: (evaluate! context code) + (run! (_.return code))) + + (def: execute! run!) + + (def: (define! context input) + (let [global (reference.artifact context) + @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 (\ encoding.utf8 decode) try.assume (:coerce _.Statement))) + + (def: (re_learn context content) + (run! content)) + + (def: (re_load context content) (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 (:coerce java/lang/Object lua_function) (array.new 0) - executor)] - (case (array.read 0 output) - #.None - (wrap []) - - (#.Some value) - (read value)))))] - [[state_context executor] - (: (Host _.Expression _.Statement) - (structure - (def: (evaluate! context code) - (run! (_.return code))) - - (def: execute! run!) - - (def: (define! context input) - (let [global (reference.artifact context) - @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 (\ encoding.utf8 decode) try.assume (:coerce _.Statement))) - - (def: (re_learn context content) - (run! content)) - - (def: (re_load context content) - (do try.monad - [_ (run! content)] - (run! (_.return (_.var (reference.artifact context))))))))]))) + [_ (run! content)] + (run! (_.return (_.var (reference.artifact context))))))))])))) @.lua (as_is (host.import: (load [host.String] #try host.Function)) (def: host (IO (Host _.Expression _.Statement)) diff --git a/stdlib/source/lux/target/lua.lux b/stdlib/source/lux/target/lua.lux index c557c7feb..29d4b82b3 100644 --- a/stdlib/source/lux/target/lua.lux +++ b/stdlib/source/lux/target/lua.lux @@ -297,6 +297,13 @@ (..nest (:representation body!)) text.new_line "end"))) + (def: #export (repeat until body!) + (-> Expression Statement Statement) + (:abstraction + (format "repeat" + (..nest (:representation body!)) + text.new_line "until " (:representation until)))) + (def: #export (for_in vars source body!) (-> (List Var) Expression Statement Statement) (:abstraction @@ -396,10 +403,12 @@ [["error"] ["print"] ["require"] - ["type"]]] + ["type"] + ["ipairs"]]] [2 - [["print"]]] + [["print"] + ["error"]]] [3 [["print"]]] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index ba12035c7..29d3704fe 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -104,13 +104,10 @@ (/.install "-" (binary (product.uncurry _.-))) (/.install "<" (binary (product.uncurry _.<))) (/.install "*" (binary (product.uncurry _.*))) - (/.install "/" (binary (product.uncurry _.//))) - (/.install "%" (binary (product.uncurry _.%))) + (/.install "/" (binary (product.uncurry //runtime.i64//division))) + (/.install "%" (binary (product.uncurry //runtime.i64//remainder))) (/.install "f64" (unary (_./ (_.float +1.0)))) - (/.install "char" (unary //runtime.i64//char)) - ## TODO: Use version below once the Lua compiler becomes self-hosted. - ## (/.install "char" (unary (for {@.lua (!unary "utf8.char")} - ## (!unary "string.char")))) + (/.install "char" (unary (_.apply/1 (_.var "utf8.char")))) ))) (def: f64//decode @@ -129,7 +126,7 @@ (/.install "=" (binary (product.uncurry _.=))) (/.install "<" (binary (product.uncurry _.<))) (/.install "i64" (unary (!unary "math.floor"))) - (/.install "encode" (unary (_.apply/2 (_.var "string.format") (_.string "%.17f")))) + (/.install "encode" (unary (_.apply/2 (_.var "string.format") (_.string "%.17g")))) (/.install "decode" (unary ..f64//decode))))) (def: (text//char [paramO subjectO]) @@ -171,7 +168,9 @@ (|> /.empty (/.install "log" (unary ..io//log!)) (/.install "error" (unary (!unary "error"))) - (/.install "current-time" (nullary (function.constant (//runtime.io//current_time //runtime.unit))))))) + (/.install "current-time" (nullary (function.constant (|> (_.var "os.time") + (_.apply/* (list)) + (_.* (_.int +1,000))))))))) (def: #export bundle Bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 90cafc75b..b87390e9a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -108,7 +108,7 @@ (/.install "+" (binary (product.uncurry (..capped _.+)))) (/.install "-" (binary (product.uncurry (..capped _.-)))) (/.install "*" (binary (product.uncurry (..capped _.*)))) - (/.install "/" (binary (product.uncurry _.//))) + (/.install "/" (binary (product.uncurry //runtime.i64//division))) (/.install "%" (binary (product.uncurry //runtime.i64//remainder))) (/.install "f64" (unary _.float/1)) (/.install "char" (unary //runtime.i64//char)) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index 503969782..14d206e23 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -274,25 +274,31 @@ (_.bit_shr param) (_.bit_and mask)))))) -## TODO: Remove this once the Lua compiler becomes self-hosted. -(def: on_rembulan? - (_.= (_.string "Lua 5.3") - (_.var "_VERSION"))) - -(runtime: (i64//char subject) - (with_expansions [<rembulan> (_.return (_.apply/1 (_.var "string.char") subject)) - <normal> (_.return (_.apply/1 (_.var "utf8.char") subject))] - (for {@.lua (_.return <normal>)} - (_.if ..on_rembulan? - <rembulan> - <normal>)))) +(runtime: (i64//division param subject) + (with_vars [floored] + ($_ _.then + (_.local/1 floored (_.// param subject)) + (let [potentially_floored? (_.< (_.int +0) floored) + inexact? (|> floored + (_.* param) + (_.= subject) + _.not)] + (_.if (_.and potentially_floored? + inexact?) + (_.return (_.+ (_.int +1) floored)) + (_.return floored)))))) + +(runtime: (i64//remainder param subject) + (_.return (_.- (|> subject (..i64//division param) (_.* param)) + subject))) (def: runtime//i64 Statement ($_ _.then @i64//left_shift @i64//right_shift - @i64//char + @i64//division + @i64//remainder )) (def: (find_byte_index subject param start) @@ -314,6 +320,11 @@ (-> Expression Expression) (_.- (_.int +1))) +## TODO: Remove this once the Lua compiler becomes self-hosted. +(def: on_rembulan? + (_.= (_.string "Lua 5.3") + (_.var "_VERSION"))) + (runtime: (text//index subject param start) (with_expansions [<rembulan> ($_ _.then (_.local/1 byte_index (|> start @@ -398,22 +409,6 @@ @array//write )) -(runtime: (io//current_time _) - (with_expansions [<rembulan> (_.return (_.int +0)) - <normal> (_.return (|> (_.var "os.time") - (_.apply/* (list)) - (_.* (_.int +1,000))))] - (for {@.lua <normal>} - (_.if ..on_rembulan? - <rembulan> - <normal>)))) - -(def: runtime//io - Statement - ($_ _.then - @io//current_time - )) - (def: runtime Statement ($_ _.then @@ -422,7 +417,6 @@ ..runtime//i64 ..runtime//text ..runtime//array - ..runtime//io )) (def: #export artifact ..prefix) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index a2e18808a..1af62cf7e 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -309,8 +309,22 @@ ..as_nat (_.bit_shr param)))) +(runtime: (i64//division param subject) + (with_vars [floored] + ($_ _.then + (_.set (list floored) (_.// param subject)) + (_.return (let [potentially_floored? (_.< (_.int +0) floored) + inexact? (|> floored + (_.* param) + (_.= subject) + _.not)] + (_.? (_.and potentially_floored? + inexact?) + (_.+ (_.int +1) floored) + floored)))))) + (runtime: (i64//remainder param subject) - (_.return (_.- (|> subject (_.// param) (_.* param)) + (_.return (_.- (|> subject (..i64//division param) (_.* param)) subject))) (template [<runtime> <python>] @@ -342,6 +356,7 @@ @i64//nat_top @i64//left_shift @i64//right_shift + @i64//division @i64//remainder @i64//and @i64//or diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index d032a47b5..67abd0eca 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -4,7 +4,8 @@ ["@" target ["." jvm] ["." js] - ["." python]] + ["." python] + ["." lua]] [abstract [monad (#+ do)]] [control @@ -63,7 +64,8 @@ (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) @.js (js.string self) - @.python (python.unicode self)}))))) + @.python (python.unicode self) + @.lua (lua.string self)}))))) (for {@.old (as_is)} |