diff options
Diffstat (limited to '')
37 files changed, 1848 insertions, 1851 deletions
diff --git a/.gitignore b/.gitignore index 47a05af09..8e75a4c6f 100644 --- a/.gitignore +++ b/.gitignore @@ -30,6 +30,11 @@ pom.xml.asc /lux-python/source/lux /lux-python/source/program +/lux-lua/target +/lux-lua/source/lux.lux +/lux-lua/source/lux +/lux-lua/source/program + /lux-ruby/target /lux-ruby/source/lux.lux /lux-ruby/source/lux @@ -55,6 +55,16 @@ cd ~/lux/lux-python/ && lein clean # Try cd ~/lux/lux-python/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +# Lua compiler + # Test + cd ~/lux/lux-lua/ && lein_2_7_1 lux auto test + cd ~/lux/lux-lua/ && lein clean && lein_2_7_1 lux auto test + # Build + cd ~/lux/lux-lua/ && lein_2_7_1 lux auto build + cd ~/lux/lux-lua/ && lein clean && lein_2_7_1 lux auto build + # Try + cd ~/lux/lux-lua/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux + # Ruby compiler # Test cd ~/lux/lux-ruby/ && lein_2_7_1 lux auto test diff --git a/lux-lua/project.clj b/lux-lua/project.clj new file mode 100644 index 000000000..62abfb470 --- /dev/null +++ b/lux-lua/project.clj @@ -0,0 +1,32 @@ +(def version "0.6.0-SNAPSHOT") +(def repo "https://github.com/LuxLang/lux") +(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/") +(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/") + +(defproject com.github.luxlang/lux-python #=(identity version) + :description "A Lua compiler for Lux." + :url ~repo + :license {:name "Lux License v0.1" + :url ~(str repo "/blob/master/license.txt")} + :scm {:name "git" + :url ~(str repo ".git")} + :pom-addition [:developers [:developer + [:name "Eduardo Julian"] + [:url "https://github.com/eduardoejp"]]] + + :repositories [["releases" ~sonatype-releases] + ["snapshots" ~sonatype-snapshots]] + :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}] + ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]] + + :plugins [[com.github.luxlang/lein-luxc ~version]] + :dependencies [[com.github.luxlang/luxc-jvm ~version] + [com.github.luxlang/stdlib ~version] + [net.sandius.rembulan/rembulan-runtime "0.1-SNAPSHOT"] + [net.sandius.rembulan/rembulan-stdlib "0.1-SNAPSHOT"] + [net.sandius.rembulan/rembulan-compiler "0.1-SNAPSHOT"]] + + :manifest {"lux" ~version} + :source-paths ["source"] + :lux {:program "program"} + ) diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux new file mode 100644 index 000000000..c49f15a4a --- /dev/null +++ b/lux-lua/source/program.lux @@ -0,0 +1,430 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + pipe + [cli (#+ program:)] + ["p" parser] + ["." exception (#+ exception:)] + ["." io (#+ IO io)]] + [data + ["." maybe] + ["." error (#+ Error)] + [number + ["." i64]] + ["." text ("#@." hash) + format] + [collection + ["." array (#+ Array)] + ["." list ("#@." functor)]]] + ["." macro + ["s" syntax (#+ syntax:)] + ["." code] + ["." template]] + [world + ["." file]] + ["." host (#+ import: interface: do-to object) + ["_" lua]] + [tool + [compiler + ["." name] + ["." synthesis] + [phase + [macro (#+ Expander)] + ["." generation + ["." lua + ["." runtime] + ["." extension]]]] + [default + ["." platform (#+ Platform)]]]]] + [program + ["/" compositor + ["/." cli]]]) + +(import: #long java/lang/String) + +(import: #long (java/lang/Class a) + (getCanonicalName [] java/lang/String)) + +(import: #long java/lang/Object + (new []) + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))) + +(import: #long java/lang/Integer + (longValue [] java/lang/Long)) + +(import: #long java/lang/Long + (intValue [] java/lang/Integer)) + +(import: #long java/lang/Number + (intValue [] java/lang/Integer) + (longValue [] long) + (doubleValue [] double)) + +(def: (inspect object) + (-> java/lang/Object Text) + (<| (case (host.check java/lang/Boolean object) + (#.Some value) + (%b value) + #.None) + (case (host.check java/lang/String object) + (#.Some value) + (%t value) + #.None) + (case (host.check java/lang/Long object) + (#.Some value) + (%i (.int value)) + #.None) + (case (host.check java/lang/Number object) + (#.Some value) + (%f (java/lang/Number::doubleValue value)) + #.None) + (case (host.check (Array java/lang/Object) object) + (#.Some value) + (let [value (:coerce (Array java/lang/Object) value)] + (case (array.read 0 value) + (^multi (#.Some tag) + [(host.check java/lang/Integer tag) + (#.Some tag)] + [[(array.read 1 value) + (array.read 2 value)] + [last? + (#.Some choice)]]) + (let [last? (case last? + (#.Some _) #1 + #.None #0)] + (|> (format (%n (.nat (java/lang/Integer::longValue tag))) + " " (%b last?) + " " (inspect choice)) + (text.enclose ["(" ")"]))) + + _ + (|> value + array.to-list + (list@map inspect) + (text.join-with " ") + (text.enclose ["[" "]"])))) + #.None) + (java/lang/Object::toString object))) + +(import: #long net/sandius/rembulan/StateContext) + +(import: #long net/sandius/rembulan/impl/StateContexts + (#static newDefaultInstance [] net/sandius/rembulan/StateContext)) + +(import: #long net/sandius/rembulan/env/RuntimeEnvironment) + +(import: #long net/sandius/rembulan/env/RuntimeEnvironments + (#static system [] net/sandius/rembulan/env/RuntimeEnvironment)) + +(import: #long net/sandius/rembulan/Table + (rawget #as get-idx [long] #? java/lang/Object) + (rawget #as get-key [java/lang/Object] #? java/lang/Object) + (rawlen [] long)) + +(import: #long net/sandius/rembulan/ByteString + (decode [] java/lang/String)) + +(import: #long net/sandius/rembulan/impl/DefaultTable) + +(import: #long net/sandius/rembulan/impl/ImmutableTable) + +(import: #long net/sandius/rembulan/impl/ImmutableTable$Builder + (new []) + (build [] net/sandius/rembulan/impl/ImmutableTable)) + +(import: #long 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)) + +(import: #long net/sandius/rembulan/Variable + (new [java/lang/Object])) + +(import: #long net/sandius/rembulan/runtime/LuaFunction) + +(import: #long net/sandius/rembulan/load/ChunkLoader + (loadTextChunk [net/sandius/rembulan/Variable + java/lang/String + java/lang/String] + net/sandius/rembulan/runtime/LuaFunction)) + +(import: #long net/sandius/rembulan/compiler/CompilerChunkLoader + (#static of [java/lang/String] net/sandius/rembulan/compiler/CompilerChunkLoader)) + +(import: #long net/sandius/rembulan/runtime/SchedulingContext) + +(import: #long net/sandius/rembulan/runtime/SchedulingContextFactory) + +(import: #long 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 + (Array java/lang/Object)] + #try (Array 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>] + [(interface: <name> + (getValue [] java/lang/Object)) + + (`` (import: #long (~~ (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 (host.check (Array java/lang/Object) unwrapped) + (#.Some sub-value) + (|> sub-value (:coerce (Array java/lang/Object)) lux-structure (:coerce java/lang/Object)) + + #.None + unwrapped))] + (object [] net/sandius/rembulan/impl/DefaultTable [program/StructureValue] + [] + ## Methods + (program/StructureValue + (getValue) + java/lang/Object + (:coerce (Array java/lang/Object) value)) + + (net/sandius/rembulan/impl/DefaultTable + (rawlen) + long + (|> value array.size (:coerce java/lang/Long))) + + (net/sandius/rembulan/impl/DefaultTable + (rawget {idx long}) + java/lang/Object + (|> value (array.read (|> idx (:coerce Nat) dec)) maybe.assume re-wrap)) + + (net/sandius/rembulan/impl/DefaultTable + (rawget {field java/lang/Object}) + java/lang/Object + (case (host.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.assume) + + (^ (static runtime.variant-flag-field)) + (case (array.read 1 value) + (#.Some _) + "" + + #.None + (host.null)) + + (^ (static runtime.variant-value-field)) + (|> value (array.read 2) maybe.assume re-wrap) + + _ + (error! (exception.construct unknown-kind-of-object field))) + + #.None + (case (host.check java/lang/Long field) + (#.Some idx) + (|> value (array.read (|> idx (:coerce Nat) dec)) maybe.assume re-wrap) + + #.None + (error! (exception.construct unknown-kind-of-object field))))) + ))) + +(type: Translator + (-> java/lang/Object (Error Any))) + +(def: (read-variant read host-object) + (-> Translator net/sandius/rembulan/impl/DefaultTable (Error 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)]) + (#error.Success [(java/lang/Long::intValue (:coerce java/lang/Long tag)) + (: Any (case ?flag (#.Some _) "" #.None (host.null))) + value]) + + _ + (exception.throw ..unknown-kind-of-object host-object))) + +(def: (read-tuple read host-object) + (-> Translator net/sandius/rembulan/impl/DefaultTable (Error 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 (:coerce java/lang/Long (inc idx)) host-object) + #.None + (recur num-keys (inc idx) output) + + (#.Some member) + (case (read member) + (#error.Success parsed-member) + (recur num-keys (inc idx) (array.write idx (:coerce java/lang/Object parsed-member) output)) + + (#error.Failure error) + (#error.Failure error))) + (#error.Success output))))) + +(exception: #export nil-has-no-lux-representation) + +(def: (read host-object) + Translator + (`` (<| (if (host.null? host-object) + (exception.throw nil-has-no-lux-representation [])) + (~~ (template [<class> <post-processing>] + [(case (host.check <class> host-object) + (#.Some typed-object) + (|> typed-object <post-processing>) + + _)] + + [java/lang/Boolean #error.Success] + [java/lang/Long #error.Success] + [java/lang/Double #error.Success] + [java/lang/String #error.Success] + [net/sandius/rembulan/runtime/LuaFunction #error.Success] + [net/sandius/rembulan/ByteString (<| #error.Success net/sandius/rembulan/ByteString::decode)] + [program/StructureValue (<| #error.Success program/StructureValue::getValue)] + )) + (case (host.check net/sandius/rembulan/impl/DefaultTable host-object) + (#.Some typed-object) + (case (read-variant read typed-object) + (#error.Success value) + (#error.Success value) + + (#error.Failure error) + (case (read-tuple read typed-object) + (#error.Success value) + (#error.Success value) + + (#error.Failure error) + (exception.throw ..unknown-kind-of-object host-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-macro + (-> Macro (Maybe net/sandius/rembulan/runtime/LuaFunction)) + (|>> (:coerce java/lang/Object) (host.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 (Error Any)) + (do error.monad + [output (net/sandius/rembulan/exec/DirectCallExecutor::call state-context + (:coerce java/lang/Object macro) + (|> (array.new 2) + (array.write 0 ## (:coerce java/lang/Object inputs) + ## (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new)) + (:coerce java/lang/Object (lux-structure (:coerce (Array java/lang/Object) inputs)))) + (array.write 1 ## (:coerce java/lang/Object lux) + ## (net/sandius/rembulan/impl/ImmutableTable$Builder::build (net/sandius/rembulan/impl/ImmutableTable$Builder::new)) + (:coerce java/lang/Object (lux-structure (:coerce (Array java/lang/Object) lux))))) + executor)] + (wrap (|> output (array.read 0) maybe.assume (:coerce java/lang/Object) ..read)))) + +(def: (expander baggage macro inputs lux) + (-> Baggage Expander) + (case (ensure-macro macro) + (#.Some macro) + (case (call-macro baggage inputs lux macro) + (#error.Success output) + (|> output + (:coerce (Error (Error [Lux (List Code)])))) + + (#error.Failure error) + (#error.Failure error)) + + #.None + (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro))) + ) + +(def: separator "___") + +(type: Host + (generation.Host (_.Expression Any) _.Statement)) + +(def: host + (IO [Baggage Host]) + (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! (: (-> Text _.Statement (Error Any)) + (function (_ dummy-name code) + (do error.monad + [#let [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 + (structure + (def: (evaluate! dummy-name code) + (run! dummy-name (_.return code))) + (def: execute! run!) + (def: (define! [module name] input) + (let [global (format (text.replace-all .module-separator ..separator module) + ..separator (name.normalize name) + "___" (%n (text@hash name))) + @global (_.var global)] + (do error.monad + [#let [definition (_.set (list @global) input)] + _ (run! global definition) + value (run! global (_.return @global))] + (wrap [global value definition]))))))]))) + +(def: platform + (IO [Baggage (Platform IO _.Var (_.Expression Any) _.Statement)]) + (do io.monad + [[baggage host] ..host] + (wrap [baggage + {#platform.&monad io.monad + #platform.&file-system file.system + #platform.host host + #platform.phase lua.generate + #platform.runtime runtime.generate}]))) + +(def: (program program) + (-> (_.Expression Any) _.Statement) + (_.statement (_.apply/* (list (runtime.lux//program-args (_.var "arg")) + _.nil) + program))) + +(program: [{service /cli.service}] + (do io.monad + [[baggage platform] ..platform] + (/.compiler (..expander baggage) + (io platform) + extension.bundle + ..program + service))) diff --git a/lux-ruby/project.clj b/lux-ruby/project.clj index 9b34f7edf..70f2e949c 100644 --- a/lux-ruby/project.clj +++ b/lux-ruby/project.clj @@ -4,7 +4,7 @@ (def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/") (defproject com.github.luxlang/lux-python #=(identity version) - :description "A Python compiler for Lux." + :description "A Ruby compiler for Lux." :url ~repo :license {:name "Lux License v0.1" :url ~(str repo "/blob/master/license.txt")} diff --git a/new-luxc/project.clj b/new-luxc/project.clj index 5017e821d..91b6efdb5 100644 --- a/new-luxc/project.clj +++ b/new-luxc/project.clj @@ -23,10 +23,6 @@ :dependencies [;; JVM Bytecode [org.ow2.asm/asm-all "5.0.3"] - ;; ;; Lua - ;; [net.sandius.rembulan/rembulan-runtime "0.1-SNAPSHOT"] - ;; [net.sandius.rembulan/rembulan-stdlib "0.1-SNAPSHOT"] - ;; [net.sandius.rembulan/rembulan-compiler "0.1-SNAPSHOT"] ;; ;; Scheme ;; [kawa-scheme/kawa-core "2.4"] ;; ;; Common Lisp diff --git a/new-luxc/source/luxc/lang/host/lua.lux b/new-luxc/source/luxc/lang/host/lua.lux deleted file mode 100644 index 364c05052..000000000 --- a/new-luxc/source/luxc/lang/host/lua.lux +++ /dev/null @@ -1,188 +0,0 @@ -(.module: - [lux #- not or and function] - (lux (data [text] - text/format - (coll [list "list/" Functor<List> Fold<List>])))) - -(type: #export Lua Text) - -(type: #export Expression Lua) - -(type: #export Statement Lua) - -(def: #export nil - Expression - "nil") - -(def: #export bool - (-> Bit Expression) - %b) - -(def: #export int - (-> Int Expression) - %i) - -(def: #export float - (-> Frac Expression) - %f) - -(def: #export (string value) - (-> Text Expression) - (%t value)) - -(def: #export (array elements) - (-> (List Expression) Expression) - (format "{" (text.join-with "," elements) "}")) - -(def: #export (nth idx array) - (-> Expression Expression Expression) - (format "(" array ")[" idx "]")) - -(def: #export (length array) - (-> Expression Expression) - (format "#(" array ")")) - -(def: #export (apply func args) - (-> Expression (List Expression) Expression) - (format func "(" (text.join-with "," args) ")")) - -(def: #export (method field table args) - (-> Text Expression (List Expression) Expression) - (format table ":" field "(" (text.join-with "," args) ")")) - -(def: #export (local! name value) - (-> Text (Maybe Expression) Statement) - (case value - #.None - (format "local " name ";") - - (#.Some value) - (format "local " name " = " value ";"))) - -(def: #export (global! name value) - (-> Text (Maybe Expression) Statement) - (case value - #.None - (format name ";") - - (#.Some value) - (format name " = " value ";"))) - -(def: #export (set! name value) - (-> Text Expression Statement) - (format name " = " value ";")) - -(def: #export (if! test then! else!) - (-> Expression Statement Statement Statement) - (format "if " test - " then " then! - " else " else! - " end;")) - -(def: #export (when! test then!) - (-> Expression Statement Statement) - (format "if " test - " then " then! - " end;")) - -(def: #export (cond! clauses else!) - (-> (List [Expression Statement]) Statement Statement) - (list/fold (.function (_ [test then!] next!) - (if! test then! next!)) - else! - (list.reverse clauses))) - -(def: #export (block! statements) - (-> (List Statement) Statement) - (text.join-with " " statements)) - -(def: #export (while! test body) - (-> Expression Statement Statement) - (format "while " test " do " body " end;")) - -(def: #export (for-in! vars source body) - (-> (List Text) Expression Statement Statement) - (format "for " (text.join-with "," vars) " in " source - " do " body " end;")) - -(def: #export (for-step! var from to step body) - (-> Text Expression Expression Expression Statement - Statement) - (format "for " var " = " from ", " to ", " step - " do " body " end;")) - -(def: #export (error message) - (-> Expression Expression) - (apply "error" (list message))) - -(def: #export (return! value) - (-> Expression Statement) - (format "return " value ";")) - -(def: #export (function args body) - (-> (List Text) Statement Expression) - (format "(" - (format "function " (format "(" (text.join-with ", " args) ")") - " " - body - " end") - ")")) - -(def: #export (function! name args body) - (-> Text (List Text) Statement Expression) - (format "function " name (format "(" (text.join-with ", " args) ")") - " " - body - " end;")) - -(def: #export (table fields) - (-> (List [Text Expression]) Expression) - (format "{" - (|> fields - (list/map (.function (_ [key val]) - (format key " = " val))) - (text.join-with ", ")) - "}")) - -(template [<name> <op>] - [(def: #export (<name> param subject) - (-> Expression Expression Expression) - (format "(" subject " " <op> " " param ")"))] - - [= "=="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [// "//"] - [% "%"] - ) - -(template [<name> <op>] - [(def: #export (<name> param subject) - (-> Expression Expression Expression) - (format "(" param " " <op> " " subject ")"))] - - [or "or"] - [and "and"] - [bit-or "|"] - [bit-and "&"] - [bit-xor "~"] - ) - -(template [<name> <op>] - [(def: #export (<name> param subject) - (-> Expression Expression Expression) - (format "(" subject " " <op> " " param ")"))] - - [bit-shl "<<"] - [bit-shr ">>"] - ) - -(def: #export (not subject) - (-> Expression Expression) - (format "(not " subject ")")) diff --git a/new-luxc/source/luxc/lang/translation/lua.lux b/new-luxc/source/luxc/lang/translation/lua.lux deleted file mode 100644 index e79af1048..000000000 --- a/new-luxc/source/luxc/lang/translation/lua.lux +++ /dev/null @@ -1,231 +0,0 @@ -(.module: - lux - (lux (control ["ex" exception #+ exception:] - pipe - [monad #+ do]) - (data [bit] - [maybe] - ["e" error #+ Error] - [text "text/" Eq<Text>] - text/format - (coll [array])) - [macro] - [io #+ IO Process io] - [host #+ class: interface: object] - (world [file #+ File])) - (luxc [lang] - (lang [".L" variable #+ Register] - (host [lua #+ Lua Expression Statement])) - [".C" io])) - -(template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [No-Active-Module-Buffer] - [Cannot-Execute] - - [No-Anchor] - ) - -(host.import: java/lang/Object) - -(host.import: java/lang/String - (getBytes [String] #try (Array byte))) - -(host.import: java/lang/CharSequence) - -(host.import: java/lang/Appendable - (append [CharSequence] Appendable)) - -(host.import: java/lang/StringBuilder - (new []) - (toString [] String)) - -(host.import: net/sandius/rembulan/StateContext) - -(host.import: net/sandius/rembulan/impl/StateContexts - (#static newDefaultInstance [] StateContext)) - -(host.import: net/sandius/rembulan/env/RuntimeEnvironment) - -(host.import: net/sandius/rembulan/env/RuntimeEnvironments - (#static system [] RuntimeEnvironment)) - -(host.import: net/sandius/rembulan/Table) - -(host.import: net/sandius/rembulan/lib/StandardLibrary - (#static in [RuntimeEnvironment] StandardLibrary) - (installInto [StateContext] Table)) - -(host.import: net/sandius/rembulan/Variable - (new [Object])) - -(host.import: net/sandius/rembulan/runtime/LuaFunction) - -(host.import: net/sandius/rembulan/load/ChunkLoader - (loadTextChunk [Variable String String] LuaFunction)) - -(host.import: net/sandius/rembulan/compiler/CompilerChunkLoader - (#static of [String] CompilerChunkLoader)) - -(host.import: net/sandius/rembulan/exec/DirectCallExecutor - (#static newExecutor [] DirectCallExecutor) - (call [StateContext Object (Array Object)] (Array Object))) - -(type: #export Anchor [Text Register]) - -(type: #export Host - {#context [Text Nat] - #anchor (Maybe Anchor) - #interpreter (-> Text (Error Any)) - #module-buffer (Maybe StringBuilder) - #program-buffer StringBuilder}) - -(def: #export init - (IO Host) - (io {#context ["" +0] - #anchor #.None - #interpreter (let [runtime-env (RuntimeEnvironments::system []) - std-lib (StandardLibrary::in [runtime-env]) - state-context (StateContexts::newDefaultInstance []) - table (StandardLibrary::installInto [state-context] std-lib) - variable (Variable::new [table]) - loader (CompilerChunkLoader::of ["_lux_definition"]) - executor (DirectCallExecutor::newExecutor [])] - (function (_ code) - (let [lua-function (ChunkLoader::loadTextChunk [variable "lux compilation" code] - loader)] - ("lux try" (io (DirectCallExecutor::call [state-context (:coerce Object lua-function) (array.new +0)] - executor)))))) - #module-buffer #.None - #program-buffer (StringBuilder::new [])})) - -(def: #export lua-module-name Text "module.lua") - -(def: #export init-module-buffer - (Meta Any) - (function (_ compiler) - (#e.Success [(update@ #.host - (|>> (:coerce Host) - (set@ #module-buffer (#.Some (StringBuilder::new []))) - (:coerce Nothing)) - compiler) - []]))) - -(def: #export (with-sub-context expr) - (All [a] (-> (Meta a) (Meta [Text a]))) - (function (_ compiler) - (let [old (:coerce Host (get@ #.host compiler)) - [old-name old-sub] (get@ #context old) - new-name (format old-name "___" (%i (.int old-sub)))] - (case (expr (set@ #.host - (:coerce Nothing (set@ #context [new-name +0] old)) - compiler)) - (#e.Success [compiler' output]) - (#e.Success [(update@ #.host - (|>> (:coerce Host) - (set@ #context [old-name (inc old-sub)]) - (:coerce Nothing)) - compiler') - [new-name output]]) - - (#e.Error error) - (#e.Error error))))) - -(def: #export context - (Meta Text) - (function (_ compiler) - (#e.Success [compiler - (|> (get@ #.host compiler) - (:coerce Host) - (get@ #context) - (let> [name sub] - name))]))) - -(def: #export (with-anchor anchor expr) - (All [a] (-> Anchor (Meta a) (Meta a))) - (function (_ compiler) - (let [old (:coerce Host (get@ #.host compiler))] - (case (expr (set@ #.host - (:coerce Nothing (set@ #anchor (#.Some anchor) old)) - compiler)) - (#e.Success [compiler' output]) - (#e.Success [(update@ #.host - (|>> (:coerce Host) - (set@ #anchor (get@ #anchor old)) - (:coerce Nothing)) - compiler') - output]) - - (#e.Error error) - (#e.Error error))))) - -(def: #export anchor - (Meta Anchor) - (function (_ compiler) - (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor)) - (#.Some anchor) - (#e.Success [compiler anchor]) - - #.None - ((lang.throw No-Anchor "") compiler)))) - -(def: #export module-buffer - (Meta StringBuilder) - (function (_ compiler) - (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer)) - #.None - ((lang.throw No-Active-Module-Buffer "") compiler) - - (#.Some module-buffer) - (#e.Success [compiler module-buffer])))) - -(def: #export program-buffer - (Meta StringBuilder) - (function (_ compiler) - (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))]))) - -(def: (execute code) - (-> Expression (Meta Any)) - (function (_ compiler) - (let [interpreter (|> compiler (get@ #.host) (:coerce Host) (get@ #interpreter))] - (case (interpreter code) - (#e.Error error) - ((lang.throw Cannot-Execute error) compiler) - - (#e.Success _) - (#e.Success [compiler []]))))) - -(def: #export variant-tag-field "_lux_tag") -(def: #export variant-flag-field "_lux_flag") -(def: #export variant-value-field "_lux_value") - -(def: #export unit Text "") - -(def: #export (definition-name [module name]) - (-> Name Text) - (lang.normalize-name (format module "$" name))) - -(def: #export (save code) - (-> Lua (Meta Any)) - (do macro.Monad<Meta> - [module-buffer module-buffer - #let [_ (Appendable::append [(:coerce CharSequence code)] - module-buffer)]] - (execute code))) - -(def: #export (save-module! target) - (-> File (Meta (Process Any))) - (do macro.Monad<Meta> - [module macro.current-module-name - module-buffer module-buffer - program-buffer program-buffer - #let [module-code (StringBuilder::toString [] module-buffer) - _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))] - program-buffer)]] - (wrap (ioC.write target - (format (lang.normalize-name module) "/" lua-module-name) - (|> module-code - (String::getBytes ["UTF-8"]) - e.assume))))) diff --git a/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux deleted file mode 100644 index af4e61b7c..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/case.jvm.lux +++ /dev/null @@ -1,175 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data text/format - (coll [list "list/" Fold<List>])) - [macro #+ "meta/" Monad<Meta>]) - (luxc [lang] - (lang ["ls" synthesis] - (host [lua #+ Lua Expression Statement]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" reference])) - -(def: (expression-block body) - (-> Statement Expression) - (lua.apply (lua.function (list) - body) - (list))) - -(def: #export (translate-let translate register valueS bodyS) - (-> (-> ls.Synthesis (Meta Expression)) Nat ls.Synthesis ls.Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - bodyO (translate bodyS)] - (wrap (expression-block - (lua.block! (list (lua.local! (referenceT.variable register) (#.Some valueO)) - (lua.return! bodyO))))))) - -(def: #export (translate-record-get translate valueS path) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List [Nat Bit]) - (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS)] - (wrap (list/fold (function (_ [idx tail?] source) - (let [method (if tail? - runtimeT.product//right - runtimeT.product//left)] - (method source (lua.int (:coerce Int idx))))) - valueO - path)))) - -(def: #export (translate-if testO thenO elseO) - (-> Expression Expression Expression Expression) - (expression-block - (lua.if! testO - (lua.return! thenO) - (lua.return! elseO)))) - -(def: savepoint - Expression - "pm_cursor_savepoint") - -(def: cursor - Expression - "pm_cursor") - -(def: (push-cursor! value) - (-> Expression Expression) - (lua.apply "table.insert" (list cursor value))) - -(def: save-cursor! - Statement - (lua.apply "table.insert" (list savepoint (runtimeT.array//copy cursor)))) - -(def: restore-cursor! - Statement - (lua.set! cursor (lua.apply "table.remove" (list savepoint)))) - -(def: cursor-top - Expression - (lua.nth (lua.length cursor) cursor)) - -(def: pop-cursor! - Statement - (lua.apply "table.remove" (list cursor))) - -(def: pm-error - Expression - (lua.string "PM-ERROR")) - -(exception: #export (Unrecognized-Path {message Text}) - message) - -(def: (translate-pattern-matching' translate path) - (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) - (case path - (^code ("lux case exec" (~ bodyS))) - (do macro.Monad<Meta> - [bodyO (translate bodyS)] - (wrap (lua.return! bodyO))) - - (^code ("lux case pop")) - (meta/wrap pop-cursor!) - - (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (meta/wrap (lua.local! (referenceT.variable register) (#.Some cursor-top))) - - (^template [<tag> <format>] - [_ (<tag> value)] - (meta/wrap (lua.when! (lua.not (lua.= (|> value <format>) cursor-top)) - (lua.return! pm-error)))) - ([#.Nat (<| lua.int (:coerce Int))] - [#.Int lua.int] - [#.Rev (<| lua.int (:coerce Int))] - [#.Bit lua.bool] - [#.Frac lua.float] - [#.Text lua.string]) - - (^template [<pm> <getter>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (push-cursor! (<getter> cursor-top (lua.int (:coerce Int idx)))))) - (["lux case tuple left" runtimeT.product//left] - ["lux case tuple right" runtimeT.product//right]) - - (^template [<pm> <flag>] - (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (lua.block! (list (lua.set! "temp" (runtimeT.sum//get cursor-top (lua.int (:coerce Int idx)) <flag>)) - (lua.if! (lua.= lua.nil "temp") - (lua.return! pm-error) - (push-cursor! "temp")))))) - (["lux case variant left" lua.nil] - ["lux case variant right" (lua.string "")]) - - (^code ("lux case seq" (~ leftP) (~ rightP))) - (do macro.Monad<Meta> - [leftO (translate-pattern-matching' translate leftP) - rightO (translate-pattern-matching' translate rightP)] - (wrap (lua.block! (list leftO rightO)))) - - (^code ("lux case alt" (~ leftP) (~ rightP))) - (do macro.Monad<Meta> - [leftO (translate-pattern-matching' translate leftP) - rightO (translate-pattern-matching' translate rightP)] - (wrap (lua.block! (list (format "local alt_success, alt_value = " (lua.apply "pcall" (list (lua.function (list) - (lua.block! (list save-cursor! - leftO))))) ";") - (lua.if! "alt_success" - (lua.return! "alt_value") - (lua.if! (lua.= pm-error "alt_value") - (lua.block! (list restore-cursor! - rightO)) - (lua.error "alt_value"))))))) - - _ - (lang.throw Unrecognized-Path (%code path)) - )) - -(def: (translate-pattern-matching translate path) - (-> (-> ls.Synthesis (Meta Expression)) Code (Meta Expression)) - (do macro.Monad<Meta> - [pattern-matching (translate-pattern-matching' translate path)] - (wrap (lua.block! (list (format "local success, value = pcall(function () " pattern-matching " end);") - (lua.if! "success" - (lua.return! "value") - (lua.if! (lua.= pm-error "value") - (lua.error (lua.string "Invalid expression for pattern-matching.")) - (lua.error "value")))))))) - -(def: (initialize-pattern-matching stack-init) - (-> Expression Statement) - (lua.block! (list (lua.local! "temp" #.None) - (lua.local! cursor (#.Some (lua.array (list stack-init)))) - (lua.local! savepoint (#.Some (lua.array (list))))))) - -(def: #export (translate-case translate valueS path) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis Code (Meta Expression)) - (do macro.Monad<Meta> - [valueO (translate valueS) - pattern-matching (translate-pattern-matching translate path)] - (wrap (expression-block - (lua.block! (list (initialize-pattern-matching valueO) - pattern-matching)))))) diff --git a/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux deleted file mode 100644 index 17596ffa7..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux +++ /dev/null @@ -1,125 +0,0 @@ -(.module: - lux - (lux (control ["ex" exception #+ exception:]) - (data [bit] - [maybe] - ["e" error #+ Error] - text/format - (coll [array])) - [host]) - (luxc [lang] - (lang (host [lua #+ Lua Expression Statement]))) - [//]) - -(template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Unknown-Kind-Of-Host-Object] - [Null-Has-No-Lux-Representation] - [Cannot-Evaluate] - ) - -(host.import: java/lang/Object - (toString [] String) - (getClass [] (Class Object))) - -(host.import: java/lang/Long - (intValue [] Integer)) - -(host.import: net/sandius/rembulan/ByteString - (decode [] String)) - -(host.import: net/sandius/rembulan/Table - (rawget #as get-idx [long] #? Object) - (rawget #as get-key [Object] #? Object) - (rawlen [] long)) - -(host.import: net/sandius/rembulan/impl/DefaultTable) - -(def: (variant lux-object host-object) - (-> (-> Object (Error Any)) DefaultTable (Maybe Any)) - (case [(Table::get-key [//.variant-tag-field] host-object) - (Table::get-key [//.variant-flag-field] host-object) - (Table::get-key [//.variant-value-field] host-object)] - (^multi [(#.Some tag) ?flag (#.Some value)] - [(lux-object value) - (#.Some value)]) - (#.Some [(Long::intValue [] (:coerce Long tag)) - (: Any (case ?flag (#.Some _) "" #.None (host.null))) - value]) - - _ - #.None)) - -(def: (array lux-object host-object) - (-> (-> Object (Error Any)) DefaultTable (Maybe (Array Object))) - (let [init-num-keys (:coerce Nat (Table::rawlen [] host-object))] - (loop [num-keys init-num-keys - idx +0 - output (: (Array Object) - (array.new init-num-keys))] - (if (n/< num-keys idx) - (case (Table::get-idx (:coerce Long (inc idx)) host-object) - (#.Some member) - (case (lux-object member) - (#e.Success parsed-member) - (recur num-keys (inc idx) (array.write idx (:coerce Object parsed-member) output)) - - (#e.Error error) - #.None) - - #.None - (recur num-keys (inc idx) output)) - (#.Some output))))) - -(def: (lux-object host-object) - (-> Object (Error Any)) - (cond (host.null? host-object) - (ex.throw Null-Has-No-Lux-Representation "") - - (or (host.instance? java/lang/Boolean host-object) - (host.instance? java/lang/Long host-object) - (host.instance? java/lang/Double host-object) - (host.instance? java/lang/String host-object)) - (ex.return host-object) - - (host.instance? ByteString host-object) - (ex.return (ByteString::decode [] (:coerce ByteString host-object))) - - (host.instance? DefaultTable host-object) - (let [host-object (:coerce DefaultTable host-object)] - (case (variant lux-object host-object) - (#.Some value) - (ex.return value) - - #.None - (case (array lux-object host-object) - (#.Some value) - (ex.return value) - - #.None - (ex.throw Unknown-Kind-Of-Host-Object (format "SECOND " (Object::toString [] (:coerce Object host-object))))))) - - ## else - (ex.throw Unknown-Kind-Of-Host-Object (format "FIRST " (Object::toString [] (:coerce Object host-object)))) - )) - -(def: #export (eval code) - (-> Expression (Meta Any)) - (function (_ compiler) - (let [interpreter (|> compiler (get@ #.host) (:coerce //.Host) (get@ #//.interpreter))] - (case (interpreter (format "return " code ";")) - (#e.Error error) - ((lang.throw Cannot-Evaluate error) compiler) - - (#e.Success output) - (case (lux-object (|> output - (:coerce (Array Object)) - (array.read +0) - maybe.assume)) - (#e.Success parsed-output) - (#e.Success [compiler parsed-output]) - - (#e.Error error) - ((lang.throw Cannot-Evaluate error) compiler)))))) diff --git a/new-luxc/source/luxc/lang/translation/lua/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/expression.jvm.lux deleted file mode 100644 index 6597364bb..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/expression.jvm.lux +++ /dev/null @@ -1,88 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - ["p" parser]) - (data ["e" error] - text/format) - [macro] - (macro ["s" syntax])) - (luxc ["&" lang] - (lang [".L" variable #+ Variable Register] - [".L" extension] - ["ls" synthesis] - (host [lua #+ Lua Expression Statement]))) - [//] - (// [".T" runtime] - [".T" primitive] - [".T" structure] - [".T" reference] - [".T" function] - [".T" loop] - [".T" case] - [".T" procedure])) - -(template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Invalid-Function-Syntax] - [Unrecognized-Synthesis] - ) - -(def: #export (translate synthesis) - (-> ls.Synthesis (Meta Expression)) - (case synthesis - (^code []) - (:: macro.Monad<Meta> wrap runtimeT.unit) - - (^code [(~ singleton)]) - (translate singleton) - - (^template [<tag> <generator>] - [_ (<tag> value)] - (<generator> value)) - ([#.Bit primitiveT.translate-bit] - [#.Nat primitiveT.translate-nat] - [#.Int primitiveT.translate-int] - [#.Rev primitiveT.translate-rev] - [#.Frac primitiveT.translate-frac] - [#.Text primitiveT.translate-text]) - - (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS))) - (structureT.translate-variant translate tag last? valueS) - - (^code [(~+ members)]) - (structureT.translate-tuple translate members) - - (^ [_ (#.Form (list [_ (#.Int var)]))]) - (referenceT.translate-variable var) - - [_ (#.Identifier definition)] - (referenceT.translate-definition definition) - - (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS))) - (caseT.translate-let translate register inputS exprS) - - (^code ("lux case" (~ inputS) (~ pathPS))) - (caseT.translate-case translate inputS pathPS) - - (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS))) - (case (s.run environment (p.some s.int)) - (#e.Success environment) - (functionT.translate-function translate environment arity bodyS) - - _ - (&.throw Invalid-Function-Syntax (%code synthesis))) - - (^code ("lux call" (~ functionS) (~+ argsS))) - (functionT.translate-apply translate functionS argsS) - - (^code ((~ [_ (#.Text procedure)]) (~+ argsS))) - (procedureT.translate-procedure translate procedure argsS) - ## (do macro.Monad<Meta> - ## [translation (extensionL.find-translation procedure)] - ## (translation argsS)) - - _ - (&.throw Unrecognized-Synthesis (%code synthesis)))) diff --git a/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux deleted file mode 100644 index 451e9dbb4..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux +++ /dev/null @@ -1,82 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [product] - [text] - text/format - (coll [list "list/" Functor<List>])) - [macro]) - (luxc ["&" lang] - (lang ["ls" synthesis] - [".L" variable #+ Variable] - (host [lua #+ Lua Expression Statement]))) - [//] - (// [".T" reference] - [".T" loop] - [".T" runtime])) - -(def: #export (translate-apply translate functionS argsS+) - (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression)) - (do macro.Monad<Meta> - [functionO (translate functionS) - argsO+ (monad.map @ translate argsS+)] - (wrap (lua.apply functionO argsO+)))) - -(def: (input-declaration register) - (lua.local! (referenceT.variable (inc register)) - (#.Some (lua.nth (|> register inc .int %i) "curried")))) - -(def: (with-closure function-name inits function-definition) - (-> Text (List Expression) Statement (Meta Expression)) - (let [closure-name (format function-name "___CLOSURE")] - (case inits - #.Nil - (do macro.Monad<Meta> - [_ (//.save function-definition)] - (wrap function-name)) - - _ - (do macro.Monad<Meta> - [_ (//.save (lua.function! closure-name - (|> (list.enumerate inits) - (list/map (|>> product.left referenceT.closure))) - (lua.block! (list function-definition - (lua.return! function-name)))))] - (wrap (lua.apply closure-name inits)))))) - -(def: #export (translate-function translate env arity bodyS) - (-> (-> ls.Synthesis (Meta Expression)) - (List Variable) ls.Arity ls.Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [[function-name bodyO] (//.with-sub-context - (do @ - [function-name //.context] - (//.with-anchor [function-name +1] - (translate bodyS)))) - closureO+ (monad.map @ referenceT.translate-variable env) - #let [args-initsO+ (|> (list.n/range +0 (dec arity)) - (list/map input-declaration)) - selfO (lua.local! (referenceT.variable +0) (#.Some function-name)) - arityO (|> arity .int %i) - pack (|>> (list) (lua.apply "table.pack"))]] - (with-closure function-name closureO+ - (lua.function! function-name (list "...") - (lua.block! (list (lua.local! "curried" (#.Some (pack "..."))) - (lua.local! "num_args" (#.Some (lua.length "curried"))) - (lua.if! (lua.= arityO "num_args") - (lua.block! (list selfO - (lua.block! args-initsO+) - (lua.while! (lua.bool #1) - (lua.return! bodyO)))) - (let [unpack (|>> (list) (lua.apply "table.unpack")) - recur (|>> (list) (lua.apply function-name))] - (lua.if! (lua.> arityO "num_args") - (let [slice (function (_ from to) - (runtimeT.array//sub "curried" from to)) - arity-args (unpack (slice (lua.int 1) arityO)) - output-func-args (unpack (slice (lua.+ (lua.int 1) arityO) "num_args"))] - (lua.return! (lua.apply (recur arity-args) - (list output-func-args)))) - (lua.return! (lua.function (list "...") - (lua.return! (recur (unpack (runtimeT.array//concat "curried" (pack "...")))))))))))))))) diff --git a/new-luxc/source/luxc/lang/translation/lua/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/loop.jvm.lux deleted file mode 100644 index 4bad74069..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/loop.jvm.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [text] - text/format - (coll [list "list/" Functor<List>])) - [macro]) - (luxc [lang] - (lang ["ls" synthesis] - (host [lua #+ Lua Expression Statement]))) - [//] - (// [".T" reference])) - -(def: #export (translate-loop translate offset initsS+ bodyS) - (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis - (Meta Expression)) - (do macro.Monad<Meta> - [loop-name (:: @ map (|>> %code lang.normalize-name) - (macro.gensym "loop")) - initsO+ (monad.map @ translate initsS+) - bodyO (//.with-anchor [loop-name offset] - (translate bodyS)) - #let [registersO+ (|> (list.n/range +0 (dec (list.size initsS+))) - (list/map (|>> (n/+ offset) referenceT.variable)))] - _ (//.save (lua.function! loop-name registersO+ - (lua.return! bodyO)))] - (wrap (lua.apply loop-name initsO+)))) - -(def: #export (translate-recur translate argsS+) - (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis) - (Meta Expression)) - (do macro.Monad<Meta> - [[loop-name offset] //.anchor - argsO+ (monad.map @ translate argsS+)] - (wrap (lua.apply loop-name argsO+)))) diff --git a/new-luxc/source/luxc/lang/translation/lua/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/primitive.jvm.lux deleted file mode 100644 index 230498fcb..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/primitive.jvm.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.module: - lux - (lux (control pipe) - (data [number] - text/format) - [macro "meta/" Monad<Meta>]) - (luxc (lang (host [lua #+ Lua Expression Statement])))) - -(def: #export translate-bit - (-> Bit (Meta Expression)) - (|>> lua.bool meta/wrap)) - -(def: #export translate-int - (-> Int (Meta Expression)) - (|>> lua.int meta/wrap)) - -(def: #export translate-frac - (-> Frac (Meta Expression)) - (|>> (cond> [(f/= number.positive-infinity)] - [(new> "math.huge")] - - [(f/= number.negative-infinity)] - [(new> "(-1 * math.huge)")] - - [(f/= number.not-a-number)] - [(new> "(0/0)")] - - ## else - [%f]) - meta/wrap)) - -(def: #export translate-text - (-> Text (Meta Expression)) - (|>> %t meta/wrap)) 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 deleted file mode 100644 index 2f1b652e3..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ /dev/null @@ -1,374 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:] - ["p" parser]) - (data ["e" error] - [text] - text/format - (coll [list "list/" Functor<List>] - (dictionary ["dict" unordered #+ Dict]))) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax:]) - [host]) - (luxc ["&" lang] - (lang ["la" analysis] - ["ls" synthesis] - (host [lua #+ Lua Expression Statement]))) - [///] - (/// [".T" runtime] - [".T" case] - [".T" function] - [".T" loop])) - -## [Types] -(type: #export Translator - (-> ls.Synthesis (Meta Expression))) - -(type: #export Proc - (-> Translator (List ls.Synthesis) (Meta Expression))) - -(type: #export Bundle - (Dict Text Proc)) - -(syntax: (Vector {size s.nat} elemT) - (wrap (list (` [(~+ (list.repeat size elemT))])))) - -(type: #export Nullary (-> (Vector +0 Expression) Expression)) -(type: #export Unary (-> (Vector +1 Expression) Expression)) -(type: #export Binary (-> (Vector +2 Expression) Expression)) -(type: #export Trinary (-> (Vector +3 Expression) Expression)) -(type: #export Variadic (-> (List Expression) Expression)) - -## [Utils] -(def: #export (install name unnamed) - (-> Text (-> Text Proc) - (-> Bundle Bundle)) - (dict.put name (unnamed name))) - -(def: #export (prefix prefix bundle) - (-> Text Bundle Bundle) - (|> bundle - dict.entries - (list/map (function (_ [key val]) [(format prefix " " key) val])) - (dict.from-list text.Hash<Text>))) - -(def: (wrong-arity proc expected actual) - (-> Text Nat Nat Text) - (format "Wrong number of arguments for " (%t proc) "\n" - "Expected: " (|> expected .int %i) "\n" - " Actual: " (|> actual .int %i))) - -(syntax: (arity: {name s.local-identifier} {arity s.nat}) - (with-gensyms [g_ g!proc g!name g!translate g!inputs] - (do @ - [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] - (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc)) - (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression) - (-> Text ..Proc)) - (function ((~ g_ ) (~ g!name)) - (function ((~ g_ ) (~ g!translate) (~ g!inputs)) - (case (~ g!inputs) - (^ (list (~+ g!input+))) - (do macro.Monad<Meta> - [(~+ (|> g!input+ - (list/map (function (_ g!input) - (list g!input (` ((~ g!translate) (~ g!input)))))) - list.concat))] - ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) - - (~' _) - (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) - -(arity: nullary +0) -(arity: unary +1) -(arity: binary +2) -(arity: trinary +3) - -(def: #export (variadic proc) - (-> Variadic (-> Text Proc)) - (function (_ proc-name) - (function (_ translate inputsS) - (do macro.Monad<Meta> - [inputsI (monad.map @ translate inputsS)] - (wrap (proc inputsI)))))) - -## [Procedures] -## [[Lux]] -(def: (lux//is [leftO rightO]) - Binary - (lua.= leftO rightO)) - -(def: (lux//if [testO thenO elseO]) - Trinary - (caseT.translate-if testO thenO elseO)) - -(def: (lux//try riskyO) - Unary - (runtimeT.lux//try riskyO)) - -(exception: #export (Wrong-Syntax {message Text}) - message) - -(def: #export (wrong-syntax procedure args) - (-> Text (List ls.Synthesis) Text) - (format "Procedure: " procedure "\n" - "Arguments: " (%code (code.tuple args)))) - -(def: lux//loop - (-> Text Proc) - (function (_ proc-name) - (function (_ translate inputsS) - (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any)) - (#e.Success [offset initsS+ bodyS]) - (loopT.translate-loop translate offset initsS+ bodyS) - - (#e.Error error) - (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS))) - ))) - -(def: lux//recur - (-> Text Proc) - (function (_ proc-name) - (function (_ translate inputsS) - (loopT.translate-recur translate inputsS)))) - -## [[Bits]] -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [bit//and lua.bit-and] - [bit//or lua.bit-or] - [bit//xor lua.bit-xor] - ) - -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [bit//left-shift lua.bit-shl] - [bit//arithmetic-right-shift lua.bit-shr] - [bit//logical-right-shift runtimeT.bit//logical-right-shift] - ) - -## [[Numbers]] -(host.import: java/lang/Double - (#static MIN_VALUE Double) - (#static MAX_VALUE Double) - (#static NaN Double) - (#static POSITIVE_INFINITY Double) - (#static NEGATIVE_INFINITY Double)) - -(template [<name> <const> <encode>] - [(def: (<name> _) - Nullary - (<encode> <const>))] - - [frac//smallest Double::MIN_VALUE lua.float] - [frac//min (f/* -1.0 Double::MAX_VALUE) lua.float] - [frac//max Double::MAX_VALUE lua.float] - ) - -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [int//add lua.+] - [int//sub lua.-] - [int//mul lua.*] - [int//div lua.//] - [int//rem lua.%] - ) - -(template [<name> <op>] - [(def: (<name> [subjectO paramO]) - Binary - (<op> paramO subjectO))] - - [frac//add lua.+] - [frac//sub lua.-] - [frac//mul lua.*] - [frac//div lua./] - [frac//rem lua.%] - [frac//= lua.=] - [frac//< lua.<] - - [text//= lua.=] - [text//< lua.<] - ) - -(template [<name> <cmp>] - [(def: (<name> [subjectO paramO]) - Binary - (<cmp> paramO subjectO))] - - [int//= lua.=] - [int//< lua.<] - ) - -(def: frac//encode - Unary - (|>> (list) (lua.apply "tostring"))) - -(def: (frac//decode inputO) - Unary - (lux//try (lua.function (list) - (lua.return! (lua.apply "tonumber" (list inputO)))))) - -(template [<name> <divisor>] - [(def: (<name> inputO) - Unary - (lua./ <divisor> inputO))] - - [int//to-frac (lua.float 1.0)] - ) - -(template [<name> <transform>] - [(def: (<name> inputO) - Unary - (|> inputO <transform>))] - - [frac//to-int (<| (lua.apply "math.floor") (list))] - ) - -(def: int//char - Unary - (|>> (list) (lua.apply "string.char"))) - -## [[Text]] -(template [<name> <op>] - [(def: <name> - Unary - (|>> (list) (lua.apply <op>)))] - - [text//size "string.len"] - ) - -(def: (text//concat [subjectO paramO]) - Binary - (format "(" subjectO " .. " paramO ")")) - -(def: (text//char [subjectO paramO]) - Binary - (runtimeT.text//char subjectO paramO)) - -(template [<name> <runtime>] - [(def: (<name> [subjectO paramO extraO]) - Trinary - (<runtime> subjectO paramO extraO))] - - [text//clip runtimeT.text//clip] - [text//index runtimeT.text//index] - ) - -## [[IO]] -(def: (io//log messageO) - Unary - (lua.or (lua.apply "print" (list messageO)) - runtimeT.unit)) - -(def: io//error - Unary - lua.error) - -(def: io//exit - Unary - (|>> (list) (lua.apply "os.exit"))) - -(def: (io//current-time []) - Nullary - (|> (lua.apply "os.time" (list)) - (lua.* (lua.int 1,000)))) - -## [Bundles] -(def: lux-procs - Bundle - (|> (dict.new text.Hash<Text>) - (install "is" (binary lux//is)) - (install "try" (unary lux//try)) - (install "if" (trinary lux//if)) - (install "loop" lux//loop) - (install "recur" lux//recur) - )) - -(def: bit-procs - Bundle - (<| (prefix "bit") - (|> (dict.new text.Hash<Text>) - (install "and" (binary bit//and)) - (install "or" (binary bit//or)) - (install "xor" (binary bit//xor)) - (install "left-shift" (binary bit//left-shift)) - (install "logical-right-shift" (binary bit//logical-right-shift)) - (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift)) - ))) - -(def: int-procs - Bundle - (<| (prefix "int") - (|> (dict.new text.Hash<Text>) - (install "+" (binary int//add)) - (install "-" (binary int//sub)) - (install "*" (binary int//mul)) - (install "/" (binary int//div)) - (install "%" (binary int//rem)) - (install "=" (binary int//=)) - (install "<" (binary int//<)) - (install "to-frac" (unary int//to-frac)) - (install "char" (unary int//char))))) - -(def: frac-procs - Bundle - (<| (prefix "frac") - (|> (dict.new text.Hash<Text>) - (install "+" (binary frac//add)) - (install "-" (binary frac//sub)) - (install "*" (binary frac//mul)) - (install "/" (binary frac//div)) - (install "%" (binary frac//rem)) - (install "=" (binary frac//=)) - (install "<" (binary frac//<)) - (install "smallest" (nullary frac//smallest)) - (install "min" (nullary frac//min)) - (install "max" (nullary frac//max)) - (install "to-int" (unary frac//to-int)) - (install "encode" (unary frac//encode)) - (install "decode" (unary frac//decode))))) - -(def: text-procs - Bundle - (<| (prefix "text") - (|> (dict.new text.Hash<Text>) - (install "=" (binary text//=)) - (install "<" (binary text//<)) - (install "concat" (binary text//concat)) - (install "index" (trinary text//index)) - (install "size" (unary text//size)) - (install "char" (binary text//char)) - (install "clip" (trinary text//clip)) - ))) - -(def: io-procs - Bundle - (<| (prefix "io") - (|> (dict.new text.Hash<Text>) - (install "log" (unary io//log)) - (install "error" (unary io//error)) - (install "exit" (unary io//exit)) - (install "current-time" (nullary io//current-time))))) - -(def: #export procedures - Bundle - (<| (prefix "lux") - (|> lux-procs - (dict.merge bit-procs) - (dict.merge int-procs) - (dict.merge frac-procs) - (dict.merge text-procs) - (dict.merge io-procs) - ))) diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/host.jvm.lux deleted file mode 100644 index f53f3ba05..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/host.jvm.lux +++ /dev/null @@ -1,87 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [text] - text/format - (coll [list "list/" Functor<List>] - (dictionary ["dict" unordered #+ Dict]))) - [macro "macro/" Monad<Meta>]) - (luxc ["&" lang] - (lang ["la" analysis] - ["ls" synthesis] - (host [lua #+ Lua Expression Statement]))) - [///] - (/// [".T" runtime]) - (// ["@" common])) - -(template [<name> <lua>] - [(def: (<name> _) @.Nullary <lua>)] - - [lua//nil "nil"] - [lua//table "{}"] - ) - -(def: (lua//global proc translate inputs) - (-> Text @.Proc) - (case inputs - (^ (list [_ (#.Text name)])) - (do macro.Monad<Meta> - [] - (wrap name)) - - _ - (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) - -(def: (lua//call proc translate inputs) - (-> Text @.Proc) - (case inputs - (^ (list& functionS argsS+)) - (do macro.Monad<Meta> - [functionO (translate functionS) - argsO+ (monad.map @ translate argsS+)] - (wrap (lua.apply functionO argsO+))) - - _ - (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) - -(def: lua-procs - @.Bundle - (|> (dict.new text.Hash<Text>) - (@.install "nil" (@.nullary lua//nil)) - (@.install "table" (@.nullary lua//table)) - (@.install "global" lua//global) - (@.install "call" lua//call))) - -(def: (table//call proc translate inputs) - (-> Text @.Proc) - (case inputs - (^ (list& tableS [_ (#.Text field)] argsS+)) - (do macro.Monad<Meta> - [tableO (translate tableS) - argsO+ (monad.map @ translate argsS+)] - (wrap (lua.method field tableO argsO+))) - - _ - (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) - -(def: (table//get [fieldO tableO]) - @.Binary - (runtimeT.lua//get tableO fieldO)) - -(def: (table//set [fieldO valueO tableO]) - @.Trinary - (runtimeT.lua//set tableO fieldO valueO)) - -(def: table-procs - @.Bundle - (<| (@.prefix "table") - (|> (dict.new text.Hash<Text>) - (@.install "call" table//call) - (@.install "get" (@.binary table//get)) - (@.install "set" (@.trinary table//set))))) - -(def: #export procedures - @.Bundle - (<| (@.prefix "lua") - (|> lua-procs - (dict.merge table-procs)))) diff --git a/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux deleted file mode 100644 index ea3f8e604..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux +++ /dev/null @@ -1,36 +0,0 @@ -(.module: - lux - (lux [macro] - (data [text] - text/format)) - (luxc ["&" lang] - (lang [".L" variable #+ Variable Register] - (host [lua #+ Lua Expression Statement]))) - [//] - (// [".T" runtime])) - -(template [<register> <translation> <prefix>] - [(def: #export (<register> register) - (-> Register Expression) - (format <prefix> (%i (.int register)))) - - (def: #export (<translation> register) - (-> Register (Meta Expression)) - (:: macro.Monad<Meta> wrap (<register> register)))] - - [closure translate-captured "c"] - [variable translate-local "v"]) - -(def: #export (translate-variable var) - (-> Variable (Meta Expression)) - (if (variableL.captured? var) - (translate-captured (variableL.captured-register var)) - (translate-local (.nat var)))) - -(def: #export global - (-> Name Expression) - //.definition-name) - -(def: #export (translate-definition name) - (-> Name (Meta Expression)) - (:: macro.Monad<Meta> wrap (global name))) diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux deleted file mode 100644 index ce9c37db5..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ /dev/null @@ -1,293 +0,0 @@ -(.module: - lux - (lux (control ["p" parser "p/" Monad<Parser>] - [monad #+ do]) - (data text/format - (coll [list "list/" Monad<List>])) - [macro] - (macro [code] - ["s" syntax #+ syntax:]) - [io #+ Process]) - [//] - (luxc [lang] - (lang (host [lua #+ Lua Expression Statement])))) - -(def: prefix Text "LuxRuntime") - -(def: #export unit Expression (%t //.unit)) - -(def: (flag value) - (-> Bit Lua) - (if value - (lua.string "") - lua.nil)) - -(def: (variant' tag last? value) - (-> Expression Expression Expression Expression) - (lua.table (list [//.variant-tag-field tag] - [//.variant-flag-field last?] - [//.variant-value-field value]))) - -(def: #export (variant tag last? value) - (-> Nat Bit Expression Expression) - (variant' (%i (.int tag)) (flag last?) value)) - -(def: none - Expression - (variant +0 #0 unit)) - -(def: some - (-> Expression Expression) - (variant +1 #1)) - -(def: left - (-> Expression Expression) - (variant +0 #0)) - -(def: right - (-> Expression Expression) - (variant +1 #1)) - -(type: Runtime Lua) - -(def: declaration - (s.Syntax [Text (List Text)]) - (p.either (p.seq s.local-identifier (p/wrap (list))) - (s.form (p.seq s.local-identifier (p.some s.local-identifier))))) - -(syntax: (runtime: {[name args] declaration} - definition) - (let [implementation (code.local-identifier (format "@@" name)) - runtime (code.text (format "__" prefix "__" (lang.normalize-name name))) - argsC+ (list/map code.local-identifier args) - argsLC+ (list/map (|>> lang.normalize-name code.text) args) - declaration (` ((~ (code.local-identifier name)) - (~+ argsC+))) - type (` (-> (~+ (list.repeat (list.size argsC+) (` lua.Lua))) - lua.Lua))] - (wrap (list (` (def: #export (~ declaration) - (~ type) - (lua.apply (~ runtime) (list (~+ argsC+))))) - (` (def: (~ implementation) - Lua - (~ (case argsC+ - #.Nil - (` (lua.global! (~ runtime) (#.Some (~ definition)))) - - _ - (` (let [(~' @) (~ runtime) - (~+ (|> (list.zip2 argsC+ argsLC+) - (list/map (function (_ [left right]) (list left right))) - list/join))] - (lua.function! (~ runtime) (list (~+ argsLC+)) - (~ definition)))))))))))) - -(runtime: (array//copy array) - (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list)))) - (lua.for-step! "idx" (lua.int 1) (lua.length array) (lua.int 1) - (lua.apply "table.insert" (list "temp" (lua.nth "idx" array)))) - (lua.return! "temp")))) - -(runtime: (array//sub array from to) - (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list)))) - (lua.for-step! "idx" from to (lua.int 1) - (lua.apply "table.insert" (list "temp" (lua.nth "idx" array)))) - (lua.return! "temp")))) - -(runtime: (array//concat left right) - (let [copy! (function (_ input output) - (lua.for-step! "idx" (lua.int 1) (format input ".n") (lua.int 1) - (lua.apply "table.insert" (list output (lua.nth "idx" input)))))] - (lua.block! (list (lua.local! "temp" (#.Some (lua.array (list)))) - (copy! left "temp") - (copy! right "temp") - (lua.return! "temp"))))) - -(runtime: (lux//try op) - (lua.block! (list (format "local success, value = " (lua.apply "pcall" (list (lua.function (list) (lua.return! (lua.apply op (list unit)))))) ";") - (lua.if! "success" - (lua.return! (right "value")) - (lua.return! (left "value")))))) - -(runtime: (lux//program-args program-args) - (lua.block! (list (lua.local! "inputs" (#.Some none)) - (lua.for-step! "idx" (lua.length program-args) (lua.int 1) (lua.int -1) - (lua.set! "inputs" (some (lua.array (list (lua.nth "idx" program-args) - "inputs"))))) - (lua.return! "inputs")))) - -(def: runtime//lux - Runtime - (format @@lux//try - @@lux//program-args)) - -(runtime: (product//left product index) - (lua.block! (list (lua.local! "index_min_length" (#.Some (lua.+ (lua.int 1) index))) - (lua.if! (lua.>= "index_min_length" (lua.length product)) - ## No need for recursion - (lua.return! (lua.nth "index_min_length" product)) - ## Needs recursion - (lua.return! (product//left (lua.nth (lua.length product) - product) - (lua.- (lua.length product) - "index_min_length"))))))) - -(runtime: (product//right product index) - (lua.block! (list (lua.local! "index_min_length" (#.Some (lua.+ (lua.int 1) index))) - (lua.cond! (list [(lua.= "index_min_length" (lua.length product)) - ## Last element. - (lua.return! (lua.nth "index_min_length" product))] - [(lua.< "index_min_length" (lua.length product)) - ## Needs recursion - (lua.return! (product//right (lua.nth (lua.length product) - product) - (lua.- (lua.length product) - "index_min_length")))]) - ## Must slice - (lua.return! (array//sub product "index_min_length" (lua.length product))))))) - -(runtime: (sum//get sum wantedTag wantsLast) - (let [no-match! (lua.return! lua.nil) - sum-tag (format "sum." //.variant-tag-field) - sum-flag (format "sum." //.variant-flag-field) - sum-value (format "sum." //.variant-value-field) - is-last? (lua.= (lua.string "") sum-flag) - test-recursion! (lua.if! is-last? - ## Must recurse. - (lua.return! (sum//get sum-value (lua.- sum-tag wantedTag) wantsLast)) - no-match!)] - (lua.cond! (list [(lua.= sum-tag wantedTag) - (lua.if! (lua.= wantsLast sum-flag) - (lua.return! sum-value) - test-recursion!)] - - [(lua.> sum-tag wantedTag) - test-recursion!] - - [(lua.and (lua.< sum-tag wantedTag) - (lua.= (lua.string "") wantsLast)) - (lua.return! (variant' (lua.- wantedTag sum-tag) sum-flag sum-value))]) - - no-match!))) - -(def: runtime//adt - Runtime - (format @@product//left - @@product//right - @@sum//get)) - -(runtime: (bit//logical-right-shift param subject) - (let [mask (|> (lua.int 1) - (lua.bit-shl (lua.- param (lua.int 64))) - (lua.- (lua.int 1)))] - (lua.return! (|> subject - (lua.bit-shr param) - (lua.bit-and mask))))) - -(def: runtime//bit - Runtime - @@bit//logical-right-shift) - -(runtime: (text//index subject param start) - (lua.block! (list (lua.local! "idx" (#.Some (lua.apply "string.find" (list subject param start (lua.bool #1))))) - (lua.if! (lua.= lua.nil "idx") - (lua.return! none) - (lua.return! (some "idx")))))) - -(runtime: (text//clip text from to) - (lua.block! (list (lua.local! "size" (#.Some (lua.apply "string.len" (list text)))) - (lua.if! (lua.or (lua.> "size" from) - (lua.> "size" to)) - (lua.return! none) - (lua.return! (some (lua.apply "string.sub" (list text from to)))))))) - -(runtime: (text//char text idx) - (lua.block! (list (lua.local! "char" (#.Some (lua.apply "string.byte" (list text idx)))) - (lua.if! (lua.= lua.nil "char") - (lua.return! none) - (lua.return! (some "char")))))) - -(def: runtime//text - Runtime - (format @@text//index - @@text//clip - @@text//char)) - -(def: (check-index-out-of-bounds array idx body!) - (-> Expression Expression Statement Statement) - (lua.if! (lua.<= (lua.length array) - idx) - body! - (lua.error (lua.string "Array index out of bounds!")))) - -(runtime: (array//new size) - (lua.block! (list (lua.local! "output" (#.Some (lua.array (list)))) - (lua.for-step! "idx" (lua.int 1) size (lua.int 1) - (lua.apply "table.insert" (list "output" unit))) - (lua.return! "output")))) - -(runtime: (array//get array idx) - (<| (check-index-out-of-bounds array idx) - (lua.block! (list (lua.local! "temp" (#.Some (lua.nth idx array))) - (lua.if! (lua.or (lua.= lua.nil "temp") - (lua.= unit "temp")) - (lua.return! none) - (lua.return! (some "temp"))))))) - -(runtime: (array//put array idx value) - (<| (check-index-out-of-bounds array idx) - (lua.block! (list (lua.set! (lua.nth idx array) value) - (lua.return! array))))) - -(def: runtime//array - Runtime - (format @@array//sub - @@array//concat - @@array//copy - @@array//new - @@array//get - @@array//put - )) - -(runtime: (box//write value box) - (lua.block! (list (lua.set! (lua.nth (lua.int 0) box) - value) - (lua.return! unit)))) - -(def: runtime//box - Runtime - (format @@box//write)) - -(runtime: (lua//get object field) - (lua.block! (list (lua.local! "value" (#.Some (lua.nth field object))) - (lua.if! (lua.= lua.nil "value") - (lua.return! none) - (lua.return! (some "value")))))) - -(runtime: (lua//set object field value) - (lua.block! (list (lua.set! (lua.nth field object) value) - (lua.return! object)))) - -(def: runtime//lua - Runtime - (format @@lua//get - @@lua//set)) - -(def: runtime - Runtime - (format runtime//lux - runtime//adt - runtime//bit - runtime//text - runtime//array - runtime//box - runtime//lua)) - -(def: #export artifact Text (format prefix ".lua")) - -(def: #export translate - (Meta (Process Any)) - (do macro.Monad<Meta> - [_ //.init-module-buffer - _ (//.save runtime)] - (//.save-module! artifact))) diff --git a/new-luxc/source/luxc/lang/translation/lua/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/statement.jvm.lux deleted file mode 100644 index 9c0181c1b..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/statement.jvm.lux +++ /dev/null @@ -1,48 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - [macro] - (data text/format)) - (luxc (lang [".L" module] - (host [lua #+ Lua Expression Statement]))) - [//] - (// [".T" runtime] - [".T" reference] - [".T" eval])) - -(def: #export (translate-def name expressionT expressionO metaV) - (-> Text Type Expression Code (Meta Any)) - (do macro.Monad<Meta> - [current-module macro.current-module-name - #let [def-name [current-module name]]] - (case (macro.get-identifier-ann (name-of #.alias) metaV) - (#.Some real-def) - (do @ - [[realT realA realV] (macro.find-def real-def) - _ (moduleL.define def-name [realT metaV realV])] - (wrap [])) - - _ - (do @ - [#let [def-name (referenceT.global def-name)] - _ (//.save (lua.global! def-name (#.Some expressionO))) - expressionV (evalT.eval def-name) - _ (moduleL.define def-name [expressionT metaV expressionV]) - _ (if (macro.type? metaV) - (case (macro.declared-tags metaV) - #.Nil - (wrap []) - - tags - (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV))) - (wrap [])) - #let [_ (log! (format "DEF " (%name def-name)))]] - (wrap [])) - ))) - -(def: #export (translate-program programO) - (-> Expression (Meta Statement)) - (macro.fail "translate-program NOT IMPLEMENTED YET") - ## (hostT.save (format "var " (referenceT.variable +0) " = " runtimeT.lux//program-args "();" - ## "(" programO ")(null);")) - ) diff --git a/new-luxc/source/luxc/lang/translation/lua/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/structure.jvm.lux deleted file mode 100644 index b6eeaa013..000000000 --- a/new-luxc/source/luxc/lang/translation/lua/structure.jvm.lux +++ /dev/null @@ -1,31 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do]) - (data [text] - text/format) - [macro]) - (luxc ["&" lang] - (lang [synthesis #+ Synthesis] - (host [js #+ JS Expression Statement]))) - [//] - (// [".T" runtime])) - -(def: #export (translate-tuple translate elemsS+) - (-> (-> Synthesis (Meta Expression)) (List Synthesis) (Meta Expression)) - (case elemsS+ - #.Nil - (:: macro.Monad<Meta> wrap runtimeT.unit) - - (#.Cons singletonS #.Nil) - (translate singletonS) - - _ - (do macro.Monad<Meta> - [elemsT+ (monad.map @ translate elemsS+)] - (wrap (format "{" (text.join-with "," elemsT+) "}"))))) - -(def: #export (translate-variant translate tag tail? valueS) - (-> (-> Synthesis (Meta Expression)) Nat Bit Synthesis (Meta Expression)) - (do macro.Monad<Meta> - [valueT (translate valueS)] - (wrap (runtimeT.variant tag tail? valueT)))) diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux index f5258db23..9212e0ad5 100644 --- a/stdlib/source/lux/data/number/nat.lux +++ b/stdlib/source/lux/data/number/nat.lux @@ -42,7 +42,7 @@ (def: * n/*) (def: / n//) (def: % n/%) - (def: (negate value) (n/- (:: ..interval top) value)) + (def: (negate value) (n/- value 0)) (def: abs function.identity) (def: (signum x) (case x diff --git a/stdlib/source/lux/host/lua.lux b/stdlib/source/lux/host/lua.lux new file mode 100644 index 000000000..ca72f1678 --- /dev/null +++ b/stdlib/source/lux/host/lua.lux @@ -0,0 +1,308 @@ +(.module: + [lux (#- Code int if cond function or and not let) + [control + [pipe (#+ case> cond> new>)]] + [data + [number + ["." frac]] + ["." text + format] + [collection + ["." list ("#@." functor fold)]]] + [macro + ["." template] + ["." code] + ["s" syntax (#+ syntax:)]] + [type + abstract]]) + +(def: input-separator ", ") +(def: statement-suffix ";") + +(def: nest + (-> Text Text) + (|>> (format text.new-line) + (text.replace-all text.new-line (format text.new-line text.tab)))) + +(abstract: #export (Code brand) + {} + + Text + + (def: #export manual + (-> Text Code) + (|>> :abstraction)) + + (def: #export code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>] + [(with-expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: #export (<brand> brand) {} Any)) + (`` (type: #export (<type> brand) + (<super> (<brand> brand)))))] + + [Expression Code] + [Computation Expression] + [Location Computation] + ) + + (template [<type> <super>] + [(with-expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: #export <brand> {} Any)) + (`` (type: #export <type> (<super> <brand>))))] + + [Literal Computation] + [Var Location] + [Access Location] + [Statement Code] + ) + + (def: #export nil + Literal + (:abstraction "nil")) + + (def: #export bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") + :abstraction)) + + (def: #export (int value) + (-> Int Literal) + (:abstraction (.if (i/< +0 value) + (%i value) + (%n (.nat value))))) + + (def: #export float + (-> Frac Literal) + (|>> (cond> [(f/= frac.positive-infinity)] + [(new> "(1.0/0.0)" [])] + + [(f/= frac.negative-infinity)] + [(new> "(-1.0/0.0)" [])] + + [(f/= frac.not-a-number)] + [(new> "(0.0/0.0)" [])] + + ## else + [%f]) + :abstraction)) + + (def: sanitize + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replace-all <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical-tab "\v"] + [text.null "\0"] + [text.back-space "\b"] + [text.form-feed "\f"] + [text.new-line "\n"] + [text.carriage-return "\r"] + [text.double-quote (format "\" text.double-quote)] + )) + ))) + + (def: #export string + (-> Text Literal) + (|>> ..sanitize (text.enclose' text.double-quote) :abstraction)) + + (def: #export array + (-> (List (Expression Any)) Literal) + (|>> (list@map ..code) + (text.join-with ..input-separator) + (text.enclose ["{" "}"]) + :abstraction)) + + (def: #export table + (-> (List [Text (Expression Any)]) Literal) + (|>> (list@map (.function (_ [key value]) + (format key " = " (:representation value)))) + (text.join-with ..input-separator) + (text.enclose ["{" "}"]) + :abstraction)) + + (def: #export (nth idx array) + (-> (Expression Any) (Expression Any) Access) + (:abstraction (format (:representation array) "[" (:representation idx) "]"))) + + (def: #export (the field table) + (-> Text (Expression Any) (Computation Any)) + (:abstraction (format (:representation table) "." field))) + + (def: #export length + (-> (Expression Any) (Computation Any)) + (|>> :representation + (text.enclose ["#(" ")"]) + :abstraction)) + + (def: #export (apply/* args func) + (-> (List (Expression Any)) (Expression Any) (Computation Any)) + (|> args + (list@map ..code) + (text.join-with ..input-separator) + (text.enclose ["(" ")"]) + (format (:representation func)) + :abstraction)) + + (def: #export (do method table args) + (-> Text (Expression Any) (List (Expression Any)) (Computation Any)) + (|> args + (list@map ..code) + (text.join-with ..input-separator) + (text.enclose ["(" ")"]) + (format (:representation table) ":" method) + :abstraction)) + + (template [<op> <name>] + [(def: #export (<name> parameter subject) + (-> (Expression Any) (Expression Any) (Expression Any)) + (:abstraction (format "(" + (:representation subject) + " " <op> " " + (:representation parameter) + ")")))] + + ["==" =] + ["<" <] + ["<=" <=] + [">" >] + [">=" >=] + ["+" +] + ["-" -] + ["*" *] + ["/" /] + ["//" //] + ["%" %] + [".." concat] + + ["or" or] + ["and" and] + ["|" bit-or] + ["&" bit-and] + ["~" bit-xor] + + ["<<" bit-shl] + [">>" bit-shr] + ) + + (def: #export (not subject) + (-> (Expression Any) (Expression Any)) + (:abstraction (format "(not " (:representation subject) ")"))) + + (def: #export var + (-> Text Var) + (|>> :abstraction)) + + (def: #export statement + (-> (Expression Any) Statement) + (|>> :representation (text.suffix ..statement-suffix) :abstraction)) + + (def: #export (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new-line + (:representation post!)))) + + (def: locations + (-> (List (Location Any)) Text) + (|>> (list@map ..code) + (text.join-with ..input-separator))) + + (def: #export (local vars) + (-> (List Var) Statement) + (:abstraction (format "local " (..locations vars) ..statement-suffix))) + + (def: #export (set vars value) + (-> (List (Location Any)) (Expression Any) Statement) + (:abstraction (format (..locations vars) " = " (:representation value) ..statement-suffix))) + + (def: #export (let vars value) + (-> (List Var) (Expression Any) Statement) + ($_ ..then + (local vars) + (set vars value))) + + (def: #export (if test then! else!) + (-> (Expression Any) Statement Statement Statement) + (:abstraction (format "if " (:representation test) + text.new-line "then" (..nest (:representation then!)) + text.new-line "else" (..nest (:representation else!)) + text.new-line "end" ..statement-suffix))) + + (def: #export (when test then!) + (-> (Expression Any) Statement Statement) + (:abstraction (format "if " (:representation test) + text.new-line "then" (..nest (:representation then!)) + text.new-line "end" ..statement-suffix))) + + (def: #export (while test body!) + (-> (Expression Any) Statement Statement) + (:abstraction + (format "while " (:representation test) " do" + (..nest (:representation body!)) + text.new-line "end" ..statement-suffix))) + + (def: #export (for-in vars source body!) + (-> (List Var) (Expression Any) Statement Statement) + (:abstraction + (format "for " (|> vars + (list@map ..code) + (text.join-with ..input-separator)) + " in " (:representation source) " do" + (..nest (:representation body!)) + text.new-line "end" ..statement-suffix))) + + (def: #export (for-step var from to step body!) + (-> Var (Expression Any) (Expression Any) (Expression Any) Statement + Statement) + (:abstraction + (format "for " (:representation var) + " = " (:representation from) + ..input-separator (:representation to) + ..input-separator (:representation step) " do" + (..nest (:representation body!)) + text.new-line "end" ..statement-suffix))) + + (def: #export (return value) + (-> (Expression Any) Statement) + (:abstraction (format "return " (:representation value) ..statement-suffix))) + + (def: #export (closure args body!) + (-> (List Var) Statement (Expression Any)) + (|> (format "function " (|> args + ..locations + (text.enclose ["(" ")"])) + (..nest (:representation body!)) + text.new-line "end") + (text.enclose ["(" ")"]) + :abstraction)) + + (def: #export (function name args body!) + (-> Var (List Var) Statement Statement) + (:abstraction + (format "function " (:representation name) + (|> args + ..locations + (text.enclose ["(" ")"])) + (..nest (:representation body!)) + text.new-line "end" ..statement-suffix))) + + (def: #export break + Statement + (|> "break" + (text.suffix ..statement-suffix) + :abstraction)) + ) + +(def: #export (cond clauses else!) + (-> (List [(Expression Any) Statement]) Statement Statement) + (list@fold (.function (_ [test then!] next!) + (..if test then! next!)) + else! + (list.reverse clauses))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua.lux new file mode 100644 index 000000000..480c473bf --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua.lux @@ -0,0 +1,60 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]]] + [/ + [runtime (#+ Phase)] + ["." primitive] + ["." structure] + ["." reference ("#@." system)] + ["." case] + ["." loop] + ["." function] + ["." /// + ["." extension] + [// + ["." synthesis]]]]) + +(def: #export (generate synthesis) + Phase + (case synthesis + (^template [<tag> <generator>] + (^ (<tag> value)) + (:: ///.monad wrap (<generator> value))) + ([synthesis.bit primitive.bit] + [synthesis.i64 primitive.i64] + [synthesis.f64 primitive.f64] + [synthesis.text primitive.text]) + + (^ (synthesis.variant variantS)) + (structure.variant generate variantS) + + (^ (synthesis.tuple members)) + (structure.tuple generate members) + + (#synthesis.Reference value) + (reference@reference value) + + (^ (synthesis.branch/case case)) + (case.case generate case) + + (^ (synthesis.branch/let let)) + (case.let generate let) + + (^ (synthesis.branch/if if)) + (case.if generate if) + + (^ (synthesis.loop/scope scope)) + (loop.scope generate scope) + + (^ (synthesis.loop/recur updates)) + (loop.recur generate updates) + + (^ (synthesis.function/abstraction abstraction)) + (function.function generate abstraction) + + (^ (synthesis.function/apply application)) + (function.apply generate application) + + (#synthesis.Extension extension) + (extension.apply generate extension))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/case.lux new file mode 100644 index 000000000..13683f0ca --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/case.lux @@ -0,0 +1,216 @@ +(.module: + [lux (#- case let if) + [abstract + [monad (#+ do)]] + [control + ["ex" exception (#+ exception:)]] + [data + ["." text + format] + [collection + ["." list ("#@." functor fold)] + ["." set]]] + [host + ["_" lua (#+ Expression Var Statement)]]] + ["." // #_ + ["#." runtime (#+ Operation Phase)] + ["#." reference] + ["#." primitive] + ["#/" // + ["#." reference] + ["#/" // ("#@." monad) + [synthesis + ["." case]] + ["#/" // #_ + ["." reference (#+ Register)] + ["#." synthesis (#+ Synthesis Path)]]]]]) + +(def: #export register + (///reference.local _.var)) + +(def: #export capture + (///reference.foreign _.var)) + +(def: #export (let generate [valueS register bodyS]) + (-> Phase [Synthesis Register Synthesis] + (Operation (Expression Any))) + (do ////.monad + [valueO (generate valueS) + bodyO (generate bodyS)] + ## TODO: Find some way to do 'let' without paying the price of the closure. + (wrap (|> bodyO + _.return + (_.closure (list (..register register))) + (_.apply/* (list valueO)))))) + +(def: #export (record-get generate valueS pathP) + (-> Phase Synthesis (List (Either Nat Nat)) + (Operation (Expression Any))) + (do ////.monad + [valueO (generate valueS)] + (wrap (list@fold (function (_ side source) + (.let [method (.case side + (^template [<side> <accessor>] + (<side> lefts) + (<accessor> (_.int (.int lefts)))) + ([#.Left //runtime.tuple//left] + [#.Right //runtime.tuple//right]))] + (method source))) + valueO + pathP)))) + +(def: #export (if generate [testS thenS elseS]) + (-> Phase [Synthesis Synthesis Synthesis] + (Operation (Expression Any))) + (do ////.monad + [testO (generate testS) + thenO (generate thenS) + elseO (generate elseS)] + (wrap (|> (_.if testO + (_.return thenO) + (_.return elseO)) + (_.closure (list)) + (_.apply/* (list)))))) + +(def: @savepoint (_.var "lux_pm_savepoint")) +(def: @cursor (_.var "lux_pm_cursor")) +(def: @temp (_.var "lux_pm_temp")) + +(def: (push! value) + (-> (Expression Any) Statement) + (_.statement (|> (_.var "table.insert") (_.apply/* (list @cursor value))))) + +(def: peek-and-pop + (Expression Any) + (|> (_.var "table.remove") (_.apply/* (list @cursor)))) + +(def: pop! + Statement + (_.statement ..peek-and-pop)) + +(def: peek + (Expression Any) + (_.nth (_.length @cursor) @cursor)) + +(def: save! + Statement + (_.statement (|> (_.var "table.insert") + (_.apply/* (list @savepoint + (//runtime.array//copy @cursor)))))) + +(def: restore! + Statement + (_.set (list @cursor) (|> (_.var "table.remove") (_.apply/* (list @savepoint))))) + +(def: fail! _.break) + +(exception: #export unrecognized-path) + +(template [<name> <flag> <prep>] + [(def: (<name> simple? idx) + (-> Bit Nat Statement) + ($_ _.then + (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) + (.if simple? + (_.when (_.= _.nil @temp) + fail!) + (_.if (_.= _.nil @temp) + fail! + (..push! @temp)))))] + + [left-choice _.nil (<|)] + [right-choice (_.string "") inc] + ) + +(def: (alternation pre! post!) + (-> Statement Statement Statement) + ($_ _.then + (_.while (_.bool true) + ($_ _.then + ..save! + pre!)) + ($_ _.then + ..restore! + post!))) + +(def: (pattern-matching' generate pathP) + (-> Phase Path (Operation Statement)) + (.case pathP + (^ (/////synthesis.path/then bodyS)) + (:: ////.monad map _.return (generate bodyS)) + + #/////synthesis.Pop + (////@wrap ..pop!) + + (#/////synthesis.Bind register) + (////@wrap (_.let (list (..register register)) ..peek)) + + (^template [<tag> <format>] + (^ (<tag> value)) + (////@wrap (_.when (|> value <format> (_.= ..peek) _.not) + fail!))) + ([/////synthesis.path/bit //primitive.bit] + [/////synthesis.path/i64 //primitive.i64] + [/////synthesis.path/f64 //primitive.f64] + [/////synthesis.path/text //primitive.text]) + + (^template [<complex> <simple> <choice>] + (^ (<complex> idx)) + (////@wrap (<choice> false idx)) + + (^ (<simple> idx nextP)) + (|> nextP + (pattern-matching' generate) + (:: ////.monad map (_.then (<choice> true idx))))) + ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice] + [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice]) + + (^ (/////synthesis.member/left 0)) + (////@wrap (|> ..peek (_.nth (_.int +1)) ..push!)) + + (^template [<pm> <getter>] + (^ (<pm> lefts)) + (////@wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push!))) + ([/////synthesis.member/left //runtime.tuple//left] + [/////synthesis.member/right //runtime.tuple//right]) + + (^ (/////synthesis.!bind-top register thenP)) + (do ////.monad + [then! (pattern-matching' generate thenP)] + (////@wrap ($_ _.then + (_.let (list (..register register)) ..peek-and-pop) + then!))) + + (^template [<tag> <combinator>] + (^ (<tag> preP postP)) + (do ////.monad + [pre! (pattern-matching' generate preP) + post! (pattern-matching' generate postP)] + (wrap (<combinator> pre! post!)))) + ([/////synthesis.path/seq _.then] + [/////synthesis.path/alt ..alternation]) + + _ + (////.throw unrecognized-path []))) + +(def: (pattern-matching generate pathP) + (-> Phase Path (Operation Statement)) + (do ////.monad + [pattern-matching! (pattern-matching' generate pathP)] + (wrap ($_ _.then + (_.while (_.bool true) + pattern-matching!) + (_.statement (|> (_.var "error") (_.apply/* (list (_.string case.pattern-matching-error))))))))) + +(def: #export (case generate [valueS pathP]) + (-> Phase [Synthesis Path] (Operation (Expression Any))) + (do ////.monad + [initG (generate valueS) + pattern-matching! (pattern-matching generate pathP)] + (wrap (|> ($_ _.then + (_.local (list @temp)) + (_.let (list @cursor) (_.array (list initG))) + (_.let (list @savepoint) (_.array (list))) + pattern-matching!) + (_.closure (list)) + (_.apply/* (list)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension.lux new file mode 100644 index 000000000..a40b4953f --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [data + [collection + ["." dictionary]]]] + [// + [runtime (#+ Bundle)]] + [/ + ["." common] + ["." host]]) + +(def: #export bundle + Bundle + (|> common.bundle + (dictionary.merge host.bundle))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux new file mode 100644 index 000000000..6d060f0bf --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/common.lux @@ -0,0 +1,145 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." function]] + [data + ["." product] + [collection + ["." dictionary]]] + [host (#+ import:) + ["_" lua (#+ Expression Literal)]]] + ["." /// #_ + ["#." runtime (#+ Operation Phase Handler Bundle)] + ["#." primitive] + [// + [extension (#+ Nullary Unary Binary Trinary + nullary unary binary trinary)] + [// + [extension + ["." bundle]]]]]) + +(template: (!unary function) + (|>> list _.apply/* (|> (_.var function)))) + +(def: lux-procs + Bundle + (|> bundle.empty + (bundle.install "is" (binary (product.uncurry _.=))) + (bundle.install "try" (unary ///runtime.lux//try)))) + +(def: i64-procs + Bundle + (<| (bundle.prefix "i64") + (|> bundle.empty + (bundle.install "and" (binary (product.uncurry _.bit-and))) + (bundle.install "or" (binary (product.uncurry _.bit-or))) + (bundle.install "xor" (binary (product.uncurry _.bit-xor))) + (bundle.install "left-shift" (binary (product.uncurry _.bit-shl))) + (bundle.install "logical-right-shift" (binary (product.uncurry ///runtime.i64//logic-right-shift))) + (bundle.install "arithmetic-right-shift" (binary (product.uncurry _.bit-shr))) + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "-" (binary (product.uncurry _.-))) + ))) + +(def: int-procs + Bundle + (<| (bundle.prefix "int") + (|> bundle.empty + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) + (bundle.install "frac" (unary (_./ (_.float +1.0)))) + (bundle.install "char" (unary (!unary "string.char")))))) + +(import: #long java/lang/Double + (#static MIN_VALUE Double) + (#static MAX_VALUE Double)) + +(template [<name> <const>] + [(def: (<name> _) + (Nullary Literal) + (_.float <const>))] + + [frac//smallest (java/lang/Double::MIN_VALUE)] + [frac//min (f/* -1.0 (java/lang/Double::MAX_VALUE))] + [frac//max (java/lang/Double::MAX_VALUE)] + ) + +(def: frac//decode + (Unary (Expression Any)) + (|>> list _.apply/* (|> (_.var "tonumber")) _.return (_.closure (list)) ///runtime.lux//try)) + +(def: frac-procs + Bundle + (<| (bundle.prefix "frac") + (|> bundle.empty + (bundle.install "+" (binary (product.uncurry _.+))) + (bundle.install "-" (binary (product.uncurry _.-))) + (bundle.install "*" (binary (product.uncurry _.*))) + (bundle.install "/" (binary (product.uncurry _./))) + (bundle.install "%" (binary (product.uncurry _.%))) + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "smallest" (nullary frac//smallest)) + (bundle.install "min" (nullary frac//min)) + (bundle.install "max" (nullary frac//max)) + (bundle.install "int" (unary (!unary "math.floor"))) + (bundle.install "encode" (unary (!unary "tostring"))) + (bundle.install "decode" (unary ..frac//decode))))) + +(def: (text//char [subjectO paramO]) + (Binary (Expression Any)) + (///runtime.text//char subjectO paramO)) + +(def: (text//clip [paramO extraO subjectO]) + (Trinary (Expression Any)) + (///runtime.text//clip subjectO paramO extraO)) + +(def: (text//index [startO partO textO]) + (Trinary (Expression Any)) + (///runtime.text//index textO partO startO)) + +(def: text-procs + Bundle + (<| (bundle.prefix "text") + (|> bundle.empty + (bundle.install "=" (binary (product.uncurry _.=))) + (bundle.install "<" (binary (product.uncurry _.<))) + (bundle.install "concat" (binary (product.uncurry (function.flip _.concat)))) + (bundle.install "index" (trinary text//index)) + (bundle.install "size" (unary (|>> list _.apply/* (|> (_.var "string.len"))))) + (bundle.install "char" (binary (product.uncurry ///runtime.text//char))) + (bundle.install "clip" (trinary text//clip)) + ))) + +(def: (io//log! messageO) + (Unary (Expression Any)) + (_.or (_.apply/* (list messageO) (_.var "print")) + ///runtime.unit)) + +(def: io-procs + Bundle + (<| (bundle.prefix "io") + (|> bundle.empty + (bundle.install "log" (unary ..io//log!)) + (bundle.install "error" (unary (!unary "error"))) + (bundle.install "exit" (unary (!unary "os.exit"))) + (bundle.install "current-time" (nullary (function (_ _) + (|> (_.var "os.time") + (_.apply/* (list)) + (_.* (_.int +1,000))))))))) + +(def: #export bundle + Bundle + (<| (bundle.prefix "lux") + (|> lux-procs + (dictionary.merge i64-procs) + (dictionary.merge int-procs) + (dictionary.merge frac-procs) + (dictionary.merge text-procs) + (dictionary.merge io-procs) + ))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/host.lux new file mode 100644 index 000000000..9c178e79c --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/extension/host.lux @@ -0,0 +1,25 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [data + ["." product] + [collection + ["." dictionary]]] + [host + ["_" lua (#+ Expression)]]] + ["." /// #_ + ["#." runtime (#+ Handler Bundle)] + ["#/" // #_ + ["#." extension (#+ Nullary Unary Binary Trinary Variadic + nullary unary binary trinary variadic)] + ["#/" // + ["#." extension + ["." bundle]] + ["#/" // #_ + ["#." synthesis]]]]]) + +(def: #export bundle + Bundle + (<| (bundle.prefix "lua") + bundle.empty)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/function.lux new file mode 100644 index 000000000..517af6550 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/function.lux @@ -0,0 +1,106 @@ +(.module: + [lux (#- function) + [abstract + ["." monad (#+ do)]] + [control + pipe] + [data + ["." product] + [text + format] + [collection + ["." list ("#@." functor fold)]]] + [host + ["_" lua (#+ Expression Statement)]]] + ["." // #_ + ["#." runtime (#+ Operation Phase)] + ["#." reference] + ["#." case] + ["#/" // + ["#." reference] + ["#/" // + ["." // #_ + [reference (#+ Register Variable)] + [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)] + [synthesis (#+ Synthesis)]]]]]) + +(def: #export (apply generate [functionS argsS+]) + (-> Phase (Application Synthesis) (Operation (Expression Any))) + (do ////.monad + [functionO (generate functionS) + argsO+ (monad.map @ generate argsS+)] + (wrap (_.apply/* argsO+ functionO)))) + +(def: #export capture + (///reference.foreign _.var)) + +(def: (with-closure function-name inits function-definition) + (-> Text (List (Expression Any)) Statement (Operation (Expression Any))) + (case inits + #.Nil + (do ////.monad + [_ (///.save! ["" function-name] + function-definition)] + (wrap (|> (_.var function-name) (_.apply/* inits)))) + + _ + (do ////.monad + [@closure (:: @ map _.var (///.gensym "closure")) + _ (///.save! ["" (_.code @closure)] + (_.function @closure + (|> (list.enumerate inits) + (list@map (|>> product.left ..capture))) + ($_ _.then + function-definition + (_.return (_.var function-name)))))] + (wrap (_.apply/* inits @closure))))) + +(def: input + (|>> inc //case.register)) + +(def: #export (function generate [environment arity bodyS]) + (-> Phase (Abstraction Synthesis) (Operation (Expression Any))) + (do ////.monad + [[function-name bodyO] (///.with-context + (do @ + [function-name ///.context] + (///.with-anchor (_.var function-name) + (generate bodyS)))) + closureO+ (: (Operation (List (Expression Any))) + (monad.map @ (:: //reference.system variable) environment)) + #let [@curried (_.var "curried") + arityO (|> arity .int _.int) + @num-args (_.var "num_args") + @self (_.var function-name) + initialize-self! (_.let (list (//case.register 0)) @self) + initialize! (list@fold (.function (_ post pre!) + ($_ _.then + pre! + (_.let (list (..input post)) (_.nth (|> post inc .int _.int) @curried)))) + initialize-self! + (list.indices arity)) + pack (|>> (list) _.apply/* (|> (_.var "table.pack"))) + unpack (|>> (list) _.apply/* (|> (_.var "table.unpack"))) + @var-args (_.var "...")]] + (with-closure function-name closureO+ + (_.function @self (list @var-args) + ($_ _.then + (_.let (list @curried) (pack @var-args)) + (_.let (list @num-args) (_.the "n" @curried)) + (_.cond (list [(|> @num-args (_.= (_.int +0))) + (_.return @self)] + [(|> @num-args (_.= arityO)) + ($_ _.then + initialize! + (_.return bodyO))] + [(|> @num-args (_.> arityO)) + (let [arity-inputs (//runtime.array//sub (_.int +0) arityO @curried) + extra-inputs (//runtime.array//sub arityO @num-args @curried)] + (_.return (|> @self + (_.apply/* (list (unpack arity-inputs))) + (_.apply/* (list (unpack extra-inputs))))))]) + ## (|> @num-args (_.< arityO)) + (_.return (_.closure (list @var-args) + (_.return (|> @self (_.apply/* (list (unpack (//runtime.array//concat @curried (pack @var-args)))))))))) + ))) + )) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/loop.lux new file mode 100644 index 000000000..41ebb4766 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/loop.lux @@ -0,0 +1,40 @@ +(.module: + [lux (#- Scope) + [abstract + ["." monad (#+ do)]] + [data + ["." product] + [text + format] + [collection + ["." list ("#@." functor)]]] + [host + ["_" lua (#+ Expression)]]] + ["." // #_ + [runtime (#+ Operation Phase)] + ["#." case] + ["#/" // + ["#/" // + [// + [synthesis (#+ Scope Synthesis)]]]]]) + +(def: #export (scope generate [start initsS+ bodyS]) + (-> Phase (Scope Synthesis) (Operation (Expression Any))) + (do ////.monad + [@loop (:: @ map (|>> %n (format "loop") _.var) ///.next) + initsO+ (monad.map @ generate initsS+) + bodyO (///.with-anchor @loop + (generate bodyS)) + _ (///.save! ["" (_.code @loop)] + (_.function @loop (|> initsS+ + list.enumerate + (list@map (|>> product.left (n/+ start) //case.register))) + (_.return bodyO)))] + (wrap (_.apply/* initsO+ @loop)))) + +(def: #export (recur generate argsS+) + (-> Phase (List Synthesis) (Operation (Expression Any))) + (do ////.monad + [@scope ///.anchor + argsO+ (monad.map @ generate argsS+)] + (wrap (_.apply/* argsO+ @scope)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/primitive.lux new file mode 100644 index 000000000..47ccf5006 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/primitive.lux @@ -0,0 +1,27 @@ +(.module: + [lux (#- i64) + [control + [pipe (#+ cond> new>)]] + [data + [number + ["." frac]]] + [host + ["_" lua (#+ Literal)]]] + ["." // #_ + ["#." runtime]]) + +(def: #export bit + (-> Bit Literal) + _.bool) + +(def: #export i64 + (-> (I64 Any) Literal) + (|>> .int _.int)) + +(def: #export f64 + (-> Frac Literal) + _.float) + +(def: #export text + (-> Text Literal) + _.string) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/reference.lux new file mode 100644 index 000000000..62c69e8bc --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/reference.lux @@ -0,0 +1,11 @@ +(.module: + [lux #* + [host + ["_" lua (#+ Expression)]]] + [// + [// + ["." reference]]]) + +(def: #export system + (reference.system (: (-> Text (Expression Any)) _.var) + (: (-> Text (Expression Any)) _.var))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux new file mode 100644 index 000000000..5e45682d1 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux @@ -0,0 +1,358 @@ +(.module: + [lux (#- inc) + [abstract + [monad (#+ do)]] + [control + ["." function] + ["p" parser]] + [data + [number (#+ hex) + ["." i64]] + ["." text + format] + [collection + ["." list ("#@." functor)]]] + ["." macro + ["." code] + ["s" syntax (#+ syntax:)]] + [host + ["_" lua (#+ Expression Location Var Computation Literal Statement)]]] + ["." /// + ["//." // + [// + ["/////." name] + ["." synthesis]]]] + ) + +(template [<name> <base>] + [(type: #export <name> + (<base> Var (Expression Any) Statement))] + + [Operation ///.Operation] + [Phase ///.Phase] + [Handler ///.Handler] + [Bundle ///.Bundle] + ) + +(def: prefix Text "LuxRuntime") + +(def: #export unit (_.string synthesis.unit)) + +(def: (flag value) + (-> Bit Literal) + (if value + (_.string "") + _.nil)) + +(def: #export variant-tag-field "_lux_tag") +(def: #export variant-flag-field "_lux_flag") +(def: #export variant-value-field "_lux_value") + +(def: (variant' tag last? value) + (-> (Expression Any) (Expression Any) (Expression Any) Literal) + (_.table (list [..variant-tag-field tag] + [..variant-flag-field last?] + [..variant-value-field value]))) + +(def: #export (variant tag last? value) + (-> Nat Bit (Expression Any) Literal) + (variant' (_.int (.int tag)) + (flag last?) + value)) + +(def: #export none + Literal + (..variant 0 #0 unit)) + +(def: #export some + (-> (Expression Any) Literal) + (..variant 1 #1)) + +(def: #export left + (-> (Expression Any) Literal) + (..variant 0 #0)) + +(def: #export right + (-> (Expression Any) Literal) + (..variant 1 #1)) + +(def: runtime-name + (-> Text Var) + (|>> /////name.normalize + (format ..prefix "_") + _.var)) + +(def: (feature name definition) + (-> Var (-> Var Statement) Statement) + (definition name)) + +(syntax: #export (with-vars {vars (s.tuple (p.some s.local-identifier))} + body) + (wrap (list (` (let [(~+ (|> vars + (list@map (function (_ var) + (list (code.local-identifier var) + (` (_.var (~ (code.text (/////name.normalize var)))))))) + list.concat))] + (~ body)))))) + +(syntax: (runtime: {declaration (p.or s.local-identifier + (s.form (p.and s.local-identifier + (p.some s.local-identifier))))} + code) + (case declaration + (#.Left name) + (macro.with-gensyms [g!_] + (let [nameC (code.local-identifier name) + code-nameC (code.local-identifier (format "@" name)) + runtime-nameC (` (runtime-name (~ (code.text name))))] + (wrap (list (` (def: #export (~ nameC) Var (~ runtime-nameC))) + (` (def: (~ code-nameC) + Statement + (..feature (~ runtime-nameC) + (function ((~ g!_) (~ nameC)) + (_.set (~ nameC) (~ code)))))))))) + + (#.Right [name inputs]) + (macro.with-gensyms [g!_] + (let [nameC (code.local-identifier name) + code-nameC (code.local-identifier (format "@" name)) + runtime-nameC (` (runtime-name (~ (code.text name)))) + inputsC (list@map code.local-identifier inputs) + inputs-typesC (list@map (function.constant (` (_.Expression Any))) + inputs)] + (wrap (list (` (def: #export ((~ nameC) (~+ inputsC)) + (-> (~+ inputs-typesC) (Computation Any)) + (_.apply/* (list (~+ inputsC)) (~ runtime-nameC)))) + (` (def: (~ code-nameC) + Statement + (..feature (~ runtime-nameC) + (function ((~ g!_) (~ g!_)) + (..with-vars [(~+ inputsC)] + (_.function (~ g!_) (list (~+ inputsC)) + (~ code))))))))))))) + +(def: (nth index table) + (-> (Expression Any) (Expression Any) (Location Any)) + (_.nth (_.+ (_.int +1) index) table)) + +(def: last-index (|>> _.length (_.- (_.int +1)))) + +(runtime: (tuple//left lefts tuple) + (with-vars [last-right] + ($_ _.then + (_.let (list last-right) (..last-index tuple)) + (_.if (_.> lefts last-right) + ## No need for recursion + (_.return (..nth lefts tuple)) + ## Needs recursion + (_.return (tuple//left (_.- last-right lefts) + (..nth last-right tuple))))))) + +(runtime: (array//sub from to array) + (with-vars [temp idx] + ($_ _.then + (_.let (list temp) (_.array (list))) + (_.for-step idx from (_.- (_.int +1) to) (_.int +1) + (|> (_.var "table.insert") + (_.apply/* (list temp (..nth idx array))) + _.statement)) + (_.return temp)))) + +(runtime: (tuple//right lefts tuple) + (with-vars [last-right right-index] + ($_ _.then + (_.let (list last-right) (..last-index tuple)) + (_.let (list right-index) (_.+ (_.int +1) lefts)) + (_.cond (list [(_.= right-index last-right) + (_.return (..nth right-index tuple))] + [(_.> right-index last-right) + ## Needs recursion. + (_.return (tuple//right (_.- last-right lefts) + (..nth last-right tuple)))]) + (_.return (array//sub right-index (_.length tuple) tuple))) + ))) + +(runtime: (sum//get sum wantsLast wantedTag) + (let [no-match! (_.return _.nil) + sum-tag (_.the ..variant-tag-field sum) + sum-flag (_.the ..variant-flag-field sum) + sum-value (_.the ..variant-value-field sum) + is-last? (_.= (_.string "") sum-flag) + test-recursion! (_.if is-last? + ## Must recurse. + (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag))) + no-match!)] + (_.cond (list [(_.= sum-tag wantedTag) + (_.if (_.= wantsLast sum-flag) + (_.return sum-value) + test-recursion!)] + + [(_.> sum-tag wantedTag) + test-recursion!] + + [(_.and (_.< sum-tag wantedTag) + (_.= (_.string "") wantsLast)) + (_.return (variant' (_.- wantedTag sum-tag) sum-flag sum-value))]) + + no-match!))) + +(runtime: (array//copy array) + (with-vars [temp idx] + ($_ _.then + (_.let (list temp) (_.array (list))) + (<| (_.for-step idx (_.int +1) (_.length array) (_.int +1)) + (_.statement (|> (_.var "table.insert") (_.apply/* (list temp (_.nth idx array)))))) + (_.return temp)))) + +(runtime: (array//concat left right) + (with-vars [temp idx] + (let [copy! (function (_ input output) + (<| (_.for-step idx (_.int +1) (_.the "n" input) (_.int +1)) + (_.statement (|> (_.var "table.insert") (_.apply/* (list output (_.nth idx input)))))))] + ($_ _.then + (_.let (list temp) (_.array (list))) + (copy! left temp) + (copy! right temp) + (_.return temp))))) + +(def: runtime//adt + Statement + ($_ _.then + @tuple//left + @array//sub + @tuple//right + @sum//get + @array//copy + @array//concat)) + +(runtime: (lux//try risky) + (with-vars [success value] + ($_ _.then + (_.let (list success value) (|> risky (_.apply/* (list ..unit)) + _.return (_.closure (list)) + list _.apply/* (|> (_.var "pcall")))) + (_.if success + (_.return (..right value)) + (_.return (..left value)))))) + +(runtime: (lux//program-args raw) + (with-vars [tail head idx] + ($_ _.then + (_.let (list tail) ..none) + (<| (_.for-step idx (_.length raw) (_.int +1) (_.int -1)) + (_.set (list tail) (..some (_.array (list (_.nth idx raw) + tail))))) + (_.return tail)))) + +(def: runtime//lux + Statement + ($_ _.then + @lux//try + @lux//program-args)) + +(runtime: (i64//logic-right-shift param subject) + (let [mask (|> (_.int +1) + (_.bit-shl (_.- param (_.int +64))) + (_.- (_.int +1)))] + (_.return (|> subject + (_.bit-shr param) + (_.bit-and mask))))) + +(def: runtime//i64 + Statement + ($_ _.then + @i64//logic-right-shift + )) + +(runtime: (text//index subject param start) + (with-vars [idx] + ($_ _.then + (_.let (list idx) (_.apply/* (list subject param start (_.bool #1)) + (_.var "string.find"))) + (_.if (_.= _.nil idx) + (_.return ..none) + (_.return (..some idx)))))) + +(runtime: (text//clip text from to) + (with-vars [size] + ($_ _.then + (_.let (list size) (_.apply/* (list text) (_.var "string.len"))) + (_.if (_.or (_.> size from) + (_.> size to)) + (_.return ..none) + (_.return (..some (_.apply/* (list text from to) (_.var "string.sub"))))) + ))) + +(runtime: (text//char idx text) + (with-vars [char] + ($_ _.then + (_.let (list char) (_.apply/* (list text idx) (_.var "string.byte"))) + (_.if (_.= _.nil char) + (_.return ..none) + (_.return (..some char)))))) + +(def: runtime//text + Statement + ($_ _.then + @text//index + @text//clip + @text//char)) + +(runtime: (array//new size) + (with-vars [output idx] + ($_ _.then + (_.let (list output) (_.array (list))) + (_.for-step idx (_.int +1) size (_.int +1) + (_.statement (_.apply/* (list output ..unit) (_.var "table.insert")))) + (_.return output)))) + +(runtime: (array//get array idx) + (with-vars [temp] + ($_ _.then + (_.let (list temp) (..nth idx array)) + (_.if (_.or (_.= _.nil temp) + (_.= ..unit temp)) + (_.return ..none) + (_.return (..some temp)))))) + +(runtime: (array//put array idx value) + ($_ _.then + (_.set (list (..nth idx array)) value) + (_.return array))) + +(def: runtime//array + Statement + ($_ _.then + @array//new + @array//get + @array//put + )) + +(runtime: (box//write value box) + ($_ _.then + (_.set (list (_.nth (_.int +1) box)) value) + (_.return ..unit))) + +(def: runtime//box + Statement + @box//write) + +(def: runtime + Statement + ($_ _.then + runtime//adt + runtime//lux + runtime//i64 + runtime//text + runtime//array + runtime//box + )) + +(def: #export artifact ..prefix) + +(def: #export generate + (Operation Any) + (///.with-buffer + (do ////.monad + [_ (///.save! ["" ..prefix] ..runtime)] + (///.save-buffer! ..artifact)))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/structure.lux new file mode 100644 index 000000000..2fab4daf0 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/structure.lux @@ -0,0 +1,36 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [host + ["_" lua (#+ Expression)]]] + ["." // #_ + ["#." runtime (#+ Operation Phase)] + ["#." primitive] + ["#//" /// + ["#/" // #_ + [analysis (#+ Variant Tuple)] + ["#." synthesis (#+ Synthesis)]]]]) + +(def: #export (tuple generate elemsS+) + (-> Phase (Tuple Synthesis) (Operation (Expression Any))) + (case elemsS+ + #.Nil + (:: ////.monad wrap (//primitive.text /////synthesis.unit)) + + (#.Cons singletonS #.Nil) + (generate singletonS) + + _ + (|> elemsS+ + (monad.map ////.monad generate) + (:: ////.monad map _.array)))) + +(def: #export (variant generate [lefts right? valueS]) + (-> Phase (Variant Synthesis) (Operation (Expression Any))) + (:: ////.monad map + (//runtime.variant (if right? + (inc lefts) + lefts) + right?) + (generate valueS))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux index 0b84f4741..bdb0a8d2b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux @@ -39,35 +39,35 @@ (def: #export unit (_.string synthesis.unit)) (def: (flag value) - (-> Bit (Computation Any)) + (-> Bit Literal) (if value (_.string "") _.none)) (def: (variant' tag last? value) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (-> (Expression Any) (Expression Any) (Expression Any) Literal) (_.tuple (list tag last? value))) (def: #export (variant tag last? value) - (-> Nat Bit (Expression Any) (Computation Any)) + (-> Nat Bit (Expression Any) Literal) (variant' (_.int (.int tag)) (flag last?) value)) (def: #export none - (Computation Any) + Literal (..variant 0 #0 unit)) (def: #export some - (-> (Expression Any) (Computation Any)) + (-> (Expression Any) Literal) (..variant 1 #1)) (def: #export left - (-> (Expression Any) (Computation Any)) + (-> (Expression Any) Literal) (..variant 0 #0)) (def: #export right - (-> (Expression Any) (Computation Any)) + (-> (Expression Any) Literal) (..variant 1 #1)) (def: runtime-name diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux index 01b405dff..18979b0fa 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/case.lux @@ -11,7 +11,7 @@ ["." list ("#@." functor fold)] ["." set]]] [host - ["_" ruby (#+ Expression LVar Statement)]]] + ["_" ruby (#+ Expression Statement)]]] ["." // #_ ["#." runtime (#+ Operation Phase)] ["#." reference] @@ -97,7 +97,7 @@ (Statement Any) (_.set (list @cursor) (|> @savepoint (_.do "pop" (list))))) -(def: fail-pm! _.break) +(def: fail! _.break) (exception: #export unrecognized-path) @@ -114,9 +114,9 @@ (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) (.if simple? (_.when (_.= _.nil @temp) - fail-pm!) + fail!) (_.if (_.= _.nil @temp) - fail-pm! + fail! (..push! @temp)))))] [left-choice _.nil (<|)] @@ -149,7 +149,7 @@ (^template [<tag> <format>] (^ (<tag> value)) (////@wrap (_.when (|> value <format> (_.= ..peek) _.not) - fail-pm!))) + fail!))) ([/////synthesis.path/bit //primitive.bit] [/////synthesis.path/i64 //primitive.i64] [/////synthesis.path/f64 //primitive.f64] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/primitive.lux index 4ec058ffe..3fa59aaf4 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/primitive.lux @@ -6,22 +6,22 @@ [number ["." frac]]] [host - ["_" ruby (#+ Expression)]]] + ["_" ruby (#+ Literal)]]] ["." // #_ ["#." runtime]]) (def: #export bit - (-> Bit (Expression Any)) + (-> Bit Literal) _.bool) (def: #export i64 - (-> (I64 Any) (Expression Any)) + (-> (I64 Any) Literal) (|>> .int _.int)) (def: #export f64 - (-> Frac (Expression Any)) + (-> Frac Literal) _.float) (def: #export text - (-> Text (Expression Any)) + (-> Text Literal) _.string) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index f73319739..21e529ecc 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -3,8 +3,8 @@ [structure (#+)] [reference (#+)] [case (#+)] - [function (#+)] [loop (#+)] + [function (#+)] [extension (#+) [common (#+)] [host (#+)]])] @@ -38,6 +38,7 @@ [host [js (#+)] [python (#+)] + [lua (#+)] [ruby (#+)] [scheme (#+)]] [tool @@ -48,6 +49,8 @@ <host-modules>] [python (#+) <host-modules>] + [lua (#+) + <host-modules>] [ruby (#+) <host-modules>] [scheme (#+) @@ -381,4 +384,5 @@ ## (_.seed 16966479879996440699) ## (_.seed 16140950815046933697) ## (_.seed 8804587020128699091) + ## (_.seed 9353282359333487462) ..test)) |