aboutsummaryrefslogtreecommitdiff
path: root/lux-lua/source
diff options
context:
space:
mode:
authorEduardo Julian2019-04-11 22:30:05 -0400
committerEduardo Julian2019-04-11 22:30:05 -0400
commitf2937706edb6887c5eb1a6a0b6668b1334f5ef3b (patch)
treee2c3b657aaa39b61ff0746fa0f59416514f87206 /lux-lua/source
parent6c3e9f8c02ce153380392ba5bc8eeb517de5f781 (diff)
WIP: Lua compiler.
Diffstat (limited to 'lux-lua/source')
-rw-r--r--lux-lua/source/program.lux430
1 files changed, 430 insertions, 0 deletions
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)))