... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. ... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. (.require [library [lux (.except Symbol Alias Global Declaration Pattern global function type_of undefined alias) [abstract ["[0]" monad (.only do)]] [control ["<>" parser (.use "[1]#[0]" monad)] ["[0]" io] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try)]] [data ["[0]" product] ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format]] [collection ["[0]" list (.use "[1]#[0]" monoid monad mix)]]] ["[0]" meta (.only) ["[0]" location] ["[0]" code (.only) ["<[1]>" \\parser (.only Parser)]] ["[0]" macro (.only with_symbols) [syntax (.only syntax)] ["[0]" template]] [type (.only sharing) ["[0]" nominal (.except #name def)]] [compiler ["@" target (.only) ["[0]" js] ["[0]" python]] [arity (.only Arity)] [reference (.only Reference) [variable (.only Register)]] [language [lux ["[0]" analysis ["[1]/[0]" simple] [complex (.only Complex)] [pattern (.only Pattern)]] ["[0]" synthesis ["[1]/[0]" simple] [access (.only Access) [side (.only Side)] ["[1]/[0]" member]]]]]]]]]) (for @.js (these (type (Analysis_Branch of) [Pattern of]) (type (Analysis_Match of) [(Analysis_Branch of) (List (Analysis_Branch of))]) (type (Environment of) (List of)) (type (Extension of) [.Symbol (List of)]) (with_expansions [@ ($ (Analysis~' $))] (type (Analysis~' $) (Or analysis/simple.Simple (Complex @) Reference [@ (Analysis_Match @)] [(Environment @) @] [@ @] (Extension @)))) (type Analysis~ (Ann Location (Analysis~' (Ann Location)))) (def extension_analysis (template (_ ) [(is Analysis~ [location.dummy {5 #1 [ ]}])])) (def text_analysis (template (_ ) [(is Analysis~ [location.dummy {0 #0 {5 #1 }}])])) (def analysis (template (_ ) [(def .public (<| (as .Analysis) (.function (_ phase archive inputs)) (.function (_ state)) (let [ [phase archive state]] (when (.result inputs) {try.#Success } {try.#Failure error} {try.#Failure (%.format "Invalid inputs for extension..." text.\n error)}))))])) (type (Synthesis_Road value next) [value next]) (type (Synthesis_Fork value next) [(Synthesis_Road value next) (List (Synthesis_Road value next))]) (type (Synthesis_Path s) (Or Any Register Access [Bit (Synthesis_Path s) (Maybe (Synthesis_Path s))] (Synthesis_Fork I64 (Synthesis_Path s)) (Synthesis_Fork Frac (Synthesis_Path s)) (Synthesis_Fork Text (Synthesis_Path s)) [(Synthesis_Path s) (Synthesis_Path s)] [(Synthesis_Path s) (Synthesis_Path s)] s)) (type (Synthesis_Abstraction s) [(Environment s) Arity s]) (type (Synthesis_Apply s) [s (List s)]) (type (Synthesis_Function s) (Or (Synthesis_Abstraction s) (Synthesis_Apply s))) (type (Synthesis_Branch s) (Or [s s] [s Register s] [s s s] [(List synthesis/member.Member) s] [s (Synthesis_Path s)])) (type (Synthesis_Scope s) [Register (List s) s]) (type (Synthesis_Loop s) (Or (Synthesis_Scope s) (List s))) (type (Synthesis_Control s) (Or (Synthesis_Branch s) (Synthesis_Loop s) (Synthesis_Function s))) (with_expansions [@ ($ (Synthesis~' $))] (type (Synthesis~' $) (Or synthesis/simple.Simple (Complex @) Reference (Synthesis_Control @) (Extension @)))) (type Synthesis~ (Ann Location (Synthesis~' (Ann Location)))) (def text_synthesis (template (_ <@> ) [[<@> {0 #0 {2 #1 }}]])) (def translation (syntax (_ [ .any .any (<>.or .local .any) .any]) (with_symbols ['_ 'phase 'archive 'inputs 'state] (in (list (` (def .public (, ) (<| (as .Translation) (.function ((, '_) (, 'phase) (, 'archive) (, 'inputs))) (.function ((, '_) (, 'state))) (let [(, ) [(, 'phase) (, 'archive) (, 'state)]] (, (when {.#Left } (` (when (is (List Synthesis~) (, 'inputs)) (, (code.local )) (, ))) {.#Right } (` (when (is (List Synthesis~) (, 'inputs)) (, ) (, ) (, '_) {try.#Failure "Invalid inputs for extension."}))))))))))))) (translation undefined?|translation [phase archive state] (list it) (do try.monad [.let [phase (sharing [archive it state] (is [archive it state] [archive it state]) (is (-> archive it state (Try [state js.Expression])) (as_expected phase)))] [state it] (phase archive it state)] (in [state (js.= js.undefined it)]))) (analysis undefined?|analysis [phase archive state] .any it (do try.monad [.let [phase (sharing [archive state] (is [archive state] [archive state]) (is (-> archive Code state (Try [state Analysis~])) (as_expected phase)))] [state it] (phase archive (` (.is .Any (, it))) state)] (in [state (extension_analysis (symbol ..undefined?|translation) (list it))]))) (def .public undefined? (template (undefined? ) [(.as .Bit (.is .Any (undefined?|analysis )))])) (translation undefined|translation [phase archive state] (list) {try.#Success [state js.undefined]}) (analysis undefined|analysis [phase archive state] .end _ {try.#Success [state (extension_analysis (symbol ..undefined|translation) (list))]}) (def .public undefined (template (_) [(.is ..Undefined (undefined|analysis))])) (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))) (translation object|translation [phase archive state] it (do [! try.monad] [.let [phase (sharing [archive state] (is [archive state] [archive state]) (is (-> archive Synthesis~ state (Try [state js.Expression])) (as_expected phase)))] [state output] (monad.mix ! (sharing [state] (is state state) (is (-> [Synthesis~ Synthesis~] [state (List [Text js.Expression])] (Try [state (List [Text js.Expression])])) (.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 it))] (in [state (js.object (list.reversed output))]))) (analysis object|analysis [phase archive state] (<>.some (<>.and .text .any)) it (do [! try.monad] [.let [phase (sharing [archive state] (is [archive state] [archive state]) (is (-> archive Code state (Try [state Analysis~])) (as_expected phase)))] [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 (symbol ..object|translation) (list.reversed output))]))) (def .public object (syntax (_ [it (<>.some .any)]) (in (list (` (.as (..Object .Any) (object|analysis (,* it)))))))) (translation set|translation [phase archive state] (list (text_synthesis @ field) value object) (do try.monad [.let [phase (sharing [archive state] (is [archive state] [archive state]) (is (-> archive Synthesis~ state (Try [state js.Expression])) (as_expected phase)))] [state value] (phase archive value state) [state object] (phase archive object state)] (in [state (js.set (js.the field object) value)]))) (analysis set|analysis [phase archive state] (all <>.and .text .any .any) [field value object] (do try.monad [.let [phase (sharing [archive state] (is [archive state] [archive state]) (is (-> archive Code state (Try [state Analysis~])) (as_expected phase)))] [state value] (phase archive (` (.is .Any (, value))) state) [state object] (phase archive (` (.is (..Object .Any) (, object))) state)] (in [state (extension_analysis (symbol ..set|translation) (list (text_analysis field) value object))]))) (def .public set (syntax (_ [field .any value .any object .any]) (in (list (` (.as .Any (set|analysis (, 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))] (nominal.def .public (Object of) 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 [ "'"])] (nominal.def 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!)] (of ! 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) (` (Try (, :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)]) (.of 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 (.Nominal (, (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)) )