(.require [library [lux (.except Symbol Alias Global global function type_of undefined) [abstract ["[0]" monad (.only do)]] [control ["<>" parser (.use "[1]#[0]" monad)] ["[0]" io] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format]] [collection ["[0]" list (.use "[1]#[0]" monoid monad mix)]]] ["[0]" meta (.only) ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only with_symbols) [syntax (.only syntax)] ["[0]" template]] [type [primitive (.except)]] ["@" target (.only) ["[0]" js]]]]]) ... These extensions must be defined this way because importing any of the modules ... normally used when writing extensions would introduce a circular dependency ... because the Archive type depends on Binary, and that module depends on this ffi module. (def extension_name (syntax (_ []) (do meta.monad [module meta.current_module_name unique_id meta.seed] (in (list (code.text (%.format module " " (%.nat unique_id)))))))) (def extension_analysis (template (_ ) [{5 #1 [ ]}])) (def text_analysis (template (_ ) [{0 #0 {5 #1 }}])) (def analysis (template (_ ) [("lux def analysis" (.function (_ name phase archive inputs) (.function (_ state) (let [ [name phase archive state]] (when (.result inputs) {try.#Failure error} {try.#Failure (%.format "Invalid inputs for extension: " (%.text name) text.\n error)} {try.#Success } )))))])) (def generation (template (_ ) [("lux def generation" (.function (_ name phase archive inputs) (.function (_ state) (let [ [name phase archive state]] (when inputs _ {try.#Failure (%.format "Invalid inputs for extension: " (%.text name))})))))])) (for @.js (with_expansions [ (..extension_name) (..extension_name) (..extension_name) (..extension_name)] (these (analysis [name phase archive state] .end _ {try.#Success [state (extension_analysis name (list))]}) (generation [name phase archive state] (list) {try.#Success [state js.undefined]}) (def .public undefined (template (undefined) [(.is ..Undefined ())])) (analysis [name phase archive state] .any it (do try.monad [[state it] (phase archive (` (.is .Any (, it))) state)] (in [state (extension_analysis name (list it))]))) (generation [name phase archive state] (list it) (do try.monad [[state it] (phase archive it state)] (in [state (js.= js.undefined it)]))) (def .public undefined? (template (undefined? ) [(.as .Bit (.is .Any ( )))])) (analysis [name phase archive state] (<>.some (<>.and .text .any)) it (do [! try.monad] [[state output] (monad.mix ! (.function (_ [key value] [state output]) (do ! [[state value] (phase archive (` (.is .Any (, value))) state)] (in [state (list.partial value (text_analysis key) output)]))) [state (list)] it)] (in [state (extension_analysis name (list.reversed output))]))) (def text_synthesis (template (_ ) [{0 #0 {2 #1 }}])) (def (pairs it) (All (_ a) (-> (List a) (List [a a]))) (when it (list.partial left right tail) (list.partial [left right] (pairs tail)) (list) (list) _ (.undefined))) (generation [name phase archive state] (list.partial head_key head_value tail) (do [! try.monad] [[state output] (monad.mix ! (.function (_ [key value] [state output]) (when key (text_synthesis key) (do try.monad [[state value] (phase archive value state)] (in [state (list.partial [key value] output)])) _ (.undefined))) [state (list)] (pairs (list.partial head_key head_value tail)))] (in [state (js.object (list.reversed output))]))) (def .public object (syntax (_ [it (<>.some .any)]) (in (list (` (.as (..Object .Any) ( (,* it)))))))) (analysis [name phase archive state] (all <>.and .text .any .any) [field value object] (do try.monad [[state value] (phase archive (` (.is .Any (, value))) state) [state object] (phase archive (` (.is (..Object .Any) (, object))) state)] (in [state (extension_analysis name (list (text_analysis field) value object))]))) (generation [name phase archive state] (list (text_synthesis field) value object) (do try.monad [[state value] (phase archive value state) [state object] (phase archive object state)] (in [state (js.set (js.the field object) value)]))) (def .public set (syntax (_ [field .any value .any object .any]) (in (list (` (.as .Any ( (, field) (, value) (, object)))))))) )) ... else (these)) (with_expansions [ (for @.js "js constant" @.python "python constant" @.lua "lua constant" @.ruby "ruby constant") (for @.js "js apply" @.python "python apply" @.lua "lua apply" @.ruby "ruby apply") (for @.js "js object new" @.python "python apply" (these)) (for @.js "js object do" @.python "python object do" @.lua "lua object do" @.ruby "ruby object do") (for @.js "js object get" @.python "python object get" @.lua "lua object get" @.ruby "ruby object get" (these)) (for @.lua "lua object set" @.ruby "ruby object set" (these)) (for @.python "python import" @.lua "lua import" @.ruby "ruby import" (these)) (for @.js "js function" @.python "python function" @.lua "lua function" (these))] (primitive .public (Object brand) Any) (with_expansions [ (for @.js (these [Symbol] [Null] [Undefined]) @.python (these [None] [Dict]) @.lua (these [Nil] [Table]) @.ruby (these [Nil])) ] (with_template [] [(with_expansions [ (template.symbol [ "'"])] (primitive Any (type .public (Object ))))] [Function] )) (with_expansions [ (for @.js (these [Number Frac]) @.python (these [Integer Int] [Float Frac]) @.lua (these [Integer Int] [Float Frac]) @.ruby (these [Integer Int] [Float Frac])) ] (with_template [ ] [(type .public )] [Boolean Bit] [String Text] )) (type Alias (Maybe Text)) (def alias (Parser Alias) (<>.maybe (<>.after (.this (' "as")) .local))) (type Optional (Record [#optional? Bit #mandatory Code])) (def optional (Parser Optional) (let [token "?"] (<| (<>.and (<>.parses? (.this_text token))) (<>.after (<>.not (.this_text token))) .any))) (type (Named a) (Record [#name Text #alias Alias #anonymous a])) (with_template [ ] [(def (All (_ a) (-> (Parser a) (Parser (Named a)))) (|>> (all <>.and ..alias )))] [named .local] [anonymous (<>#in "")] ) (type Output Optional) (def output (Parser Output) ..optional) (type Global (Named Output)) (def variables (Parser (List Text)) (<>.else (list) (.tuple (<>.some .local)))) (def (generalized $ it) (All (_ a) (-> (-> (List Text) a a) (-> (Parser a) (Parser a)))) (do <>.monad [variables ..variables it it] (in ($ variables it)))) (type Input (Record [#variables (List Text) #parameters (List Optional) #io? Bit #try? Bit])) (def input (Parser Input) (all <>.and (<>#in (list)) (.tuple (<>.some ..optional)) (<>.parses? (.this_text "io")) (<>.parses? (.this_text "try")))) (type Constructor (Named Input)) (def constructor (Parser Constructor) (<| .form (..generalized (has [#anonymous #variables])) (<>.after (.this (' new))) (..anonymous ..input))) (type (Member a) (Record [#static? Bit #member a])) (def static! (Parser Any) (.this_text "static")) (def (member it) (All (_ a) (-> (Parser a) (Parser (Member a)))) (do [! <>.monad] [static? (<>.parses? ..static!)] (at ! each (|>> [#static? static? #member]) it))) (type Field (Member (Named Output))) (def field (Parser Field) (<| .form ..member ..named ..output)) (type Procedure (Record [#input Input #output Optional])) (def procedure (Parser (Named Procedure)) (<| (..generalized (has [#anonymous #input #variables])) ..named (all <>.and ..input ..optional ))) (type Method (Member (Named Procedure))) (def method (Parser Method) (<| .form ..member ..procedure)) (`` (`` (type Sub (Variant (,, (for @.lua (,, (these)) @.ruby (,, (these)) {#Constructor Constructor})) {#Field Field} {#Method Method})))) (`` (`` (def sub (Parser Sub) (all <>.or (,, (for @.lua (,, (these)) @.ruby (,, (these)) ..constructor)) ..field ..method )))) (def parameters (-> (List Optional) (List Optional)) (|>> list.enumeration (list#each (.function (_ [idx [optional? type]]) [#optional? optional? #mandatory (|> idx %.nat code.local)])))) (def (output_type it) (-> Optional Code) (if (the #optional? it) (` (.Maybe (, (the #mandatory it)))) (the #mandatory it))) (`` (with_template [ ] [(def .public ( _) (-> Any Nothing) (as_expected ())) (def .public (-> Any Bit) (|>> )) (template.with_locals [g!it] (these (def g!it' (' g!it)) (def (host_optional it) (-> Optional Code) (.if (.the #optional? it) (` (.when (, (the #mandatory it)) {.#Some (, g!it')} (, g!it') {.#None} ())) (the #mandatory it))) (def (lux_optional it output) (-> Optional Code Code) (` (.let [(, g!it') (, output)] (, (if (the #optional? it) (` (.if ( (, g!it')) {.#None} {.#Some (, g!it')})) (` (.if (.not ( (, g!it'))) (, g!it') (.panic! "Invalid output."))))))))))] (,, (for @.js [null "js object null" null? "js object null?"] @.python [none "python object none" none? "python object none?"] @.lua [nil "lua object nil" nil? "lua object nil?"] @.ruby [nil "ruby object nil" nil? "ruby object nil?"])) )) (type Declaration [Text (List Text)]) (type Namespace Text) (type Class (Record [#declaration Declaration #class_alias Alias #namespace Namespace #members (List Sub)])) (def class (Parser Class) (all <>.and (<>.either (<>.and .local (<>#in (list))) (.form (<>.and .local (<>.some .local)))) ..alias .text (<>.some ..sub))) (type Import (Variant {#Class Class} {#Procedure (Named Procedure)} {#Global Global})) (def importP (Parser Import) (all <>.or ..class (.form ..procedure) (.form (..named ..output)))) (def (input_type input :it:) (-> Input Code Code) (let [:it: (if (the #try? input) (` (.Either .Text (, :it:))) :it:)] (if (the #io? input) (` (io.IO (, :it:))) :it:))) (def (input_term input term) (-> Input Code Code) (let [term (if (the #try? input) (` (.try (, term))) term)] (if (the #io? input) (` (io.io (, term))) term))) (def (procedure_definition import! source it) (-> (List Code) Code (Named Procedure) Code) (let [g!it (|> (the #alias it) (maybe.else (the #name it)) code.local) g!variables (list#each code.local (the [#anonymous #input #variables] it)) input (the [#anonymous #input] it) :parameters: (the #parameters input) g!parameters (..parameters :parameters:) :output: (the [#anonymous #output] it) :input:/* (when :parameters: {.#End} (list (` [])) parameters (list#each ..output_type :parameters:))] (` (.def ((, g!it) (,* (when g!parameters {.#End} (list g!it) _ (list#each (the #mandatory) g!parameters)))) (.All ((, g!it) (,* g!variables)) (-> (,* :input:/*) (, (|> :output: ..output_type (..input_type input))))) (.exec (,* import!) (.as_expected (, (<| (..input_term input) (..lux_optional :output:) (` ( (.as_expected (, source)) [(,* (list#each ..host_optional g!parameters))])))))))))) (def (namespaced namespace class alias member) (-> Namespace Text Alias Text Text) (|> namespace (text.replaced "[1]" (maybe.else class alias)) (text.replaced "[0]" member))) (def class_separator ".") (def host_path (text.replaced .module_separator ..class_separator)) (for @.js (these) (def (imported class) (-> Text Code) (when (text.all_split_by .module_separator class) {.#Item head tail} (list#mix (.function (_ sub super) (` ( (, (code.text sub)) (.as (..Object .Any) (, super))))) (` ( (, (code.text head)))) tail) {.#End} (` ( (, (code.text class))))))) (def (global_definition import! it) (-> (List Code) Global Code) (let [g!name (|> (the #alias it) (maybe.else (the #name it)) code.local) :output: (the #anonymous it)] (` (.def (, g!name) (, (..output_type :output:)) (.exec (,* import!) (.as_expected (, (<| (lux_optional :output:) (` ( (, (code.text (..host_path (the #name it)))))))))))))) (for @.lua (these) @.ruby (these) (def (constructor_definition [class_name class_parameters] alias namespace it) (-> Declaration Alias Namespace Constructor Code) (let [g!it (|> it (the #alias) (maybe.else "new") (..namespaced namespace class_name alias) code.local) input (the #anonymous it) g!input_variables (list#each code.local (the #variables input)) :parameters: (the #parameters input) g!parameters (..parameters :parameters:) g!class_variables (list#each code.local class_parameters) g!class (` ((, (code.local (maybe.else class_name alias))) (,* g!class_variables))) :output: [#optional? false #mandatory g!class] unquantified_type (` (.-> (,* (when :parameters: (list) (list (` .Any)) _ (list#each ..output_type :parameters:))) (, (|> :output: ..output_type (..input_type input))))) quantified_type (when (list#composite g!class_variables g!input_variables) (list) unquantified_type _ (` (.All ((, g!it) (,* g!class_variables) (,* g!input_variables)) (, unquantified_type))))] (` (.def ((, g!it) (,* (when g!parameters {.#End} (list g!it) _ (list#each (the #mandatory) g!parameters)))) (, quantified_type) (.as_expected (, (<| (..input_term input) (..lux_optional :output:) (` ( (, (for @.js (` ( (, (code.text (..host_path class_name))))) @.python (` (.as ..Function (, (..imported class_name)))))) [(,* (list#each ..host_optional g!parameters))])))))))))) (def (optional_value type value) (-> Optional Code Optional) [#optional? (the #optional? type) #mandatory value]) (def (static_field_definition import! [class_name class_parameters] alias namespace it) (-> (List Code) Declaration Alias Namespace (Named Output) Code) (let [field (the #name it) g!it (|> (the #alias it) (maybe.else field) (..namespaced namespace class_name alias) code.local) :field: (the #anonymous it) get (` (.as (io.IO (, (..output_type :field:))) (io.io (, (<| (lux_optional :field:) (for @.js (` ( (, (code.text (%.format (..host_path class_name) "." field))))) @.ruby (` ( (, (code.text (%.format (..host_path class_name) "::" field))))) ... else (` ( (, (code.text field)) (, (..imported class_name)))))))))) set (` (.as (io.IO .Any) (io.io (, (for @.js (` (..set (, (code.text field)) (, (host_optional (optional_value :field: (` ((,' ,) (, g!it)))))) (.as (..Object .Any) ( (, (code.text (..host_path class_name))))))) @.ruby (` ( (, (code.text field)) (, (host_optional (optional_value :field: (` ((,' ,) (, g!it)))))) ( (, (code.text (..host_path class_name)))))) @.python (` ( ( "setattr") [(, (..imported class_name)) (, (code.text field)) (, (host_optional (optional_value :field: (` ((,' ,) (, g!it))))))])) ... else (` ( (, (code.text field)) (, (host_optional (optional_value :field: (` ((,' ,) (, g!it)))))) (, (..imported class_name)))))))))] (` (def (, g!it) (syntax ((, g!it) [(, g!it) (<>.maybe .any)]) (.at meta.monad (,' in) (.list (`' (.exec (,* import!) ((,' ,) (when (, g!it) {.#None} (`' (, get)) {.#Some (, g!it)} (`' (, set))))))))))))) (def (virtual_field_definition [class_name class_parameters] alias namespace it) (-> Declaration Alias Namespace (Named Output) Code) (let [name (the #name it) g!it (|> (the #alias it) (maybe.else name) (..namespaced namespace class_name alias) code.local) path (%.format (..host_path class_name) "." name) :field: (the #anonymous it) g!variables (list#each code.local class_parameters) g!class (` ((, (code.local (maybe.else class_name alias))) (,* g!variables)))] (` (.def ((, g!it) (, g!it)) (.All ((, g!it) (,* g!variables)) (.-> (, g!class) (, (..output_type :field:)))) (.as_expected (, (<| (lux_optional :field:) (` ( (, (code.text name)) (, g!it)))))))))) (def (field_definition import! class alias namespace it) (-> (List Code) Declaration Alias Namespace Field Code) (if (the #static? it) (..static_field_definition import! class alias namespace (the #member it)) (..virtual_field_definition class alias namespace (the #member it)))) (def (static_method_definition import! [class_name class_parameters] alias namespace it) (-> (List Code) Declaration Alias Namespace (Named Procedure) Code) (let [method (the #name it) name (|> (the #alias it) (maybe.else (the #name it)) (..namespaced namespace class_name alias))] (|> it (has #alias {.#Some name}) (..procedure_definition import! (for @.js (` ( (, (code.text (%.format (..host_path class_name) "." method))))) @.ruby (` ( (, (code.text (%.format (..host_path class_name) "::" method))))) (` ( (, (code.text method)) (.as (..Object .Any) (, (..imported class_name)))))))))) (def (virtual_method_definition [class_name class_parameters] alias namespace it) (-> Declaration Alias Namespace (Named Procedure) Code) (let [method (the #name it) g!it (|> (the #alias it) (maybe.else method) (..namespaced namespace class_name alias) code.local) procedure (the #anonymous it) input (the #input procedure) g!input_variables (list#each code.local (the #variables input)) :parameters: (the #parameters input) g!parameters (..parameters :parameters:) g!class_variables (list#each code.local class_parameters) g!class (` ((, (code.local (maybe.else class_name alias))) (,* g!class_variables))) :output: (the #output procedure)] (` (.def ((, g!it) (,* (list#each (the #mandatory) g!parameters)) (, g!it)) (.All ((, g!it) (,* g!class_variables) (,* g!input_variables)) (.-> (,* (list#each ..output_type :parameters:)) (, g!class) (, (|> :output: ..output_type (..input_type input))))) (.as_expected (, (<| (..input_term input) (..lux_optional :output:) (` ( (, (code.text method)) (, g!it) [(,* (list#each ..host_optional g!parameters))]))))))))) (def (method_definition import! class alias namespace it) (-> (List Code) Declaration Alias Namespace Method Code) (if (the #static? it) (static_method_definition import! class alias namespace (the #member it)) (virtual_method_definition class alias namespace (the #member it)))) (def .public import (syntax (_ [host_module (<>.maybe .text) it ..importP]) (let [host_module_import! (is (List Code) (when host_module {.#Some host_module} (list (` ( (, (code.text host_module))))) {.#None} (list)))] (when it {#Global it} (in (list (..global_definition host_module_import! it))) {#Procedure it} (in (list (..procedure_definition host_module_import! (` ( (, (code.text (..host_path (the #name it)))))) it))) {#Class it} (let [class (the #declaration it) alias (the #class_alias it) [class_name class_parameters] class namespace (the #namespace it) g!class_variables (list#each code.local class_parameters) declaration (` ((, (code.local (maybe.else class_name alias))) (,* g!class_variables)))] (in (list.partial (` (.type (, declaration) (..Object (.Primitive (, (code.text (..host_path class_name))) [(,* g!class_variables)])))) (list#each (.function (_ member) (`` (`` (when member (,, (for @.lua (,, (these)) @.ruby (,, (these)) (,, (these {#Constructor it} (..constructor_definition class alias namespace it))))) {#Field it} (..field_definition host_module_import! class alias namespace it) {#Method it} (..method_definition host_module_import! class alias namespace it))))) (the #members it))))) )))) (for @.ruby (these) (def .public function (syntax (_ [[self inputs] (.form (all <>.and .local (.tuple (<>.some (<>.and .any .any))))) type .any term .any]) (in (list (` (.<| (.as ..Function) ( (, (code.nat (list.size inputs)))) (.as (.-> [(,* (list.repeated (list.size inputs) (` .Any)))] .Any)) (.is (.-> [(,* (list#each product.right inputs))] (, type))) (.function ((, (code.local self)) [(,* (list#each product.left inputs))]) (, term))))))))) (for @.js (these (def .public type_of (template (type_of object) [("js type-of" object)])) (def .public global (syntax (_ [type .any [head tail] (.tuple (<>.and .local (<>.some .local)))]) (with_symbols [g!_] (let [global (` ("js constant" (, (code.text head))))] (when tail {.#End} (in (list (` (is (.Maybe (, type)) (when (..type_of (, global)) "undefined" {.#None} (, g!_) {.#Some (as (, type) (, global))}))))) {.#Item [next tail]} (let [separator "."] (in (list (` (is (.Maybe (, type)) (when (..type_of (, global)) "undefined" {.#None} (, g!_) (..global (, type) [(, (code.local (%.format head "." next))) (,* (list#each code.local tail))])))))))))))) (def !defined? (template (_ ) [(.when (..global Any ) {.#None} .false {.#Some _} .true)])) (with_template [ ] [(def .public Bit (!defined? ))] [on_browser? [window]] [on_nashorn? [java lang Object]] ) (def .public on_node_js? Bit (|> (..global (Object Any) [process]) (maybe#each (|>> [] ("js apply" ("js constant" "Object.prototype.toString.call")) (as Text) (text#= "[object process]"))) (maybe.else false)))) (these)) )