(.require [library [lux (.except Symbol Alias Global global function type_of undefined) ["[0]" meta] [abstract ["[0]" monad (.only do)]] [control ["[0]" io] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try] ["<>" parser (.use "[1]#[0]" monad) ["<[0]>" code (.only Parser)]]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format]] [collection ["[0]" list (.use "[1]#[0]" monad mix)]]] ["[0]" macro (.only with_symbols) [syntax (.only syntax)] ["[0]" code] ["[0]" template]] ["@" target (.only) ["[0]" js]] [type [primitive (.except)]]]]) (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 @.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) (` (.case (~ (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:/* (case :parameters: {.#End} (list (` [])) parameters (list#each ..output_type :parameters:))] (` (.def ((~ g!it) (~+ (case 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) (case (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]] (` (.def ((~ g!it) (~+ (case g!parameters {.#End} (list g!it) _ (list#each (the #mandatory) g!parameters)))) (.All ((~ g!it) (~+ g!class_variables) (~+ g!input_variables)) (.-> (~+ (list#each ..output_type :parameters:)) (~ (|> :output: ..output_type (..input_type input))))) (.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 (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)] (` (def (~ g!it) ((~! syntax) ((~ g!it) []) (.at (~! meta.monad) (~' in) (.list (`' (.exec (~+ import!) (.as (~ (..output_type :field:)) (~ (<| (lux_optional :field:) (for @.js (` ( (~ (code.text (%.format (..host_path class_name) "." field))))) @.ruby (` ( (~ (code.text (%.format (..host_path class_name) "::" field))))) (` ( (~ (code.text field)) (~ (..imported class_name))))))))))))))))) (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) (case host_module {.#Some host_module} (list (` ( (~ (code.text host_module))))) {.#None} (list)))] (case 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) (`` (`` (case 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))))] (case tail {.#End} (in (list (` (is (.Maybe (~ type)) (case (..type_of (~ global)) "undefined" {.#None} (~ g!_) {.#Some (as (~ type) (~ global))}))))) {.#Item [next tail]} (let [separator "."] (in (list (` (is (.Maybe (~ type)) (case (..type_of (~ global)) "undefined" {.#None} (~ g!_) (..global (~ type) [(~ (code.local (%.format head "." next))) (~+ (list#each code.local tail))])))))))))))) (def !defined? (template (_ ) [(.case (..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 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)))))))) (with_expansions [ (..extension_name) (..extension_name) (..extension_name)] (these (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]] (case (.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]] (case inputs (pattern ) _ {try.#Failure (%.format "Invalid inputs for extension: " (%.text name))})))))])) (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]))) (case it (pattern (list.partial left right tail)) (list.partial [left right] (pairs tail)) (pattern (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]) (case key (pattern (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)))))))) ))) (these)) )