diff options
Diffstat (limited to 'lux-cl')
| -rw-r--r-- | lux-cl/commands.md | 23 | ||||
| -rw-r--r-- | lux-cl/source/program.lux | 476 |
2 files changed, 314 insertions, 185 deletions
diff --git a/lux-cl/commands.md b/lux-cl/commands.md new file mode 100644 index 000000000..baefd65b7 --- /dev/null +++ b/lux-cl/commands.md @@ -0,0 +1,23 @@ +# Common Lisp compiler + +## Test + +``` +cd ~/lux/lux-cl/ && lein lux auto test +cd ~/lux/lux-cl/ && lein clean && lein lux auto test +``` + +## Build + +``` +## Develop +cd ~/lux/lux-cl/ \ +&& lein clean \ +&& lein lux auto build +``` + +## Try + +``` +cd ~/lux/lux-cl/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +``` diff --git a/lux-cl/source/program.lux b/lux-cl/source/program.lux index 8d6218297..89b2b937c 100644 --- a/lux-cl/source/program.lux +++ b/lux-cl/source/program.lux @@ -1,116 +1,151 @@ (.module: [lux #* - ["." host (#+ import: interface: do-to object)] + [program (#+ program:)] + ["." ffi] + ["." debug] [abstract - [monad (#+ do)]] + ["." monad (#+ do)]] [control - [pipe (#+ new> case>)] + [pipe (#+ exec> case> new>)] + ["." try (#+ Try)] ["." exception (#+ exception:)] ["." io (#+ IO io)] - [parser - [cli (#+ program:)]]] + [concurrency + ["." promise (#+ Promise)]]] [data ["." maybe] - ["." error (#+ Error)] - [number - ["." i64]] - ["." text ("#/." hash) - format] + ["." text ("#\." hash) + ["%" format (#+ format)] + ["." encoding]] [collection - ["." array (#+ Array)] - ["." list ("#/." functor)]]] + ["." array (#+ Array)]]] [macro ["." template]] - [world - ["." file]] - ["." debug] - [target - ["_" common-lisp]] + [math + [number (#+ hex) + ["n" nat] + ["." i64]]] + ["." world #_ + ["." file] + ["#/." program]] + ["@" target + ["_" common_lisp]] [tool [compiler - ["." name] - ["." synthesis] - [phase - [macro (#+ Expander)] - ["." generation - ["." common-lisp - ["." runtime] - ["." extension]]]] + [phase (#+ Operation Phase)] + [reference + [variable (#+ Register)]] + [language + [lux + [program (#+ Program)] + [generation (#+ Context Host)] + ["." synthesis] + [analysis + [macro (#+ Expander)]] + [phase + ["." extension (#+ Extender Handler) + ["#/." bundle] + ["." analysis #_ + ["#" common_lisp]] + ["." generation #_ + ["#" common_lisp]]] + [generation + ["." reference] + ["." common_lisp + ["." runtime]]]]]] [default - ["." platform (#+ Platform)]]]]] + ["." platform (#+ Platform)]] + [meta + ["." packager #_ + ["#" script]]]]]] [program ["/" compositor - ["/." cli]]]) - -(import: #long java/lang/String) - -(import: #long (java/lang/Class a) - (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object))) - -(import: #long java/lang/Object - (toString [] java/lang/String) - (getClass [] (java/lang/Class java/lang/Object))) - -(import: #long java/lang/Long - (intValue [] java/lang/Integer)) - -(import: #long java/lang/Integer - (longValue [] long)) - -(import: #long java/lang/Number - (intValue [] java/lang/Integer) - (longValue [] long) - (doubleValue [] double)) - -(import: #long org/armedbear/lisp/LispObject - (length [] int) - (NTH [int] org/armedbear/lisp/LispObject) - (SVREF [int] org/armedbear/lisp/LispObject) - (elt [int] org/armedbear/lisp/LispObject) - (execute [org/armedbear/lisp/LispObject org/armedbear/lisp/LispObject] #try org/armedbear/lisp/LispObject)) + ["#." cli] + ["#." static]]]) + +(ffi.import: java/lang/String) + +(ffi.import: (java/lang/Class a) + ["#::." + (#static forName [java/lang/String] #try (java/lang/Class java/lang/Object))]) + +(ffi.import: java/lang/Object + ["#::." + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))]) + +(ffi.import: java/lang/Long + ["#::." + (intValue [] java/lang/Integer)]) + +(ffi.import: java/lang/Integer + ["#::." + (longValue [] long)]) + +(ffi.import: java/lang/Number + ["#::." + (intValue [] java/lang/Integer) + (longValue [] long) + (doubleValue [] double)]) + +(ffi.import: org/armedbear/lisp/LispObject + ["#::." + (length [] int) + (NTH [int] org/armedbear/lisp/LispObject) + (SVREF [int] org/armedbear/lisp/LispObject) + (elt [int] org/armedbear/lisp/LispObject) + (execute [org/armedbear/lisp/LispObject org/armedbear/lisp/LispObject] #try org/armedbear/lisp/LispObject)]) ## The org/armedbear/lisp/Interpreter must be imported before the ## other ones, because there is an order dependency in their static initialization. -(import: #long org/armedbear/lisp/Interpreter - (#static getInstance [] org/armedbear/lisp/Interpreter) - (#static createInstance [] #? org/armedbear/lisp/Interpreter) - (eval [java/lang/String] #try org/armedbear/lisp/LispObject)) +(ffi.import: org/armedbear/lisp/Interpreter + ["#::." + (#static getInstance [] org/armedbear/lisp/Interpreter) + (#static createInstance [] #? org/armedbear/lisp/Interpreter) + (eval [java/lang/String] #try org/armedbear/lisp/LispObject)]) -(import: #long org/armedbear/lisp/Symbol - (#static T org/armedbear/lisp/Symbol)) +(ffi.import: org/armedbear/lisp/Symbol + ["#::." + (#static T org/armedbear/lisp/Symbol)]) -(import: #long org/armedbear/lisp/DoubleFloat - (new [double]) - (doubleValue [] double)) +(ffi.import: org/armedbear/lisp/DoubleFloat + ["#::." + (new [double]) + (doubleValue [] double)]) -(import: #long org/armedbear/lisp/SimpleString - (new [java/lang/String]) - (getStringValue [] java/lang/String)) +(ffi.import: org/armedbear/lisp/SimpleString + ["#::." + (new [java/lang/String]) + (getStringValue [] java/lang/String)]) -(import: #long org/armedbear/lisp/LispInteger) +(ffi.import: org/armedbear/lisp/LispInteger) -(import: #long org/armedbear/lisp/Bignum - (longValue [] long) - (#static getInstance [long] org/armedbear/lisp/LispInteger)) +(ffi.import: org/armedbear/lisp/Bignum + ["#::." + (longValue [] long) + (#static getInstance [long] org/armedbear/lisp/LispInteger)]) -(import: #long org/armedbear/lisp/Fixnum - (longValue [] long) - (#static getInstance [int] org/armedbear/lisp/Fixnum)) +(ffi.import: org/armedbear/lisp/Fixnum + ["#::." + (longValue [] long) + (#static getInstance [int] org/armedbear/lisp/Fixnum)]) -(import: #long org/armedbear/lisp/Nil - (#static NIL org/armedbear/lisp/Symbol)) +(ffi.import: org/armedbear/lisp/Nil + ["#::." + (#static NIL org/armedbear/lisp/Symbol)]) -(import: #long org/armedbear/lisp/SimpleVector) +(ffi.import: org/armedbear/lisp/SimpleVector) -(import: #long org/armedbear/lisp/Cons) +(ffi.import: org/armedbear/lisp/Cons) -(import: #long org/armedbear/lisp/Closure) +(ffi.import: org/armedbear/lisp/Closure) -(interface: LuxADT +(ffi.interface: LuxADT (getValue [] java/lang/Object)) -(import: #long program/LuxADT - (getValue [] java/lang/Object)) +(ffi.import: program/LuxADT + ["#::." + (getValue [] java/lang/Object)]) (template [<name>] [(exception: (<name> {object java/lang/Object}) @@ -118,44 +153,44 @@ ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))] ["Object" (java/lang/Object::toString object)]))] - [unknown-kind-of-object] - [cannot-apply-a-non-function] + [unknown_kind_of_object] + [cannot_apply_a_non_function] ) -(def: host-bit +(def: host_bit (-> Bit org/armedbear/lisp/LispObject) (|>> (case> #0 (org/armedbear/lisp/Nil::NIL) #1 (org/armedbear/lisp/Symbol::T)))) -(def: (host-value value) +(def: (host_value value) (-> Any org/armedbear/lisp/LispObject) - (let [to-sub (: (-> Any org/armedbear/lisp/LispObject) - (function (_ sub-value) - (let [sub-value (:coerce java/lang/Object sub-value)] + (let [to_sub (: (-> Any org/armedbear/lisp/LispObject) + (function (_ sub_value) + (let [sub_value (:coerce java/lang/Object sub_value)] (`` (<| (~~ (template [<type> <then>] - [(case (host.check <type> sub-value) - (#.Some sub-value) - (`` (|> sub-value (~~ (template.splice <then>)))) + [(case (ffi.check <type> sub_value) + (#.Some sub_value) + (`` (|> sub_value (~~ (template.splice <then>)))) #.None)] - [[java/lang/Object] [host-value]] - [java/lang/Boolean [..host-bit]] + [[java/lang/Object] [host_value]] + [java/lang/Boolean [..host_bit]] [java/lang/Integer [java/lang/Integer::longValue org/armedbear/lisp/Fixnum::getInstance]] [java/lang/Long [org/armedbear/lisp/Bignum::getInstance]] [java/lang/Double [org/armedbear/lisp/DoubleFloat::new]] [java/lang/String [org/armedbear/lisp/SimpleString::new]] )) ## else - (:coerce org/armedbear/lisp/LispObject sub-value))))))] - (`` (object [] org/armedbear/lisp/LispObject [program/LuxADT] + (:coerce org/armedbear/lisp/LispObject sub_value))))))] + (`` (ffi.object [] org/armedbear/lisp/LispObject [program/LuxADT] [] ## Methods (program/LuxADT - (getValue) java/lang/Object + [] (getValue self) java/lang/Object (:coerce java/lang/Object value)) (org/armedbear/lisp/LispObject - (length) + [] (length self) int (|> value (:coerce (Array java/lang/Object)) @@ -165,12 +200,12 @@ (~~ (template [<name>] [(org/armedbear/lisp/LispObject - (<name> {idx int}) + [] (<name> self {idx int}) org/armedbear/lisp/LispObject (case (array.read (|> idx java/lang/Integer::longValue (:coerce Nat)) (:coerce (Array java/lang/Object) value)) (#.Some sub) - (to-sub sub) + (to_sub sub) #.None (org/armedbear/lisp/Nil::NIL)))] @@ -180,128 +215,135 @@ )))) (type: (Reader a) - (-> a (Error Any))) + (-> a (Try Any))) -(def: (read-variant read host-object) +(def: (read_variant read host_object) (-> (Reader org/armedbear/lisp/LispObject) (Reader org/armedbear/lisp/Cons)) - (do error.monad - [tag (read (org/armedbear/lisp/LispObject::NTH +0 host-object)) - value (read (org/armedbear/lisp/LispObject::NTH +2 host-object))] + (do try.monad + [tag (read (org/armedbear/lisp/LispObject::NTH +0 host_object)) + value (read (org/armedbear/lisp/LispObject::NTH +2 host_object))] (wrap [(java/lang/Long::intValue (:coerce java/lang/Long tag)) - (case (host.check org/armedbear/lisp/Nil (org/armedbear/lisp/LispObject::NTH +1 host-object)) + (case (ffi.check org/armedbear/lisp/Nil (org/armedbear/lisp/LispObject::NTH +1 host_object)) (#.Some _) - (: Any (host.null)) + (: Any (ffi.null)) _ (: Any synthesis.unit)) value]))) -(def: (read-tuple read host-object) +(def: (read_tuple read host_object) (-> (Reader org/armedbear/lisp/LispObject) (Reader org/armedbear/lisp/SimpleVector)) - (let [size (.nat (org/armedbear/lisp/LispObject::length host-object))] + (let [size (.nat (org/armedbear/lisp/LispObject::length host_object))] (loop [idx 0 output (:coerce (Array Any) (array.new size))] - (if (n/< size idx) + (if (n.< size idx) ## TODO: Start using "SVREF" instead of "elt" ASAP - (case (read (org/armedbear/lisp/LispObject::elt (.int idx) host-object)) - (#error.Failure error) - (#error.Failure error) + (case (read (org/armedbear/lisp/LispObject::elt (.int idx) host_object)) + (#try.Failure error) + (#try.Failure error) - (#error.Success member) - (recur (inc idx) (array.write idx (:coerce Any member) output))) - (#error.Success output))))) + (#try.Success member) + (recur (inc idx) (array.write! idx (:coerce Any member) output))) + (#try.Success output))))) -(def: (read host-object) +(def: (read host_object) (Reader org/armedbear/lisp/LispObject) - (`` (<| (~~ (template [<class> <post-processing>] - [(case (host.check <class> host-object) - (#.Some host-object) - (`` (|> host-object (~~ (template.splice <post-processing>)))) + (`` (<| (~~ (template [<class> <post_processing>] + [(case (ffi.check <class> host_object) + (#.Some host_object) + (`` (|> host_object (~~ (template.splice <post_processing>)))) #.None)] - [org/armedbear/lisp/Bignum [org/armedbear/lisp/Bignum::longValue #error.Success]] - [org/armedbear/lisp/Fixnum [org/armedbear/lisp/Fixnum::longValue #error.Success]] - [org/armedbear/lisp/DoubleFloat [org/armedbear/lisp/DoubleFloat::doubleValue #error.Success]] - [org/armedbear/lisp/SimpleString [org/armedbear/lisp/SimpleString::getStringValue #error.Success]] - [org/armedbear/lisp/Cons [(read-variant read)]] - [org/armedbear/lisp/SimpleVector [(read-tuple read)]] - [org/armedbear/lisp/Nil [(new> (#error.Success false) [])]] - [org/armedbear/lisp/Closure [#error.Success]] - [program/LuxADT [program/LuxADT::getValue #error.Success]])) - (case (host.check org/armedbear/lisp/Symbol host-object) - (#.Some host-object) - (if (is? (org/armedbear/lisp/Symbol::T) host-object) - (#error.Success true) - (exception.throw unknown-kind-of-object (:coerce java/lang/Object host-object))) + [org/armedbear/lisp/Bignum [org/armedbear/lisp/Bignum::longValue #try.Success]] + [org/armedbear/lisp/Fixnum [org/armedbear/lisp/Fixnum::longValue #try.Success]] + [org/armedbear/lisp/DoubleFloat [org/armedbear/lisp/DoubleFloat::doubleValue #try.Success]] + [org/armedbear/lisp/SimpleString [org/armedbear/lisp/SimpleString::getStringValue #try.Success]] + [org/armedbear/lisp/Cons [(read_variant read)]] + [org/armedbear/lisp/SimpleVector [(read_tuple read)]] + [org/armedbear/lisp/Nil [(new> (#try.Success false) [])]] + [org/armedbear/lisp/Closure [#try.Success]] + [program/LuxADT [program/LuxADT::getValue #try.Success]])) + (case (ffi.check org/armedbear/lisp/Symbol host_object) + (#.Some host_object) + (if (is? (org/armedbear/lisp/Symbol::T) host_object) + (#try.Success true) + (exception.throw ..unknown_kind_of_object (:coerce java/lang/Object host_object))) #.None) ## else - (exception.throw unknown-kind-of-object (:coerce java/lang/Object host-object)) + (exception.throw ..unknown_kind_of_object (:coerce java/lang/Object host_object)) ))) -(def: ensure-macro +(def: ensure_macro (-> Macro (Maybe org/armedbear/lisp/Closure)) - (|>> (:coerce java/lang/Object) (host.check org/armedbear/lisp/Closure))) + (|>> (:coerce java/lang/Object) (ffi.check org/armedbear/lisp/Closure))) -(def: (call-macro inputs lux macro) - (-> (List Code) Lux org/armedbear/lisp/Closure (Error (Error [Lux (List Code)]))) - (do error.monad - [raw-output (org/armedbear/lisp/LispObject::execute (..host-value inputs) (..host-value lux) macro)] - (:coerce (Error (Error [Lux (List Code)])) - (..read raw-output)))) +(def: (call_macro inputs lux macro) + (-> (List Code) Lux org/armedbear/lisp/Closure (Try (Try [Lux (List Code)]))) + (do try.monad + [raw_output (org/armedbear/lisp/LispObject::execute (..host_value inputs) (..host_value lux) macro)] + (:coerce (Try (Try [Lux (List Code)])) + (..read raw_output)))) (def: (expander macro inputs lux) Expander - (case (ensure-macro macro) + (case (ensure_macro macro) (#.Some macro) - (call-macro inputs lux macro) + (call_macro inputs lux macro) #.None - (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro)))) - -(def: separator "$") - -(type: Host - (generation.Host (_.Expression Any) (_.Expression Any))) + (exception.throw ..cannot_apply_a_non_function (:coerce java/lang/Object macro)))) (def: host - (IO Host) + (IO (Host (_.Expression Any) (_.Expression Any))) (io (let [_ (org/armedbear/lisp/Interpreter::createInstance) - interpreter (org/armedbear/lisp/Interpreter::getInstance)] - (: Host + interpreter (org/armedbear/lisp/Interpreter::getInstance) + run! (: (-> (_.Code Any) (Try Any)) + (function (_ code) + (do try.monad + [host_value (org/armedbear/lisp/Interpreter::eval (_.code code) interpreter)] + (read host_value))))] + (: (Host (_.Expression Any) (_.Expression Any)) (structure - (def: (evaluate! alias input) - (do error.monad - [host-value (org/armedbear/lisp/Interpreter::eval (_.code input) interpreter)] - (read host-value))) + (def: (evaluate! context code) + (run! code)) - (def: (execute! alias input) + (def: (execute! input) (org/armedbear/lisp/Interpreter::eval (_.code input) interpreter)) - (def: (define! [module name] input) - (let [global (format (text.replace-all .module-separator ..separator module) - ..separator (name.normalize name) - "___" (%n (text/hash name))) + (def: (define! context input) + (let [global (reference.artifact context) @global (_.var global)] - (do error.monad + (do try.monad [#let [definition (_.defparameter @global input)] _ (org/armedbear/lisp/Interpreter::eval (_.code definition) interpreter) - host-value (org/armedbear/lisp/Interpreter::eval (_.code @global) interpreter) - lux-value (read host-value)] - (wrap [global lux-value definition]))))))))) + value (run! @global)] + (wrap [global value definition])))) + + (def: (ingest context content) + (|> content (\ encoding.utf8 decode) try.assume (:coerce (_.Expression Any)))) + + (def: (re_learn context content) + (run! content)) + + (def: (re_load context content) + (do try.monad + [_ (run! content)] + (run! (_.var (reference.artifact context))))) + ))))) (def: platform - (IO (Platform IO _.Var/1 (_.Expression Any) (_.Expression Any))) + (IO (Platform _.Var/1 (_.Expression Any) (_.Expression Any))) (do io.monad [host ..host] - (wrap {#platform.&monad io.monad - #platform.&file-system file.system + (wrap {#platform.&file_system (file.async file.default) #platform.host host - #platform.phase common-lisp.generate - #platform.runtime runtime.generate}))) + #platform.phase common_lisp.generate + #platform.runtime runtime.generate + #platform.write (|>> _.code (\ encoding.utf8 encode))}))) -(def: get-ecl-cli-inputs +(def: get_ecl_cli_inputs (let [@idx (_.var "i")] (_.call/* (_.var "loop") (list (_.var "for") @idx @@ -309,23 +351,87 @@ (_.var "below") (_.call/* (_.var "si:argc") (list)) (_.var "collect") (_.call/* (_.var "si:argv") (list @idx)))))) -(def: program - (-> (_.Expression Any) (_.Expression Any)) - (let [raw-inputs ($_ _.progn +(def: (program context program) + (Program (_.Expression Any) (_.Expression Any)) + (let [raw_inputs ($_ _.progn (_.conditional+ (list "clisp") (_.var "ext:*args*")) (_.conditional+ (list "sbcl") (_.var "sb-ext:*posix-argv*")) (_.conditional+ (list "clozure") (_.call/* (_.var "ccl::command-line-arguments") (list))) (_.conditional+ (list "gcl") (_.var "si:*command-args*")) - (_.conditional+ (list "ecl") ..get-ecl-cli-inputs) + (_.conditional+ (list "ecl") ..get_ecl_cli_inputs) (_.conditional+ (list "cmu") (_.var "extensions:*command-line-strings*")) (_.conditional+ (list "allegro") (_.call/* (_.var "sys:command-line-arguments") (list))) (_.conditional+ (list "lispworks") (_.var "sys:*line-arguments-list*")) (_.list/* (list)))] - (|>> (_.call/2 [(runtime.lux//program-args raw-inputs) _.nil])))) - -(program: [{service /cli.service}] - (/.compiler ..expander - ..platform - extension.bundle - ..program - service)) + (_.call/2 [(runtime.lux//program_args raw_inputs) _.nil] program))) + +(for {@.old + (def: extender + Extender + ## TODO: Stop relying on coercions ASAP. + (<| (:coerce Extender) + (function (@self handler)) + (:coerce Handler) + (function (@self name phase)) + (:coerce Phase) + (function (@self archive parameters)) + (:coerce Operation) + (function (@self state)) + (:coerce Try) + try.assume + (:coerce Try) + (exec + ("lux io log" "TODO: Extender") + (#try.Failure "TODO: Extender")))) + + @.common_lisp + (def: (extender handler) + Extender + (:assume handler))}) + +(def: (declare_success! _) + (-> Any (Promise Any)) + (promise.future (\ world/program.default exit +0))) + +(def: (then pre post) + (-> (_.Expression Any) (_.Expression Any) (_.Expression Any)) + (_.manual (format (_.code pre) + text.new_line + (_.code post)))) + +(def: (scope body) + (-> (_.Expression Any) (_.Expression Any)) + (let [@program (_.var "lux_program")] + ($_ ..then + (_.defun @program (_.args (list)) body) + (_.call/* @program (list)) + ))) + +(`` (program: [{service /cli.service}] + (let [extension ".cl"] + (do io.monad + [platform ..platform] + (exec (do promise.monad + [_ (/.compiler {#/static.host @.common_lisp + #/static.host_module_extension extension + #/static.target (/cli.target service) + #/static.artifact_extension extension} + ..expander + analysis.bundle + (io.io platform) + generation.bundle + extension/bundle.empty + ..program + [_.Var _.Expression _.Expression] + ..extender + service + [(packager.package (_.manual "") + _.code + ..then + ..scope) + (format (/cli.target service) + (\ file.default separator) + "program" + extension)])] + (..declare_success! [])) + (io.io [])))))) |