diff options
Diffstat (limited to '')
26 files changed, 3978 insertions, 3977 deletions
diff --git a/stdlib/source/library/lux/target/common_lisp.lux b/stdlib/source/library/lux/target/common_lisp.lux index 1a14f8d6e..253896c2f 100644 --- a/stdlib/source/library/lux/target/common_lisp.lux +++ b/stdlib/source/library/lux/target/common_lisp.lux @@ -23,446 +23,446 @@ (abstract: .public (Code brand) Text - [(def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: .public (<brand> brand) Any [])) - (`` (type: .public (<type> brand) - (<super> (<brand> brand)))))] - - [Expression Code] - [Computation Expression] - [Access Computation] - [Var Access] - - [Input Code] - ) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: .public <brand> Any [])) - (`` (type: .public <type> (<super> <brand>))))] - - [Label Code] - [Tag Expression] - [Literal Expression] - [Var/1 Var] - [Var/* Input] - ) - - (type: .public Lambda - (Record - [#input Var/* - #output (Expression Any)])) - - (def: .public nil - Literal - (:abstraction "()")) - - (template [<prefix> <name>] - [(def: .public <name> - (-> Text Literal) - (|>> (format <prefix>) :abstraction))] - - ["'" symbol] - [":" keyword]) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 ..nil - #1 (..symbol "t")))) - - (def: .public int - (-> Int Literal) - (|>> %.int :abstraction)) - - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "(/ 1.0 0.0)" [])] - - [(f.= f.negative_infinity)] - [(new> "(/ -1.0 0.0)" [])] - - [f.not_a_number?] - [(new> "(/ 0.0 0.0)" [])] - - ... else - [%.frac]) - :abstraction)) - - (def: .public (double value) - (-> Frac Literal) - (:abstraction - (.cond (f.= f.positive_infinity value) - "(/ 1.0d0 0.0d0)" - - (f.= f.negative_infinity value) - "(/ -1.0d0 0.0d0)" - - (f.not_a_number? value) - "(/ 0.0d0 0.0d0)" - - ... else - (.let [raw (%.frac value)] - (.if (text.contains? "E" raw) - (text.replaced/1 "E" "d" raw) - (format raw "d0")))))) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed' text.double_quote) - :abstraction)) - - (def: .public var - (-> Text Var/1) - (|>> :abstraction)) - - (def: .public args - (-> (List Var/1) Var/*) - (|>> (list\each ..code) - (text.interposed " ") - ..as_form - :abstraction)) - - (def: .public (args& singles rest) - (-> (List Var/1) Var/1 Var/*) - (|> (case singles - #.End - "" - - {#.Item _} - (|> singles - (list\each ..code) - (text.interposed " ") - (text.suffix " "))) - (format "&rest " (:representation rest)) - ..as_form + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: .public (<brand> brand) Any)) + (`` (type: .public (<type> brand) + (<super> (<brand> brand)))))] + + [Expression Code] + [Computation Expression] + [Access Computation] + [Var Access] + + [Input Code] + ) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: .public <brand> Any)) + (`` (type: .public <type> (<super> <brand>))))] + + [Label Code] + [Tag Expression] + [Literal Expression] + [Var/1 Var] + [Var/* Input] + ) + + (type: .public Lambda + (Record + [#input Var/* + #output (Expression Any)])) + + (def: .public nil + Literal + (:abstraction "()")) + + (template [<prefix> <name>] + [(def: .public <name> + (-> Text Literal) + (|>> (format <prefix>) :abstraction))] + + ["'" symbol] + [":" keyword]) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 ..nil + #1 (..symbol "t")))) + + (def: .public int + (-> Int Literal) + (|>> %.int :abstraction)) + + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "(/ 1.0 0.0)" [])] + + [(f.= f.negative_infinity)] + [(new> "(/ -1.0 0.0)" [])] + + [f.not_a_number?] + [(new> "(/ 0.0 0.0)" [])] + + ... else + [%.frac]) :abstraction)) - (def: form - (-> (List (Expression Any)) Expression) - (|>> (list\each ..code) - (text.interposed " ") - ..as_form - :abstraction)) - - (def: .public (call/* func) - (-> (Expression Any) (-> (List (Expression Any)) (Computation Any))) - (|>> {#.Item func} ..form)) - - (template [<name> <function>] - [(def: .public <name> - (-> (List (Expression Any)) (Computation Any)) - (..call/* (..var <function>)))] - - [vector/* "vector"] - [list/* "list"] - ) - - (def: .public (labels definitions body) - (-> (List [Var/1 Lambda]) (Expression Any) (Computation Any)) - (..form (list (..var "labels") - (..form (list\each (function (_ [def_name [def_args def_body]]) - (..form (list def_name (:transmutation def_args) def_body))) - definitions)) - body))) - - (def: .public (destructuring_bind [bindings expression] body) - (-> [Var/* (Expression Any)] (List (Expression Any)) (Computation Any)) - (..form (list& (..var "destructuring-bind") - (:transmutation bindings) expression - body))) - - (template [<call> <input_var>+ <input_type>+ <function>+] - [(`` (def: .public (<call> [(~~ (template.spliced <input_var>+))] function) - (-> [(~~ (template.spliced <input_type>+))] (Expression Any) (Computation Any)) - (..call/* function (list (~~ (template.spliced <input_var>+)))))) - - (`` (template [<lux_name> <host_name>] - [(def: .public (<lux_name> args) - (-> [(~~ (template.spliced <input_type>+))] (Computation Any)) - (<call> args (..var <host_name>)))] + (def: .public (double value) + (-> Frac Literal) + (:abstraction + (.cond (f.= f.positive_infinity value) + "(/ 1.0d0 0.0d0)" + + (f.= f.negative_infinity value) + "(/ -1.0d0 0.0d0)" - (~~ (template.spliced <function>+))))] - - [call/0 [] [] - [[get_universal_time/0 "get-universal-time"] - [make_hash_table/0 "make-hash-table"]]] - [call/1 [in0] [(Expression Any)] - [[length/1 "length"] - [function/1 "function"] - [copy_seq/1 "copy-seq"] - [null/1 "null"] - [error/1 "error"] - [not/1 "not"] - [floor/1 "floor"] - [type_of/1 "type-of"] - [write_to_string/1 "write-to-string"] - [read_from_string/1 "read-from-string"] - [print/1 "print"] - [reverse/1 "reverse"] - [sxhash/1 "sxhash"] - [string_upcase/1 "string-upcase"] - [string_downcase/1 "string-downcase"] - [char_int/1 "char-int"] - [text/1 "text"] - [hash_table_size/1 "hash-table-size"] - [hash_table_rehash_size/1 "hash-table-rehash-size"] - [code_char/1 "code-char"] - [char_code/1 "char-code"] - [string/1 "string"] - [write_line/1 "write-line"] - [pprint/1 "pprint"] - [identity/1 "identity"]]] - [call/2 [in0 in1] [(Expression Any) (Expression Any)] - [[apply/2 "apply"] - [append/2 "append"] - [cons/2 "cons"] - [char/2 "char"] - [nth/2 "nth"] - [nthcdr/2 "nthcdr"] - [coerce/2 "coerce"] - [eq/2 "eq"] - [equal/2 "equal"] - [string=/2 "string="] - [=/2 "="] - [+/2 "+"] - [*/2 "*"]]] - [call/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)] - [[subseq/3 "subseq"] - [map/3 "map"] - [concatenate/3 "concatenate"] - [format/3 "format"]]] - ) - - (template [<call> <input_type>+ <function>+] - [(`` (template [<lux_name> <host_name>] - [(def: .public (<lux_name> args) - (-> [(~~ (template.spliced <input_type>+))] (Access Any)) - (:transmutation (<call> args (..var <host_name>))))] + (f.not_a_number? value) + "(/ 0.0d0 0.0d0)" - (~~ (template.spliced <function>+))))] - - [call/1 [(Expression Any)] - [[car/1 "car"] - [cdr/1 "cdr"] - [cadr/1 "cadr"] - [cddr/1 "cddr"]]] - [call/2 [(Expression Any) (Expression Any)] - [[svref/2 "svref"] - [elt/2 "elt"] - [gethash/2 "gethash"]]] - ) - - (def: .public (make_hash_table/with_size size) - (-> (Expression Any) (Computation Any)) - (..call/* (..var "make-hash-table") - (list (..keyword "size") - size))) - - (def: .public (funcall/+ [func args]) - (-> [(Expression Any) (List (Expression Any))] (Computation Any)) - (..call/* (..var "funcall") (list& func args))) - - (def: .public (search/3 [reference space start]) - (-> [(Expression Any) (Expression Any) (Expression Any)] (Computation Any)) - (..call/* (..var "search") - (list reference - space - (..keyword "start2") start))) - - (def: .public (concatenate/2|string [left right]) - (-> [(Expression Any) (Expression Any)] (Computation Any)) - (concatenate/3 [(..symbol "string") left right])) - - (template [<lux_name> <host_name>] - [(def: .public (<lux_name> left right) - (-> (Expression Any) (Expression Any) (Computation Any)) - (..form (list (..var <host_name>) left right)))] - - [or "or"] - [and "and"] - ) - - (template [<lux_name> <host_name>] - [(def: .public (<lux_name> [param subject]) - (-> [(Expression Any) (Expression Any)] (Computation Any)) - (..form (list (..var <host_name>) subject param)))] - - [</2 "<"] - [<=/2 "<="] - [>/2 ">"] - [>=/2 ">="] - [string</2 "string<"] - [-/2 "-"] - [//2 "/"] - [rem/2 "rem"] - [floor/2 "floor"] - [mod/2 "mod"] - [ash/2 "ash"] - [logand/2 "logand"] - [logior/2 "logior"] - [logxor/2 "logxor"] - ) - - (def: .public (if test then else) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) - (..form (list (..var "if") test then else))) - - (def: .public (when test then) - (-> (Expression Any) (Expression Any) (Computation Any)) - (..form (list (..var "when") test then))) - - (def: .public (lambda input body) - (-> Var/* (Expression Any) Literal) - (..form (list (..var "lambda") (:transmutation input) body))) - - (template [<lux_name> <host_name>] - [(def: .public (<lux_name> bindings body) - (-> (List [Var/1 (Expression Any)]) (List (Expression Any)) (Computation Any)) - (..form (list& (..var <host_name>) - (|> bindings - (list\each (function (_ [name value]) - (..form (list name value)))) - ..form) - body)))] - - [let "let"] - [let* "let*"] - ) - - (def: .public (defparameter name body) - (-> Var/1 (Expression Any) (Expression Any)) - (..form (list (..var "defparameter") name body))) - - (def: .public (defun name inputs body) - (-> Var/1 Var/* (Expression Any) (Expression Any)) - (..form (list (..var "defun") name (:transmutation inputs) body))) - - (template [<name> <symbol>] - [(def: .public <name> - (-> (List (Expression Any)) (Computation Any)) - (|>> (list& (..var <symbol>)) ..form))] - - [progn "progn"] - [tagbody "tagbody"] - [values/* "values"] - ) - - (def: .public (setq name value) - (-> Var/1 (Expression Any) (Expression Any)) - (..form (list (..var "setq") name value))) - - (def: .public (setf access value) - (-> (Access Any) (Expression Any) (Expression Any)) - (..form (list (..var "setf") access value))) - - (type: .public Handler - (Record - [#condition_type (Expression Any) - #condition Var/1 - #body (Expression Any)])) - - (def: .public (handler_case handlers body) - (-> (List Handler) (Expression Any) (Computation Any)) - (..form (list& (..var "handler-case") - body - (list\each (function (_ [type condition handler]) - (..form (list type - (:transmutation (..args (list condition))) - handler))) - handlers)))) - - (template [<name> <prefix>] - [(def: .public (<name> conditions expression) - (-> (List Text) (Expression Any) (Expression Any)) - (case conditions + ... else + (.let [raw (%.frac value)] + (.if (text.contains? "E" raw) + (text.replaced/1 "E" "d" raw) + (format raw "d0")))))) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed' text.double_quote) + :abstraction)) + + (def: .public var + (-> Text Var/1) + (|>> :abstraction)) + + (def: .public args + (-> (List Var/1) Var/*) + (|>> (list\each ..code) + (text.interposed " ") + ..as_form + :abstraction)) + + (def: .public (args& singles rest) + (-> (List Var/1) Var/1 Var/*) + (|> (case singles #.End - expression - - {#.Item single #.End} - (:abstraction - (format <prefix> single " " (:representation expression))) + "" - _ - (:abstraction - (format <prefix> (|> conditions (list\each ..symbol) - (list& (..symbol "or")) ..form - :representation) - " " (:representation expression)))))] - - [conditional+ "#+"] - [conditional- "#-"]) - - (def: .public label - (-> Text Label) - (|>> :abstraction)) - - (def: .public (block name body) - (-> Label (List (Expression Any)) (Computation Any)) - (..form (list& (..var "block") (:transmutation name) body))) - - (def: .public (return_from target value) - (-> Label (Expression Any) (Computation Any)) - (..form (list (..var "return-from") (:transmutation target) value))) - - (def: .public (return value) - (-> (Expression Any) (Computation Any)) - (..form (list (..var "return") value))) - - (def: .public (cond clauses else) - (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any)) - (..form (list& (..var "cond") - (list\composite (list\each (function (_ [test then]) - (..form (list test then))) - clauses) - (list (..form (list (..bool true) else))))))) - - (def: .public tag - (-> Text Tag) - (|>> :abstraction)) - - (def: .public go - (-> Tag (Expression Any)) - (|>> (list (..var "go")) - ..form)) - - (def: .public values_list/1 - (-> (Expression Any) (Expression Any)) - (|>> (list (..var "values-list")) - ..form)) - - (def: .public (multiple_value_setq bindings values) - (-> Var/* (Expression Any) (Expression Any)) - (..form (list (..var "multiple-value-setq") - (:transmutation bindings) - values)))] + {#.Item _} + (|> singles + (list\each ..code) + (text.interposed " ") + (text.suffix " "))) + (format "&rest " (:representation rest)) + ..as_form + :abstraction)) + + (def: form + (-> (List (Expression Any)) Expression) + (|>> (list\each ..code) + (text.interposed " ") + ..as_form + :abstraction)) + + (def: .public (call/* func) + (-> (Expression Any) (-> (List (Expression Any)) (Computation Any))) + (|>> {#.Item func} ..form)) + + (template [<name> <function>] + [(def: .public <name> + (-> (List (Expression Any)) (Computation Any)) + (..call/* (..var <function>)))] + + [vector/* "vector"] + [list/* "list"] + ) + + (def: .public (labels definitions body) + (-> (List [Var/1 Lambda]) (Expression Any) (Computation Any)) + (..form (list (..var "labels") + (..form (list\each (function (_ [def_name [def_args def_body]]) + (..form (list def_name (:transmutation def_args) def_body))) + definitions)) + body))) + + (def: .public (destructuring_bind [bindings expression] body) + (-> [Var/* (Expression Any)] (List (Expression Any)) (Computation Any)) + (..form (list& (..var "destructuring-bind") + (:transmutation bindings) expression + body))) + + (template [<call> <input_var>+ <input_type>+ <function>+] + [(`` (def: .public (<call> [(~~ (template.spliced <input_var>+))] function) + (-> [(~~ (template.spliced <input_type>+))] (Expression Any) (Computation Any)) + (..call/* function (list (~~ (template.spliced <input_var>+)))))) + + (`` (template [<lux_name> <host_name>] + [(def: .public (<lux_name> args) + (-> [(~~ (template.spliced <input_type>+))] (Computation Any)) + (<call> args (..var <host_name>)))] + + (~~ (template.spliced <function>+))))] + + [call/0 [] [] + [[get_universal_time/0 "get-universal-time"] + [make_hash_table/0 "make-hash-table"]]] + [call/1 [in0] [(Expression Any)] + [[length/1 "length"] + [function/1 "function"] + [copy_seq/1 "copy-seq"] + [null/1 "null"] + [error/1 "error"] + [not/1 "not"] + [floor/1 "floor"] + [type_of/1 "type-of"] + [write_to_string/1 "write-to-string"] + [read_from_string/1 "read-from-string"] + [print/1 "print"] + [reverse/1 "reverse"] + [sxhash/1 "sxhash"] + [string_upcase/1 "string-upcase"] + [string_downcase/1 "string-downcase"] + [char_int/1 "char-int"] + [text/1 "text"] + [hash_table_size/1 "hash-table-size"] + [hash_table_rehash_size/1 "hash-table-rehash-size"] + [code_char/1 "code-char"] + [char_code/1 "char-code"] + [string/1 "string"] + [write_line/1 "write-line"] + [pprint/1 "pprint"] + [identity/1 "identity"]]] + [call/2 [in0 in1] [(Expression Any) (Expression Any)] + [[apply/2 "apply"] + [append/2 "append"] + [cons/2 "cons"] + [char/2 "char"] + [nth/2 "nth"] + [nthcdr/2 "nthcdr"] + [coerce/2 "coerce"] + [eq/2 "eq"] + [equal/2 "equal"] + [string=/2 "string="] + [=/2 "="] + [+/2 "+"] + [*/2 "*"]]] + [call/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)] + [[subseq/3 "subseq"] + [map/3 "map"] + [concatenate/3 "concatenate"] + [format/3 "format"]]] + ) + + (template [<call> <input_type>+ <function>+] + [(`` (template [<lux_name> <host_name>] + [(def: .public (<lux_name> args) + (-> [(~~ (template.spliced <input_type>+))] (Access Any)) + (:transmutation (<call> args (..var <host_name>))))] + + (~~ (template.spliced <function>+))))] + + [call/1 [(Expression Any)] + [[car/1 "car"] + [cdr/1 "cdr"] + [cadr/1 "cadr"] + [cddr/1 "cddr"]]] + [call/2 [(Expression Any) (Expression Any)] + [[svref/2 "svref"] + [elt/2 "elt"] + [gethash/2 "gethash"]]] + ) + + (def: .public (make_hash_table/with_size size) + (-> (Expression Any) (Computation Any)) + (..call/* (..var "make-hash-table") + (list (..keyword "size") + size))) + + (def: .public (funcall/+ [func args]) + (-> [(Expression Any) (List (Expression Any))] (Computation Any)) + (..call/* (..var "funcall") (list& func args))) + + (def: .public (search/3 [reference space start]) + (-> [(Expression Any) (Expression Any) (Expression Any)] (Computation Any)) + (..call/* (..var "search") + (list reference + space + (..keyword "start2") start))) + + (def: .public (concatenate/2|string [left right]) + (-> [(Expression Any) (Expression Any)] (Computation Any)) + (concatenate/3 [(..symbol "string") left right])) + + (template [<lux_name> <host_name>] + [(def: .public (<lux_name> left right) + (-> (Expression Any) (Expression Any) (Computation Any)) + (..form (list (..var <host_name>) left right)))] + + [or "or"] + [and "and"] + ) + + (template [<lux_name> <host_name>] + [(def: .public (<lux_name> [param subject]) + (-> [(Expression Any) (Expression Any)] (Computation Any)) + (..form (list (..var <host_name>) subject param)))] + + [</2 "<"] + [<=/2 "<="] + [>/2 ">"] + [>=/2 ">="] + [string</2 "string<"] + [-/2 "-"] + [//2 "/"] + [rem/2 "rem"] + [floor/2 "floor"] + [mod/2 "mod"] + [ash/2 "ash"] + [logand/2 "logand"] + [logior/2 "logior"] + [logxor/2 "logxor"] + ) + + (def: .public (if test then else) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (..form (list (..var "if") test then else))) + + (def: .public (when test then) + (-> (Expression Any) (Expression Any) (Computation Any)) + (..form (list (..var "when") test then))) + + (def: .public (lambda input body) + (-> Var/* (Expression Any) Literal) + (..form (list (..var "lambda") (:transmutation input) body))) + + (template [<lux_name> <host_name>] + [(def: .public (<lux_name> bindings body) + (-> (List [Var/1 (Expression Any)]) (List (Expression Any)) (Computation Any)) + (..form (list& (..var <host_name>) + (|> bindings + (list\each (function (_ [name value]) + (..form (list name value)))) + ..form) + body)))] + + [let "let"] + [let* "let*"] + ) + + (def: .public (defparameter name body) + (-> Var/1 (Expression Any) (Expression Any)) + (..form (list (..var "defparameter") name body))) + + (def: .public (defun name inputs body) + (-> Var/1 Var/* (Expression Any) (Expression Any)) + (..form (list (..var "defun") name (:transmutation inputs) body))) + + (template [<name> <symbol>] + [(def: .public <name> + (-> (List (Expression Any)) (Computation Any)) + (|>> (list& (..var <symbol>)) ..form))] + + [progn "progn"] + [tagbody "tagbody"] + [values/* "values"] + ) + + (def: .public (setq name value) + (-> Var/1 (Expression Any) (Expression Any)) + (..form (list (..var "setq") name value))) + + (def: .public (setf access value) + (-> (Access Any) (Expression Any) (Expression Any)) + (..form (list (..var "setf") access value))) + + (type: .public Handler + (Record + [#condition_type (Expression Any) + #condition Var/1 + #body (Expression Any)])) + + (def: .public (handler_case handlers body) + (-> (List Handler) (Expression Any) (Computation Any)) + (..form (list& (..var "handler-case") + body + (list\each (function (_ [type condition handler]) + (..form (list type + (:transmutation (..args (list condition))) + handler))) + handlers)))) + + (template [<name> <prefix>] + [(def: .public (<name> conditions expression) + (-> (List Text) (Expression Any) (Expression Any)) + (case conditions + #.End + expression + + {#.Item single #.End} + (:abstraction + (format <prefix> single " " (:representation expression))) + + _ + (:abstraction + (format <prefix> (|> conditions (list\each ..symbol) + (list& (..symbol "or")) ..form + :representation) + " " (:representation expression)))))] + + [conditional+ "#+"] + [conditional- "#-"]) + + (def: .public label + (-> Text Label) + (|>> :abstraction)) + + (def: .public (block name body) + (-> Label (List (Expression Any)) (Computation Any)) + (..form (list& (..var "block") (:transmutation name) body))) + + (def: .public (return_from target value) + (-> Label (Expression Any) (Computation Any)) + (..form (list (..var "return-from") (:transmutation target) value))) + + (def: .public (return value) + (-> (Expression Any) (Computation Any)) + (..form (list (..var "return") value))) + + (def: .public (cond clauses else) + (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any)) + (..form (list& (..var "cond") + (list\composite (list\each (function (_ [test then]) + (..form (list test then))) + clauses) + (list (..form (list (..bool true) else))))))) + + (def: .public tag + (-> Text Tag) + (|>> :abstraction)) + + (def: .public go + (-> Tag (Expression Any)) + (|>> (list (..var "go")) + ..form)) + + (def: .public values_list/1 + (-> (Expression Any) (Expression Any)) + (|>> (list (..var "values-list")) + ..form)) + + (def: .public (multiple_value_setq bindings values) + (-> Var/* (Expression Any) (Expression Any)) + (..form (list (..var "multiple-value-setq") + (:transmutation bindings) + values))) ) (def: .public (while condition body) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index 662f0c3a4..1519e639b 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -31,388 +31,388 @@ (abstract: .public (Code brand) Text - [(def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) Any []) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: <brand> Any []) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Var [Location' Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [Literal [Computation' Expression' Code]] - [Loop [Statement' Code]] - [Label [Code]] - ) - - (template [<name> <literal>] - [(def: .public <name> Literal (:abstraction <literal>))] - - [null "null"] - [undefined "undefined"] - ) - - (def: .public boolean - (-> Bit Literal) - (|>> (case> - #0 "false" - #1 "true") - :abstraction)) - - (def: .public (number value) - (-> Frac Literal) - (:abstraction - (.cond (f.not_a_number? value) - "NaN" - - (f.= f.positive_infinity value) - "Infinity" - - (f.= f.negative_infinity value) - "-Infinity" - - ... else - (|> value %.frac ..expression)))) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<replace> <find>] - [(text.replaced <find> <replace>)] - - ["\\" "\"] - ["\t" text.tab] - ["\v" text.vertical_tab] - ["\0" text.null] - ["\b" text.back_space] - ["\f" text.form_feed] - ["\n" text.new_line] - ["\r" text.carriage_return] - [(format "\" text.double_quote) - text.double_quote] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed [text.double_quote text.double_quote]) - :abstraction)) - - (def: argument_separator ", ") - (def: field_separator ": ") - (def: statement_suffix ";") - - (def: .public array - (-> (List Expression) Computation) - (|>> (list\each ..code) - (text.interposed ..argument_separator) - ..element - :abstraction)) - - (def: .public var - (-> Text Var) - (|>> :abstraction)) - - (def: .public (at index array_or_object) - (-> Expression Expression Access) - (:abstraction (format (:representation array_or_object) (..element (:representation index))))) - - (def: .public (the field object) - (-> Text Expression Access) - (:abstraction (format (:representation object) "." field))) - - (def: .public (apply/* function inputs) - (-> Expression (List Expression) Computation) - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression - (format (:representation function)) + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: <brand> Any) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Var [Location' Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [Literal [Computation' Expression' Code]] + [Loop [Statement' Code]] + [Label [Code]] + ) + + (template [<name> <literal>] + [(def: .public <name> Literal (:abstraction <literal>))] + + [null "null"] + [undefined "undefined"] + ) + + (def: .public boolean + (-> Bit Literal) + (|>> (case> + #0 "false" + #1 "true") :abstraction)) - (def: .public (do method inputs object) - (-> Text (List Expression) Expression Computation) - (apply/* (..the method object) inputs)) - - (def: .public object - (-> (List [Text Expression]) Computation) - (|>> (list\each (.function (_ [key val]) - (format (:representation (..string key)) ..field_separator (:representation val)))) - (text.interposed ..argument_separator) - (text.enclosed ["{" "}"]) - ..expression - :abstraction)) - - (def: .public (, pre post) - (-> Expression Expression Computation) - (|> (format (:representation pre) ..argument_separator (:representation post)) - ..expression + (def: .public (number value) + (-> Frac Literal) + (:abstraction + (.cond (f.not_a_number? value) + "NaN" + + (f.= f.positive_infinity value) + "Infinity" + + (f.= f.negative_infinity value) + "-Infinity" + + ... else + (|> value %.frac ..expression)))) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<replace> <find>] + [(text.replaced <find> <replace>)] + + ["\\" "\"] + ["\t" text.tab] + ["\v" text.vertical_tab] + ["\0" text.null] + ["\b" text.back_space] + ["\f" text.form_feed] + ["\n" text.new_line] + ["\r" text.carriage_return] + [(format "\" text.double_quote) + text.double_quote] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed [text.double_quote text.double_quote]) :abstraction)) - (def: .public (then pre post) - (-> Statement Statement Statement) - (:abstraction (format (:representation pre) - text.new_line - (:representation post)))) + (def: argument_separator ", ") + (def: field_separator ": ") + (def: statement_suffix ";") - (def: block - (-> Statement Text) - (let [close (format text.new_line "}")] - (|>> :representation - ..nested - (text.enclosed ["{" - close])))) - - (def: .public (function! name inputs body) - (-> Var (List Var) Statement Statement) - (|> body - ..block - (format "function " (:representation name) - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression) - " ") + (def: .public array + (-> (List Expression) Computation) + (|>> (list\each ..code) + (text.interposed ..argument_separator) + ..element :abstraction)) - (def: .public (function name inputs body) - (-> Var (List Var) Statement Computation) - (|> (..function! name inputs body) - :representation + (def: .public var + (-> Text Var) + (|>> :abstraction)) + + (def: .public (at index array_or_object) + (-> Expression Expression Access) + (:abstraction (format (:representation array_or_object) (..element (:representation index))))) + + (def: .public (the field object) + (-> Text Expression Access) + (:abstraction (format (:representation object) "." field))) + + (def: .public (apply/* function inputs) + (-> Expression (List Expression) Computation) + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression + (format (:representation function)) + :abstraction)) + + (def: .public (do method inputs object) + (-> Text (List Expression) Expression Computation) + (apply/* (..the method object) inputs)) + + (def: .public object + (-> (List [Text Expression]) Computation) + (|>> (list\each (.function (_ [key val]) + (format (:representation (..string key)) ..field_separator (:representation val)))) + (text.interposed ..argument_separator) + (text.enclosed ["{" "}"]) ..expression :abstraction)) - (def: .public (closure inputs body) - (-> (List Var) Statement Computation) - (|> body - ..block - (format "function" - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression) - " ") + (def: .public (, pre post) + (-> Expression Expression Computation) + (|> (format (:representation pre) ..argument_separator (:representation post)) + ..expression + :abstraction)) + + (def: .public (then pre post) + (-> Statement Statement Statement) + (:abstraction (format (:representation pre) + text.new_line + (:representation post)))) + + (def: block + (-> Statement Text) + (let [close (format text.new_line "}")] + (|>> :representation + ..nested + (text.enclosed ["{" + close])))) + + (def: .public (function! name inputs body) + (-> Var (List Var) Statement Statement) + (|> body + ..block + (format "function " (:representation name) + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression) + " ") + :abstraction)) + + (def: .public (function name inputs body) + (-> Var (List Var) Statement Computation) + (|> (..function! name inputs body) + :representation + ..expression + :abstraction)) + + (def: .public (closure inputs body) + (-> (List Var) Statement Computation) + (|> body + ..block + (format "function" + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression) + " ") + ..expression + :abstraction)) + + (template [<name> <op>] + [(def: .public (<name> param subject) + (-> Expression Expression Computation) + (|> (format (:representation subject) " " <op> " " (:representation param)) + ..expression + :abstraction))] + + [= "==="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [% "%"] + + [left_shift "<<"] + [arithmetic_right_shift ">>"] + [logic_right_shift ">>>"] + + [or "||"] + [and "&&"] + [bit_xor "^"] + [bit_or "|"] + [bit_and "&"] + ) + + (template [<name> <prefix>] + [(def: .public <name> + (-> Expression Computation) + (|>> :representation (text.prefix <prefix>) ..expression :abstraction))] + + [not "!"] + [bit_not "~"] + [opposite "-"] + ) + + (template [<name> <input> <format>] + [... A 32-bit integer expression. + (def: .public (<name> value) + (-> <input> Computation) + (:abstraction (..expression (format (<format> value) "|0"))))] + + [to_i32 Expression :representation] + [i32 Int %.int] + ) + + (def: .public (int value) + (-> Int Literal) + (:abstraction (.if (i.< +0 value) + (%.int value) + (%.nat (.nat value))))) + + (def: .public (? test then else) + (-> Expression Expression Expression Computation) + (|> (format (:representation test) + " ? " (:representation then) + " : " (:representation else)) + ..expression + :abstraction)) + + (def: .public type_of + (-> Expression Computation) + (|>> :representation + (format "typeof ") ..expression :abstraction)) - (template [<name> <op>] - [(def: .public (<name> param subject) - (-> Expression Expression Computation) - (|> (format (:representation subject) " " <op> " " (:representation param)) - ..expression + (def: .public (new constructor inputs) + (-> Expression (List Expression) Computation) + (|> (format "new " (:representation constructor) + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression)) + ..expression + :abstraction)) + + (def: .public statement + (-> Expression Statement) + (|>> :representation (text.suffix ..statement_suffix) :abstraction)) + + (def: .public use_strict + Statement + (:abstraction (format text.double_quote "use strict" text.double_quote ..statement_suffix))) + + (def: .public (declare name) + (-> Var Statement) + (:abstraction (format "var " (:representation name) ..statement_suffix))) + + (def: .public (define name value) + (-> Var Expression Statement) + (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement_suffix))) + + (def: .public (set name value) + (-> Location Expression Statement) + (:abstraction (format (:representation name) " = " (:representation value) ..statement_suffix))) + + (def: .public (throw message) + (-> Expression Statement) + (:abstraction (format "throw " (:representation message) ..statement_suffix))) + + (def: .public (return value) + (-> Expression Statement) + (:abstraction (format "return " (:representation value) ..statement_suffix))) + + (def: .public (delete value) + (-> Location Statement) + (:abstraction (format "delete " (:representation value) ..statement_suffix))) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (:abstraction (format "if(" (:representation test) ") " + (..block then!) + " else " + (..block else!)))) + + (def: .public (when test then!) + (-> Expression Statement Statement) + (:abstraction (format "if(" (:representation test) ") " + (..block then!)))) + + (def: .public (while test body) + (-> Expression Statement Loop) + (:abstraction (format "while(" (:representation test) ") " + (..block body)))) + + (def: .public (do_while test body) + (-> Expression Statement Loop) + (:abstraction (format "do " (..block body) + " while(" (:representation test) ")" ..statement_suffix))) + + (def: .public (try body [exception catch]) + (-> Statement [Var Statement] Statement) + (:abstraction (format "try " + (..block body) + " catch(" (:representation exception) ") " + (..block catch)))) + + (def: .public (for var init condition update iteration) + (-> Var Expression Expression Expression Statement Loop) + (:abstraction (format "for(" (:representation (..define var init)) + " " (:representation condition) + ..statement_suffix " " (:representation update) + ")" + (..block iteration)))) + + (def: .public label + (-> Text Label) + (|>> :abstraction)) + + (def: .public (with_label label loop) + (-> Label Loop Statement) + (:abstraction (format (:representation label) ": " (:representation loop)))) + + (template [<keyword> <0> <1>] + [(def: .public <0> + Statement + (:abstraction (format <keyword> ..statement_suffix))) + + (def: .public (<1> label) + (-> Label Statement) + (:abstraction (format <keyword> " " (:representation label) ..statement_suffix)))] + + ["break" break break_at] + ["continue" continue continue_at] + ) + + (template [<name> <js>] + [(def: .public <name> + (-> Location Expression) + (|>> :representation + (text.suffix <js>) :abstraction))] - [= "==="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [% "%"] - - [left_shift "<<"] - [arithmetic_right_shift ">>"] - [logic_right_shift ">>>"] - - [or "||"] - [and "&&"] - [bit_xor "^"] - [bit_or "|"] - [bit_and "&"] - ) - - (template [<name> <prefix>] - [(def: .public <name> - (-> Expression Computation) - (|>> :representation (text.prefix <prefix>) ..expression :abstraction))] - - [not "!"] - [bit_not "~"] - [opposite "-"] - ) - - (template [<name> <input> <format>] - [... A 32-bit integer expression. - (def: .public (<name> value) - (-> <input> Computation) - (:abstraction (..expression (format (<format> value) "|0"))))] - - [to_i32 Expression :representation] - [i32 Int %.int] - ) - - (def: .public (int value) - (-> Int Literal) - (:abstraction (.if (i.< +0 value) - (%.int value) - (%.nat (.nat value))))) - - (def: .public (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (:representation test) - " ? " (:representation then) - " : " (:representation else)) - ..expression - :abstraction)) - - (def: .public type_of - (-> Expression Computation) - (|>> :representation - (format "typeof ") - ..expression - :abstraction)) - - (def: .public (new constructor inputs) - (-> Expression (List Expression) Computation) - (|> (format "new " (:representation constructor) - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression)) - ..expression - :abstraction)) - - (def: .public statement - (-> Expression Statement) - (|>> :representation (text.suffix ..statement_suffix) :abstraction)) - - (def: .public use_strict - Statement - (:abstraction (format text.double_quote "use strict" text.double_quote ..statement_suffix))) - - (def: .public (declare name) - (-> Var Statement) - (:abstraction (format "var " (:representation name) ..statement_suffix))) - - (def: .public (define name value) - (-> Var Expression Statement) - (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement_suffix))) - - (def: .public (set name value) - (-> Location Expression Statement) - (:abstraction (format (:representation name) " = " (:representation value) ..statement_suffix))) - - (def: .public (throw message) - (-> Expression Statement) - (:abstraction (format "throw " (:representation message) ..statement_suffix))) - - (def: .public (return value) - (-> Expression Statement) - (:abstraction (format "return " (:representation value) ..statement_suffix))) - - (def: .public (delete value) - (-> Location Statement) - (:abstraction (format "delete " (:representation value) ..statement_suffix))) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (:abstraction (format "if(" (:representation test) ") " - (..block then!) - " else " - (..block else!)))) - - (def: .public (when test then!) - (-> Expression Statement Statement) - (:abstraction (format "if(" (:representation test) ") " - (..block then!)))) - - (def: .public (while test body) - (-> Expression Statement Loop) - (:abstraction (format "while(" (:representation test) ") " - (..block body)))) - - (def: .public (do_while test body) - (-> Expression Statement Loop) - (:abstraction (format "do " (..block body) - " while(" (:representation test) ")" ..statement_suffix))) - - (def: .public (try body [exception catch]) - (-> Statement [Var Statement] Statement) - (:abstraction (format "try " - (..block body) - " catch(" (:representation exception) ") " - (..block catch)))) - - (def: .public (for var init condition update iteration) - (-> Var Expression Expression Expression Statement Loop) - (:abstraction (format "for(" (:representation (..define var init)) - " " (:representation condition) - ..statement_suffix " " (:representation update) - ")" - (..block iteration)))) - - (def: .public label - (-> Text Label) - (|>> :abstraction)) - - (def: .public (with_label label loop) - (-> Label Loop Statement) - (:abstraction (format (:representation label) ": " (:representation loop)))) - - (template [<keyword> <0> <1>] - [(def: .public <0> - Statement - (:abstraction (format <keyword> ..statement_suffix))) - - (def: .public (<1> label) - (-> Label Statement) - (:abstraction (format <keyword> " " (:representation label) ..statement_suffix)))] - - ["break" break break_at] - ["continue" continue continue_at] - ) - - (template [<name> <js>] - [(def: .public <name> - (-> Location Expression) - (|>> :representation - (text.suffix <js>) - :abstraction))] - - [++ "++"] - [-- "--"] - ) - - (def: .public (comment commentary on) - (All (_ kind) (-> Text (Code kind) (Code kind))) - (:abstraction (format "/* " commentary " */" " " (:representation on)))) - - (def: .public (switch input cases default) - (-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement) - (:abstraction (format "switch (" (:representation input) ") " - (|> (format (|> cases - (list\each (.function (_ [when then]) - (format (|> when - (list\each (|>> :representation (text.enclosed ["case " ":"]))) - (text.interposed text.new_line)) - (..nested (:representation then))))) - (text.interposed text.new_line)) - text.new_line - (case default - {#.Some default} - (format "default:" - (..nested (:representation default))) - - #.None "")) - :abstraction - ..block))))] + [++ "++"] + [-- "--"] + ) + + (def: .public (comment commentary on) + (All (_ kind) (-> Text (Code kind) (Code kind))) + (:abstraction (format "/* " commentary " */" " " (:representation on)))) + + (def: .public (switch input cases default) + (-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement) + (:abstraction (format "switch (" (:representation input) ") " + (|> (format (|> cases + (list\each (.function (_ [when then]) + (format (|> when + (list\each (|>> :representation (text.enclosed ["case " ":"]))) + (text.interposed text.new_line)) + (..nested (:representation then))))) + (text.interposed text.new_line)) + text.new_line + (case default + {#.Some default} + (format "default:" + (..nested (:representation default))) + + #.None "")) + :abstraction + ..block)))) ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/address.lux b/stdlib/source/library/lux/target/jvm/bytecode/address.lux index 2908238d5..73239ffd2 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/address.lux @@ -26,49 +26,49 @@ (abstract: .public Address U2 - [(def: .public value - (-> Address U2) - (|>> :representation)) + (def: .public value + (-> Address U2) + (|>> :representation)) - (def: .public start - Address - (|> 0 ///unsigned.u2 try.trusted :abstraction)) + (def: .public start + Address + (|> 0 ///unsigned.u2 try.trusted :abstraction)) - (def: .public (move distance) - (-> U2 (-> Address (Try Address))) - (|>> :representation - (///unsigned.+/2 distance) - (\ try.functor each (|>> :abstraction)))) + (def: .public (move distance) + (-> U2 (-> Address (Try Address))) + (|>> :representation + (///unsigned.+/2 distance) + (\ try.functor each (|>> :abstraction)))) - (def: with_sign - (-> Address (Try S4)) - (|>> :representation ///unsigned.value .int ///signed.s4)) + (def: with_sign + (-> Address (Try S4)) + (|>> :representation ///unsigned.value .int ///signed.s4)) - (def: .public (jump from to) - (-> Address Address (Try Big_Jump)) - (do try.monad - [from (with_sign from) - to (with_sign to)] - (///signed.-/4 from to))) + (def: .public (jump from to) + (-> Address Address (Try Big_Jump)) + (do try.monad + [from (with_sign from) + to (with_sign to)] + (///signed.-/4 from to))) - (def: .public (after? reference subject) - (-> Address Address Bit) - (n.> (|> reference :representation ///unsigned.value) - (|> subject :representation ///unsigned.value))) + (def: .public (after? reference subject) + (-> Address Address Bit) + (n.> (|> reference :representation ///unsigned.value) + (|> subject :representation ///unsigned.value))) - (implementation: .public equivalence - (Equivalence Address) - - (def: (= reference subject) - (\ ///unsigned.equivalence = - (:representation reference) - (:representation subject)))) + (implementation: .public equivalence + (Equivalence Address) + + (def: (= reference subject) + (\ ///unsigned.equivalence = + (:representation reference) + (:representation subject)))) - (def: .public writer - (Writer Address) - (|>> :representation ///unsigned.writer/2)) + (def: .public writer + (Writer Address) + (|>> :representation ///unsigned.writer/2)) - (def: .public format - (Format Address) - (|>> :representation ///unsigned.value %.nat))] + (def: .public format + (Format Address) + (|>> :representation ///unsigned.value %.nat)) ) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux index 13f9343a7..506e041be 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -31,61 +31,61 @@ (abstract: .public Registry U2 - [(def: .public registry - (-> U2 Registry) - (|>> :abstraction)) + (def: .public registry + (-> U2 Registry) + (|>> :abstraction)) - (def: (minimal type) - (-> (Type Method) Nat) - (let [[type_variables inputs output exceptions] (/////type/parser.method type)] - (|> inputs - (list\each (function (_ input) - (if (or (same? /////type.long input) - (same? /////type.double input)) - ..wide - ..normal))) - (list\mix n.+ 0)))) + (def: (minimal type) + (-> (Type Method) Nat) + (let [[type_variables inputs output exceptions] (/////type/parser.method type)] + (|> inputs + (list\each (function (_ input) + (if (or (same? /////type.long input) + (same? /////type.double input)) + ..wide + ..normal))) + (list\mix n.+ 0)))) - (template [<start> <name>] - [(def: .public <name> - (-> (Type Method) (Try Registry)) - (|>> ..minimal - (n.+ <start>) - /////unsigned.u2 - (try\each ..registry)))] + (template [<start> <name>] + [(def: .public <name> + (-> (Type Method) (Try Registry)) + (|>> ..minimal + (n.+ <start>) + /////unsigned.u2 + (try\each ..registry)))] - [0 static] - [1 virtual] - ) + [0 static] + [1 virtual] + ) - (def: .public equivalence - (Equivalence Registry) - (\ equivalence.functor each - (|>> :representation) - /////unsigned.equivalence)) + (def: .public equivalence + (Equivalence Registry) + (\ equivalence.functor each + (|>> :representation) + /////unsigned.equivalence)) - (def: .public writer - (Writer Registry) - (|>> :representation /////unsigned.writer/2)) + (def: .public writer + (Writer Registry) + (|>> :representation /////unsigned.writer/2)) - (def: .public (has needed) - (-> Registry Registry Registry) - (|>> :representation - (/////unsigned.max/2 (:representation needed)) - :abstraction)) + (def: .public (has needed) + (-> Registry Registry Registry) + (|>> :representation + (/////unsigned.max/2 (:representation needed)) + :abstraction)) - (template [<name> <extra>] - [(def: .public <name> - (-> Register Registry) - (let [extra (|> <extra> /////unsigned.u2 try.trusted)] - (|>> /////unsigned.lifted/2 - (/////unsigned.+/2 extra) - try.trusted - :abstraction)))] + (template [<name> <extra>] + [(def: .public <name> + (-> Register Registry) + (let [extra (|> <extra> /////unsigned.u2 try.trusted)] + (|>> /////unsigned.lifted/2 + (/////unsigned.+/2 extra) + try.trusted + :abstraction)))] - [for ..normal] - [for_wide ..wide] - )] + [for ..normal] + [for_wide ..wide] + ) ) (def: .public length diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux index 1118c3b22..c6c132a8c 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux @@ -20,49 +20,49 @@ (abstract: .public Stack U2 - [(template [<frames> <name>] - [(def: .public <name> - Stack - (|> <frames> /////unsigned.u2 maybe.trusted :abstraction))] + (template [<frames> <name>] + [(def: .public <name> + Stack + (|> <frames> /////unsigned.u2 maybe.trusted :abstraction))] - [0 empty] - [1 catch] - ) + [0 empty] + [1 catch] + ) - (def: .public equivalence - (Equivalence Stack) - (\ equivalence.functor each - (|>> :representation) - /////unsigned.equivalence)) + (def: .public equivalence + (Equivalence Stack) + (\ equivalence.functor each + (|>> :representation) + /////unsigned.equivalence)) - (def: .public writer - (Writer Stack) - (|>> :representation /////unsigned.writer/2)) + (def: .public writer + (Writer Stack) + (|>> :representation /////unsigned.writer/2)) - (def: stack - (-> U2 Stack) - (|>> :abstraction)) + (def: stack + (-> U2 Stack) + (|>> :abstraction)) - (template [<op> <name>] - [(def: .public (<name> amount) - (-> U2 (-> Stack (Try Stack))) - (|>> :representation - (<op> amount) - (\ try.functor each ..stack)))] + (template [<op> <name>] + [(def: .public (<name> amount) + (-> U2 (-> Stack (Try Stack))) + (|>> :representation + (<op> amount) + (\ try.functor each ..stack)))] - [/////unsigned.+/2 push] - [/////unsigned.-/2 pop] - ) + [/////unsigned.+/2 push] + [/////unsigned.-/2 pop] + ) - (def: .public (max left right) - (-> Stack Stack Stack) - (:abstraction - (/////unsigned.max/2 (:representation left) - (:representation right)))) + (def: .public (max left right) + (-> Stack Stack Stack) + (:abstraction + (/////unsigned.max/2 (:representation left) + (:representation right)))) - (def: .public format - (Format Stack) - (|>> :representation /////unsigned.value %.nat))] + (def: .public format + (Format Stack) + (|>> :representation /////unsigned.value %.nat)) ) (def: .public length diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index 646278f35..c43e5ed0b 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -237,22 +237,23 @@ (abstract: .public Primitive_Array_Type U1 - [(def: code - (-> Primitive_Array_Type U1) - (|>> :representation)) - - (template [<code> <name>] - [(def: .public <name> (|> <code> ///unsigned.u1 try.trusted :abstraction))] - - [04 t_boolean] - [05 t_char] - [06 t_float] - [07 t_double] - [08 t_byte] - [09 t_short] - [10 t_int] - [11 t_long] - )]) + (def: code + (-> Primitive_Array_Type U1) + (|>> :representation)) + + (template [<code> <name>] + [(def: .public <name> + (|> <code> ///unsigned.u1 try.trusted :abstraction))] + + [04 t_boolean] + [05 t_char] + [06 t_float] + [07 t_double] + [08 t_byte] + [09 t_short] + [10 t_int] + [11 t_long] + )) ... https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5 (with_expansions [<constants> (template [<code> <name>] diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux index 27efe496d..51517ff74 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -44,23 +44,23 @@ (abstract: .public Class (Index UTF8) - [(def: .public index - (-> Class (Index UTF8)) - (|>> :representation)) - - (def: .public class - (-> (Index UTF8) Class) - (|>> :abstraction)) - - (def: .public class_equivalence - (Equivalence Class) - (\ equivalence.functor each - ..index - //index.equivalence)) - - (def: class_writer - (Writer Class) - (|>> :representation //index.writer))] + (def: .public index + (-> Class (Index UTF8)) + (|>> :representation)) + + (def: .public class + (-> (Index UTF8) Class) + (|>> :abstraction)) + + (def: .public class_equivalence + (Equivalence Class) + (\ equivalence.functor each + ..index + //index.equivalence)) + + (def: class_writer + (Writer Class) + (|>> :representation //index.writer)) ) (import: java/lang/Float @@ -86,46 +86,46 @@ (abstract: .public (Value kind) kind - [(def: .public value - (All (_ kind) (-> (Value kind) kind)) - (|>> :representation)) - - (def: .public (value_equivalence Equivalence<kind>) - (All (_ kind) - (-> (Equivalence kind) - (Equivalence (Value kind)))) - (\ equivalence.functor each - (|>> :representation) - Equivalence<kind>)) - - (template [<constructor> <type> <marker>] - [(type: .public <type> - (Value <marker>)) - - (def: .public <constructor> - (-> <marker> <type>) - (|>> :abstraction))] - - [integer Integer I32] - [float Float java/lang/Float] - [long Long .Int] - [double Double Frac] - [string String (Index UTF8)] - ) - - (template [<writer_name> <type> <write> <writer>] - [(def: <writer_name> - (Writer <type>) - (`` (|>> :representation - (~~ (template.spliced <write>)) - (~~ (template.spliced <writer>)))))] - - [integer_writer Integer [] [binaryF.bits/32]] - [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]] - [long_writer Long [] [binaryF.bits/64]] - [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] - [string_writer String [] [//index.writer]] - )] + (def: .public value + (All (_ kind) (-> (Value kind) kind)) + (|>> :representation)) + + (def: .public (value_equivalence Equivalence<kind>) + (All (_ kind) + (-> (Equivalence kind) + (Equivalence (Value kind)))) + (\ equivalence.functor each + (|>> :representation) + Equivalence<kind>)) + + (template [<constructor> <type> <marker>] + [(type: .public <type> + (Value <marker>)) + + (def: .public <constructor> + (-> <marker> <type>) + (|>> :abstraction))] + + [integer Integer I32] + [float Float java/lang/Float] + [long Long .Int] + [double Double Frac] + [string String (Index UTF8)] + ) + + (template [<writer_name> <type> <write> <writer>] + [(def: <writer_name> + (Writer <type>) + (`` (|>> :representation + (~~ (template.spliced <write>)) + (~~ (template.spliced <writer>)))))] + + [integer_writer Integer [] [binaryF.bits/32]] + [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]] + [long_writer Long [] [binaryF.bits/64]] + [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] + [string_writer String [] [//index.writer]] + ) ) (type: .public (Name_And_Type of) diff --git a/stdlib/source/library/lux/target/jvm/constant/tag.lux b/stdlib/source/library/lux/target/jvm/constant/tag.lux index b774dfd4e..73ff384f4 100644 --- a/stdlib/source/library/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/library/lux/target/jvm/constant/tag.lux @@ -17,34 +17,34 @@ (abstract: .public Tag U1 - [(implementation: .public equivalence - (Equivalence Tag) - (def: (= reference sample) - (u1//= (:representation reference) - (:representation sample)))) + (implementation: .public equivalence + (Equivalence Tag) + (def: (= reference sample) + (u1//= (:representation reference) + (:representation sample)))) - (template [<code> <name>] - [(def: .public <name> - Tag - (|> <code> ///unsigned.u1 try.trusted :abstraction))] + (template [<code> <name>] + [(def: .public <name> + Tag + (|> <code> ///unsigned.u1 try.trusted :abstraction))] - [01 utf8] - [03 integer] - [04 float] - [05 long] - [06 double] - [07 class] - [08 string] - [09 field] - [10 method] - [11 interface_method] - [12 name_and_type] - [15 method_handle] - [16 method_type] - [18 invoke_dynamic] - ) + [01 utf8] + [03 integer] + [04 float] + [05 long] + [06 double] + [07 class] + [08 string] + [09 field] + [10 method] + [11 interface_method] + [12 name_and_type] + [15 method_handle] + [16 method_type] + [18 invoke_dynamic] + ) - (def: .public writer - (Writer Tag) - (|>> :representation ///unsigned.writer/1))] + (def: .public writer + (Writer Tag) + (|>> :representation ///unsigned.writer/1)) ) diff --git a/stdlib/source/library/lux/target/jvm/encoding/name.lux b/stdlib/source/library/lux/target/jvm/encoding/name.lux index 390b7c95c..c7776612a 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/name.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/name.lux @@ -16,21 +16,21 @@ (abstract: .public Internal Text - [(def: .public internal - (-> External Internal) - (|>> (text.replaced ..external_separator - ..internal_separator) - :abstraction)) - - (def: .public read - (-> Internal Text) - (|>> :representation)) - - (def: .public external - (-> Internal External) - (|>> :representation - (text.replaced ..internal_separator - ..external_separator)))]) + (def: .public internal + (-> External Internal) + (|>> (text.replaced ..external_separator + ..internal_separator) + :abstraction)) + + (def: .public read + (-> Internal Text) + (|>> :representation)) + + (def: .public external + (-> Internal External) + (|>> :representation + (text.replaced ..internal_separator + ..external_separator)))) (def: .public safe (-> Text External) diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux index 5d4f124a6..1e7e57721 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -25,83 +25,83 @@ (abstract: .public (Signed brand) Int - [(def: .public value - (-> (Signed Any) Int) - (|>> :representation)) + (def: .public value + (-> (Signed Any) Int) + (|>> :representation)) - (implementation: .public equivalence - (All (_ brand) (Equivalence (Signed brand))) - (def: (= reference sample) - (i.= (:representation reference) (:representation sample)))) + (implementation: .public equivalence + (All (_ brand) (Equivalence (Signed brand))) + (def: (= reference sample) + (i.= (:representation reference) (:representation sample)))) - (implementation: .public order - (All (_ brand) (Order (Signed brand))) - - (def: &equivalence ..equivalence) - (def: (< reference sample) - (i.< (:representation reference) (:representation sample)))) + (implementation: .public order + (All (_ brand) (Order (Signed brand))) + + (def: &equivalence ..equivalence) + (def: (< reference sample) + (i.< (:representation reference) (:representation sample)))) - (exception: .public (value_exceeds_the_scope [value Int - scope Nat]) - (exception.report - ["Value" (%.int value)] - ["Scope (in bytes)" (%.nat scope)])) + (exception: .public (value_exceeds_the_scope [value Int + scope Nat]) + (exception.report + ["Value" (%.int value)] + ["Scope (in bytes)" (%.nat scope)])) - (template [<bytes> <name> <size> <constructor> <maximum> <+> <->] - [(with_expansions [<raw> (template.identifier [<name> "'"])] - (abstract: .public <raw> Any []) - (type: .public <name> (Signed <raw>))) + (template [<bytes> <name> <size> <constructor> <maximum> <+> <->] + [(with_expansions [<raw> (template.identifier [<name> "'"])] + (abstract: <raw> Any) + (type: .public <name> (Signed <raw>))) - (def: .public <size> <bytes>) - - (def: .public <maximum> - <name> - (|> <bytes> (n.* i64.bits_per_byte) -- i64.mask :abstraction)) - - (def: .public <constructor> - (-> Int (Try <name>)) - (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask) - negative (|> positive .int (i.right_shifted 1) i64.not)] - (function (_ value) - (if (i.= (if (i.< +0 value) - (i64.or negative value) - (i64.and positive value)) - value) - {#try.Success (:abstraction value)} - (exception.except ..value_exceeds_the_scope [value <size>]))))) + (def: .public <size> <bytes>) + + (def: .public <maximum> + <name> + (|> <bytes> (n.* i64.bits_per_byte) -- i64.mask :abstraction)) + + (def: .public <constructor> + (-> Int (Try <name>)) + (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask) + negative (|> positive .int (i.right_shifted 1) i64.not)] + (function (_ value) + (if (i.= (if (i.< +0 value) + (i64.or negative value) + (i64.and positive value)) + value) + {#try.Success (:abstraction value)} + (exception.except ..value_exceeds_the_scope [value <size>]))))) - (template [<abstract_operation> <concrete_operation>] - [(def: .public (<abstract_operation> parameter subject) - (-> <name> <name> (Try <name>)) - (<constructor> - (<concrete_operation> (:representation parameter) - (:representation subject))))] + (template [<abstract_operation> <concrete_operation>] + [(def: .public (<abstract_operation> parameter subject) + (-> <name> <name> (Try <name>)) + (<constructor> + (<concrete_operation> (:representation parameter) + (:representation subject))))] - [<+> i.+] - [<-> i.-] - )] + [<+> i.+] + [<-> i.-] + )] - [1 S1 bytes/1 s1 maximum/1 +/1 -/1] - [2 S2 bytes/2 s2 maximum/2 +/2 -/2] - [4 S4 bytes/4 s4 maximum/4 +/4 -/4] - ) + [1 S1 bytes/1 s1 maximum/1 +/1 -/1] + [2 S2 bytes/2 s2 maximum/2 +/2 -/2] + [4 S4 bytes/4 s4 maximum/4 +/4 -/4] + ) - (template [<name> <from> <to>] - [(def: .public <name> - (-> <from> <to>) - (|>> :transmutation))] + (template [<name> <from> <to>] + [(def: .public <name> + (-> <from> <to>) + (|>> :transmutation))] - [lifted/2 S1 S2] - [lifted/4 S2 S4] - ) + [lifted/2 S1 S2] + [lifted/4 S2 S4] + ) - (template [<writer_name> <type> <writer>] - [(def: .public <writer_name> - (Writer <type>) - (|>> :representation <writer>))] + (template [<writer_name> <type> <writer>] + [(def: .public <writer_name> + (Writer <type>) + (|>> :representation <writer>))] - [writer/1 S1 format.bits/8] - [writer/2 S2 format.bits/16] - [writer/4 S4 format.bits/32] - )] + [writer/1 S1 format.bits/8] + [writer/2 S2 format.bits/16] + [writer/4 S4 format.bits/32] + ) ) diff --git a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux index 097265bcf..804374a4e 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux @@ -24,98 +24,98 @@ (abstract: .public (Unsigned brand) Nat - [(def: .public value - (-> (Unsigned Any) Nat) - (|>> :representation)) - - (implementation: .public equivalence - (All (_ brand) (Equivalence (Unsigned brand))) - (def: (= reference sample) - (n.= (:representation reference) - (:representation sample)))) - - (implementation: .public order - (All (_ brand) (Order (Unsigned brand))) + (def: .public value + (-> (Unsigned Any) Nat) + (|>> :representation)) + + (implementation: .public equivalence + (All (_ brand) (Equivalence (Unsigned brand))) + (def: (= reference sample) + (n.= (:representation reference) + (:representation sample)))) + + (implementation: .public order + (All (_ brand) (Order (Unsigned brand))) + + (def: &equivalence ..equivalence) + (def: (< reference sample) + (n.< (:representation reference) + (:representation sample)))) + + (exception: .public (value_exceeds_the_maximum [type Name + value Nat + maximum (Unsigned Any)]) + (exception.report + ["Type" (%.name type)] + ["Value" (%.nat value)] + ["Maximum" (%.nat (:representation maximum))])) + + (exception: .public [brand] (subtraction_cannot_yield_negative_value + [type Name + parameter (Unsigned brand) + subject (Unsigned brand)]) + (exception.report + ["Type" (%.name type)] + ["Parameter" (%.nat (:representation parameter))] + ["Subject" (%.nat (:representation subject))])) + + (template [<bytes> <name> <size> <constructor> <maximum> <+> <-> <max>] + [(with_expansions [<raw> (template.identifier [<name> "'"])] + (abstract: .public <raw> Any) + (type: .public <name> (Unsigned <raw>))) + + (def: .public <size> <bytes>) - (def: &equivalence ..equivalence) - (def: (< reference sample) - (n.< (:representation reference) - (:representation sample)))) - - (exception: .public (value_exceeds_the_maximum [type Name - value Nat - maximum (Unsigned Any)]) - (exception.report - ["Type" (%.name type)] - ["Value" (%.nat value)] - ["Maximum" (%.nat (:representation maximum))])) - - (exception: .public [brand] (subtraction_cannot_yield_negative_value - [type Name - parameter (Unsigned brand) - subject (Unsigned brand)]) - (exception.report - ["Type" (%.name type)] - ["Parameter" (%.nat (:representation parameter))] - ["Subject" (%.nat (:representation subject))])) - - (template [<bytes> <name> <size> <constructor> <maximum> <+> <-> <max>] - [(with_expansions [<raw> (template.identifier [<name> "'"])] - (abstract: .public <raw> Any []) - (type: .public <name> (Unsigned <raw>))) - - (def: .public <size> <bytes>) - - (def: .public <maximum> - <name> - (|> <bytes> (n.* i64.bits_per_byte) i64.mask :abstraction)) - - (def: .public (<constructor> value) - (-> Nat (Try <name>)) - (if (n.> (:representation <maximum>) value) - (exception.except ..value_exceeds_the_maximum [(name_of <name>) value <maximum>]) - {#try.Success (:abstraction value)})) - - (def: .public (<+> parameter subject) - (-> <name> <name> (Try <name>)) - (<constructor> - (n.+ (:representation parameter) - (:representation subject)))) - - (def: .public (<-> parameter subject) - (-> <name> <name> (Try <name>)) - (let [parameter' (:representation parameter) - subject' (:representation subject)] - (if (n.> subject' parameter') - (exception.except ..subtraction_cannot_yield_negative_value [(name_of <name>) parameter subject]) - {#try.Success (:abstraction (n.- parameter' subject'))}))) - - (def: .public (<max> left right) - (-> <name> <name> <name>) - (:abstraction (n.max (:representation left) - (:representation right))))] - - [1 U1 bytes/1 u1 maximum/1 +/1 -/1 max/1] - [2 U2 bytes/2 u2 maximum/2 +/2 -/2 max/2] - [4 U4 bytes/4 u4 maximum/4 +/4 -/4 max/4] - ) - - (template [<name> <from> <to>] - [(def: .public <name> - (-> <from> <to>) - (|>> :transmutation))] - - [lifted/2 U1 U2] - [lifted/4 U2 U4] - ) - - (template [<writer_name> <type> <writer>] - [(def: .public <writer_name> - (Writer <type>) - (|>> :representation <writer>))] - - [writer/1 U1 format.bits/8] - [writer/2 U2 format.bits/16] - [writer/4 U4 format.bits/32] - )] + (def: .public <maximum> + <name> + (|> <bytes> (n.* i64.bits_per_byte) i64.mask :abstraction)) + + (def: .public (<constructor> value) + (-> Nat (Try <name>)) + (if (n.> (:representation <maximum>) value) + (exception.except ..value_exceeds_the_maximum [(name_of <name>) value <maximum>]) + {#try.Success (:abstraction value)})) + + (def: .public (<+> parameter subject) + (-> <name> <name> (Try <name>)) + (<constructor> + (n.+ (:representation parameter) + (:representation subject)))) + + (def: .public (<-> parameter subject) + (-> <name> <name> (Try <name>)) + (let [parameter' (:representation parameter) + subject' (:representation subject)] + (if (n.> subject' parameter') + (exception.except ..subtraction_cannot_yield_negative_value [(name_of <name>) parameter subject]) + {#try.Success (:abstraction (n.- parameter' subject'))}))) + + (def: .public (<max> left right) + (-> <name> <name> <name>) + (:abstraction (n.max (:representation left) + (:representation right))))] + + [1 U1 bytes/1 u1 maximum/1 +/1 -/1 max/1] + [2 U2 bytes/2 u2 maximum/2 +/2 -/2 max/2] + [4 U4 bytes/4 u4 maximum/4 +/4 -/4 max/4] + ) + + (template [<name> <from> <to>] + [(def: .public <name> + (-> <from> <to>) + (|>> :transmutation))] + + [lifted/2 U1 U2] + [lifted/4 U2 U4] + ) + + (template [<writer_name> <type> <writer>] + [(def: .public <writer_name> + (Writer <type>) + (|>> :representation <writer>))] + + [writer/1 U1 format.bits/8] + [writer/2 U2 format.bits/16] + [writer/4 U4 format.bits/32] + ) ) diff --git a/stdlib/source/library/lux/target/jvm/index.lux b/stdlib/source/library/lux/target/jvm/index.lux index cdf27baba..361514578 100644 --- a/stdlib/source/library/lux/target/jvm/index.lux +++ b/stdlib/source/library/lux/target/jvm/index.lux @@ -18,21 +18,21 @@ (abstract: .public (Index kind) U2 - [(def: .public index - (All (_ kind) (-> U2 (Index kind))) - (|>> :abstraction)) + (def: .public index + (All (_ kind) (-> U2 (Index kind))) + (|>> :abstraction)) - (def: .public value - (-> (Index Any) U2) - (|>> :representation)) + (def: .public value + (-> (Index Any) U2) + (|>> :representation)) - (def: .public equivalence - (All (_ kind) (Equivalence (Index kind))) - (\ equivalence.functor each - ..value - //unsigned.equivalence)) + (def: .public equivalence + (All (_ kind) (Equivalence (Index kind))) + (\ equivalence.functor each + ..value + //unsigned.equivalence)) - (def: .public writer - (All (_ kind) (Writer (Index kind))) - (|>> :representation //unsigned.writer/2))] + (def: .public writer + (All (_ kind) (Writer (Index kind))) + (|>> :representation //unsigned.writer/2)) ) diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux index 48c0697d9..c37bb039b 100644 --- a/stdlib/source/library/lux/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/target/jvm/modifier.lux @@ -26,56 +26,56 @@ (abstract: .public (Modifier of) //unsigned.U2 - [(def: .public code - (-> (Modifier Any) //unsigned.U2) - (|>> :representation)) + (def: .public code + (-> (Modifier Any) //unsigned.U2) + (|>> :representation)) - (implementation: .public equivalence - (All (_ of) (Equivalence (Modifier of))) - - (def: (= reference sample) - (\ //unsigned.equivalence = - (:representation reference) - (:representation sample)))) + (implementation: .public equivalence + (All (_ of) (Equivalence (Modifier of))) + + (def: (= reference sample) + (\ //unsigned.equivalence = + (:representation reference) + (:representation sample)))) - (template: (!wrap value) - [(|> value - //unsigned.u2 - try.trusted - :abstraction)]) + (template: (!wrap value) + [(|> value + //unsigned.u2 + try.trusted + :abstraction)]) - (template: (!unwrap value) - [(|> value - :representation - //unsigned.value)]) + (template: (!unwrap value) + [(|> value + :representation + //unsigned.value)]) - (def: .public (has? sub super) - (All (_ of) (-> (Modifier of) (Modifier of) Bit)) - (let [sub (!unwrap sub)] - (|> (!unwrap super) - (i64.and sub) - (\ i64.equivalence = sub)))) + (def: .public (has? sub super) + (All (_ of) (-> (Modifier of) (Modifier of) Bit)) + (let [sub (!unwrap sub)] + (|> (!unwrap super) + (i64.and sub) + (\ i64.equivalence = sub)))) - (implementation: .public monoid - (All (_ of) (Monoid (Modifier of))) + (implementation: .public monoid + (All (_ of) (Monoid (Modifier of))) - (def: identity - (!wrap (hex "0000"))) - - (def: (composite left right) - (!wrap (i64.or (!unwrap left) (!unwrap right))))) + (def: identity + (!wrap (hex "0000"))) + + (def: (composite left right) + (!wrap (i64.or (!unwrap left) (!unwrap right))))) - (def: .public empty - Modifier - (\ ..monoid identity)) + (def: .public empty + Modifier + (\ ..monoid identity)) - (def: .public writer - (All (_ of) (Writer (Modifier of))) - (|>> :representation //unsigned.writer/2)) + (def: .public writer + (All (_ of) (Writer (Modifier of))) + (|>> :representation //unsigned.writer/2)) - (def: modifier - (-> Nat Modifier) - (|>> !wrap))] + (def: modifier + (-> Nat Modifier) + (|>> !wrap)) ) (syntax: .public (modifiers: [ofT <code>.any diff --git a/stdlib/source/library/lux/target/jvm/modifier/inner.lux b/stdlib/source/library/lux/target/jvm/modifier/inner.lux index 6327fefa8..8456668bb 100644 --- a/stdlib/source/library/lux/target/jvm/modifier/inner.lux +++ b/stdlib/source/library/lux/target/jvm/modifier/inner.lux @@ -5,7 +5,7 @@ abstract]]] [// {"+" [modifiers:]}]) -(abstract: .public Inner Any []) +(abstract: .public Inner Any) (modifiers: Inner ["0001" public] diff --git a/stdlib/source/library/lux/target/jvm/type.lux b/stdlib/source/library/lux/target/jvm/type.lux index e3ec58a89..3a3235a7c 100644 --- a/stdlib/source/library/lux/target/jvm/type.lux +++ b/stdlib/source/library/lux/target/jvm/type.lux @@ -30,165 +30,165 @@ (Descriptor category) (Reflection category)] - [(type: .public Argument - [Text (Type Value)]) - - (type: .public (Typed a) - [(Type Value) a]) - - (type: .public Constraint - (Record - [#name Text - #super_class (Type Class) - #super_interfaces (List (Type Class))])) - - (template [<name> <style>] - [(def: .public (<name> type) - (All (_ category) (-> (Type category) (<style> category))) - (let [[signature descriptor reflection] (:representation type)] - <name>))] - - [signature Signature] - [descriptor Descriptor] - ) - - (def: .public (reflection type) - (All (_ category) - (-> (Type (<| Return' Value' category)) - (Reflection (<| Return' Value' category)))) + (type: .public Argument + [Text (Type Value)]) + + (type: .public (Typed a) + [(Type Value) a]) + + (type: .public Constraint + (Record + [#name Text + #super_class (Type Class) + #super_interfaces (List (Type Class))])) + + (template [<name> <style>] + [(def: .public (<name> type) + (All (_ category) (-> (Type category) (<style> category))) + (let [[signature descriptor reflection] (:representation type)] + <name>))] + + [signature Signature] + [descriptor Descriptor] + ) + + (def: .public (reflection type) + (All (_ category) + (-> (Type (<| Return' Value' category)) + (Reflection (<| Return' Value' category)))) + (let [[signature descriptor reflection] (:representation type)] + reflection)) + + (template [<category> <name> <signature> <descriptor> <reflection>] + [(def: .public <name> + (Type <category>) + (:abstraction [<signature> <descriptor> <reflection>]))] + + [Void void /signature.void /descriptor.void /reflection.void] + [Primitive boolean /signature.boolean /descriptor.boolean /reflection.boolean] + [Primitive byte /signature.byte /descriptor.byte /reflection.byte] + [Primitive short /signature.short /descriptor.short /reflection.short] + [Primitive int /signature.int /descriptor.int /reflection.int] + [Primitive long /signature.long /descriptor.long /reflection.long] + [Primitive float /signature.float /descriptor.float /reflection.float] + [Primitive double /signature.double /descriptor.double /reflection.double] + [Primitive char /signature.char /descriptor.char /reflection.char] + ) + + (def: .public (array type) + (-> (Type Value) (Type Array)) + (:abstraction + [(/signature.array (..signature type)) + (/descriptor.array (..descriptor type)) + (/reflection.array (..reflection type))])) + + (def: .public (class name parameters) + (-> External (List (Type Parameter)) (Type Class)) + (:abstraction + [(/signature.class name (list\each ..signature parameters)) + (/descriptor.class name) + (/reflection.class name)])) + + (def: .public (declaration name variables) + (-> External (List (Type Var)) (Type Declaration)) + (:abstraction + [(/signature.declaration name (list\each ..signature variables)) + (/descriptor.declaration name) + (/reflection.declaration name)])) + + (def: .public (as_class type) + (-> (Type Declaration) (Type Class)) + (:abstraction (let [[signature descriptor reflection] (:representation type)] - reflection)) - - (template [<category> <name> <signature> <descriptor> <reflection>] - [(def: .public <name> - (Type <category>) - (:abstraction [<signature> <descriptor> <reflection>]))] - - [Void void /signature.void /descriptor.void /reflection.void] - [Primitive boolean /signature.boolean /descriptor.boolean /reflection.boolean] - [Primitive byte /signature.byte /descriptor.byte /reflection.byte] - [Primitive short /signature.short /descriptor.short /reflection.short] - [Primitive int /signature.int /descriptor.int /reflection.int] - [Primitive long /signature.long /descriptor.long /reflection.long] - [Primitive float /signature.float /descriptor.float /reflection.float] - [Primitive double /signature.double /descriptor.double /reflection.double] - [Primitive char /signature.char /descriptor.char /reflection.char] - ) - - (def: .public (array type) - (-> (Type Value) (Type Array)) - (:abstraction - [(/signature.array (..signature type)) - (/descriptor.array (..descriptor type)) - (/reflection.array (..reflection type))])) - - (def: .public (class name parameters) - (-> External (List (Type Parameter)) (Type Class)) - (:abstraction - [(/signature.class name (list\each ..signature parameters)) - (/descriptor.class name) - (/reflection.class name)])) - - (def: .public (declaration name variables) - (-> External (List (Type Var)) (Type Declaration)) - (:abstraction - [(/signature.declaration name (list\each ..signature variables)) - (/descriptor.declaration name) - (/reflection.declaration name)])) - - (def: .public (as_class type) - (-> (Type Declaration) (Type Class)) - (:abstraction - (let [[signature descriptor reflection] (:representation type)] - [(/signature.as_class signature) - (/descriptor.as_class descriptor) - (/reflection.as_class reflection)]))) - - (def: .public wildcard - (Type Parameter) - (:abstraction - [/signature.wildcard - /descriptor.wildcard - /reflection.wildcard])) - - (def: .public (var name) - (-> Text (Type Var)) - (:abstraction - [(/signature.var name) - /descriptor.var - /reflection.var])) - - (def: .public (lower bound) - (-> (Type Class) (Type Parameter)) - (:abstraction - (let [[signature descriptor reflection] (:representation bound)] - [(/signature.lower signature) - (/descriptor.lower descriptor) - (/reflection.lower reflection)]))) - - (def: .public (upper bound) - (-> (Type Class) (Type Parameter)) - (:abstraction - (let [[signature descriptor reflection] (:representation bound)] - [(/signature.upper signature) - (/descriptor.upper descriptor) - (/reflection.upper reflection)]))) - - (def: .public (method [type_variables inputs output exceptions]) - (-> [(List (Type Var)) - (List (Type Value)) - (Type Return) - (List (Type Class))] - (Type Method)) - (:abstraction - [(/signature.method [(list\each ..signature type_variables) - (list\each ..signature inputs) - (..signature output) - (list\each ..signature exceptions)]) - (/descriptor.method [(list\each ..descriptor inputs) - (..descriptor output)]) - (:expected ..void)])) - - (implementation: .public equivalence - (All (_ category) (Equivalence (Type category))) - - (def: (= parameter subject) - (\ /signature.equivalence = - (..signature parameter) - (..signature subject)))) - - (implementation: .public hash - (All (_ category) (Hash (Type category))) - - (def: &equivalence ..equivalence) - (def: hash (|>> ..signature (\ /signature.hash hash)))) - - (def: .public (primitive? type) - (-> (Type Value) (Either (Type Object) - (Type Primitive))) - (if (`` (or (~~ (template [<type>] - [(\ ..equivalence = (: (Type Value) <type>) type)] - - [..boolean] - [..byte] - [..short] - [..int] - [..long] - [..float] - [..double] - [..char])))) - (|> type (:as (Type Primitive)) #.Right) - (|> type (:as (Type Object)) #.Left))) - - (def: .public (void? type) - (-> (Type Return) (Either (Type Value) - (Type Void))) - (if (`` (or (~~ (template [<type>] - [(\ ..equivalence = (: (Type Return) <type>) type)] - - [..void])))) - (|> type (:as (Type Void)) #.Right) - (|> type (:as (Type Value)) #.Left)))] + [(/signature.as_class signature) + (/descriptor.as_class descriptor) + (/reflection.as_class reflection)]))) + + (def: .public wildcard + (Type Parameter) + (:abstraction + [/signature.wildcard + /descriptor.wildcard + /reflection.wildcard])) + + (def: .public (var name) + (-> Text (Type Var)) + (:abstraction + [(/signature.var name) + /descriptor.var + /reflection.var])) + + (def: .public (lower bound) + (-> (Type Class) (Type Parameter)) + (:abstraction + (let [[signature descriptor reflection] (:representation bound)] + [(/signature.lower signature) + (/descriptor.lower descriptor) + (/reflection.lower reflection)]))) + + (def: .public (upper bound) + (-> (Type Class) (Type Parameter)) + (:abstraction + (let [[signature descriptor reflection] (:representation bound)] + [(/signature.upper signature) + (/descriptor.upper descriptor) + (/reflection.upper reflection)]))) + + (def: .public (method [type_variables inputs output exceptions]) + (-> [(List (Type Var)) + (List (Type Value)) + (Type Return) + (List (Type Class))] + (Type Method)) + (:abstraction + [(/signature.method [(list\each ..signature type_variables) + (list\each ..signature inputs) + (..signature output) + (list\each ..signature exceptions)]) + (/descriptor.method [(list\each ..descriptor inputs) + (..descriptor output)]) + (:expected ..void)])) + + (implementation: .public equivalence + (All (_ category) (Equivalence (Type category))) + + (def: (= parameter subject) + (\ /signature.equivalence = + (..signature parameter) + (..signature subject)))) + + (implementation: .public hash + (All (_ category) (Hash (Type category))) + + (def: &equivalence ..equivalence) + (def: hash (|>> ..signature (\ /signature.hash hash)))) + + (def: .public (primitive? type) + (-> (Type Value) (Either (Type Object) + (Type Primitive))) + (if (`` (or (~~ (template [<type>] + [(\ ..equivalence = (: (Type Value) <type>) type)] + + [..boolean] + [..byte] + [..short] + [..int] + [..long] + [..float] + [..double] + [..char])))) + (|> type (:as (Type Primitive)) #.Right) + (|> type (:as (Type Object)) #.Left))) + + (def: .public (void? type) + (-> (Type Return) (Either (Type Value) + (Type Void))) + (if (`` (or (~~ (template [<type>] + [(\ ..equivalence = (: (Type Return) <type>) type)] + + [..void])))) + (|> type (:as (Type Void)) #.Right) + (|> type (:as (Type Value)) #.Left))) ) (def: .public (class? type) diff --git a/stdlib/source/library/lux/target/jvm/type/category.lux b/stdlib/source/library/lux/target/jvm/type/category.lux index 2f7a2eed6..6d4b73aa2 100644 --- a/stdlib/source/library/lux/target/jvm/type/category.lux +++ b/stdlib/source/library/lux/target/jvm/type/category.lux @@ -6,24 +6,24 @@ [type abstract]]]) -(abstract: .public Void' Any []) -(abstract: .public (Value' kind) Any []) -(abstract: .public (Return' kind) Any []) -(abstract: .public Method Any []) +(abstract: .public Void' Any) +(abstract: .public (Value' kind) Any) +(abstract: .public (Return' kind) Any) +(abstract: .public Method Any) (type: .public Return (<| Return' Any)) (type: .public Value (<| Return' Value' Any)) (type: .public Void (<| Return' Void')) -(abstract: .public (Object' brand) Any []) +(abstract: .public (Object' brand) Any) (type: .public Object (<| Return' Value' Object' Any)) -(abstract: .public (Parameter' brand) Any []) +(abstract: .public (Parameter' brand) Any) (type: .public Parameter (<| Return' Value' Object' Parameter' Any)) (template [<parents> <child>] [(with_expansions [<raw> (template.identifier [<child> "'"])] - (abstract: .public <raw> Any []) + (abstract: .public <raw> Any) (type: .public <child> (`` (<| Return' Value' (~~ (template.spliced <parents>)) <raw>))))] @@ -33,4 +33,4 @@ [[Object'] Array] ) -(abstract: .public Declaration Any []) +(abstract: .public Declaration Any) diff --git a/stdlib/source/library/lux/target/jvm/type/descriptor.lux b/stdlib/source/library/lux/target/jvm/type/descriptor.lux index 7d7d4e7fe..677c7b801 100644 --- a/stdlib/source/library/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/library/lux/target/jvm/type/descriptor.lux @@ -24,101 +24,101 @@ (abstract: .public (Descriptor category) Text - [(def: .public descriptor - (-> (Descriptor Any) Text) - (|>> :representation)) - - (template [<sigil> <category> <name>] - [(def: .public <name> - (Descriptor <category>) - (:abstraction <sigil>))] - - ["V" Void void] - ["Z" Primitive boolean] - ["B" Primitive byte] - ["S" Primitive short] - ["I" Primitive int] - ["J" Primitive long] - ["F" Primitive float] - ["D" Primitive double] - ["C" Primitive char] - ) - - (def: .public class_prefix "L") - (def: .public class_suffix ";") - - (def: .public class - (-> External (Descriptor Class)) - (|>> ///name.internal - ///name.read - (text.enclosed [..class_prefix ..class_suffix]) - :abstraction)) - - (def: .public (declaration name) - (-> External (Descriptor Declaration)) - (:transmutation (..class name))) - - (def: .public as_class - (-> (Descriptor Declaration) (Descriptor Class)) - (|>> :transmutation)) - - (template [<name> <category>] - [(def: .public <name> - (Descriptor <category>) - (:transmutation - (..class "java.lang.Object")))] - - [var Var] - [wildcard Parameter] - ) - - (def: .public (lower descriptor) - (-> (Descriptor Class) (Descriptor Parameter)) - ..wildcard) - - (def: .public upper - (-> (Descriptor Class) (Descriptor Parameter)) - (|>> :transmutation)) - - (def: .public array_prefix "[") - - (def: .public array - (-> (Descriptor Value) - (Descriptor Array)) - (|>> :representation - (format ..array_prefix) - :abstraction)) - - (def: .public (method [inputs output]) - (-> [(List (Descriptor Value)) - (Descriptor Return)] - (Descriptor Method)) - (:abstraction - (format (|> inputs - (list\each ..descriptor) - text.together - (text.enclosed ["(" ")"])) - (:representation output)))) - - (implementation: .public equivalence - (All (_ category) (Equivalence (Descriptor category))) - - (def: (= parameter subject) - (text\= (:representation parameter) (:representation subject)))) - - (def: .public class_name - (-> (Descriptor Object) Internal) - (let [prefix_size (text.size ..class_prefix) - suffix_size (text.size ..class_suffix)] - (function (_ descriptor) - (let [repr (:representation descriptor)] - (if (text.starts_with? ..array_prefix repr) - (///name.internal repr) - (|> repr - (text.clip prefix_size - (|> (text.size repr) - (n.- prefix_size) - (n.- suffix_size))) - (\ maybe.monad each ///name.internal) - maybe.trusted))))))] + (def: .public descriptor + (-> (Descriptor Any) Text) + (|>> :representation)) + + (template [<sigil> <category> <name>] + [(def: .public <name> + (Descriptor <category>) + (:abstraction <sigil>))] + + ["V" Void void] + ["Z" Primitive boolean] + ["B" Primitive byte] + ["S" Primitive short] + ["I" Primitive int] + ["J" Primitive long] + ["F" Primitive float] + ["D" Primitive double] + ["C" Primitive char] + ) + + (def: .public class_prefix "L") + (def: .public class_suffix ";") + + (def: .public class + (-> External (Descriptor Class)) + (|>> ///name.internal + ///name.read + (text.enclosed [..class_prefix ..class_suffix]) + :abstraction)) + + (def: .public (declaration name) + (-> External (Descriptor Declaration)) + (:transmutation (..class name))) + + (def: .public as_class + (-> (Descriptor Declaration) (Descriptor Class)) + (|>> :transmutation)) + + (template [<name> <category>] + [(def: .public <name> + (Descriptor <category>) + (:transmutation + (..class "java.lang.Object")))] + + [var Var] + [wildcard Parameter] + ) + + (def: .public (lower descriptor) + (-> (Descriptor Class) (Descriptor Parameter)) + ..wildcard) + + (def: .public upper + (-> (Descriptor Class) (Descriptor Parameter)) + (|>> :transmutation)) + + (def: .public array_prefix "[") + + (def: .public array + (-> (Descriptor Value) + (Descriptor Array)) + (|>> :representation + (format ..array_prefix) + :abstraction)) + + (def: .public (method [inputs output]) + (-> [(List (Descriptor Value)) + (Descriptor Return)] + (Descriptor Method)) + (:abstraction + (format (|> inputs + (list\each ..descriptor) + text.together + (text.enclosed ["(" ")"])) + (:representation output)))) + + (implementation: .public equivalence + (All (_ category) (Equivalence (Descriptor category))) + + (def: (= parameter subject) + (text\= (:representation parameter) (:representation subject)))) + + (def: .public class_name + (-> (Descriptor Object) Internal) + (let [prefix_size (text.size ..class_prefix) + suffix_size (text.size ..class_suffix)] + (function (_ descriptor) + (let [repr (:representation descriptor)] + (if (text.starts_with? ..array_prefix repr) + (///name.internal repr) + (|> repr + (text.clip prefix_size + (|> (text.size repr) + (n.- prefix_size) + (n.- suffix_size))) + (\ maybe.monad each ///name.internal) + maybe.trusted)))))) ) diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index d144ac6fe..ee5734d6d 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -30,7 +30,7 @@ ["[1][0]" name]]]]) (template [<name>] - [(abstract: .public (<name> class) Any [])] + [(abstract: .public (<name> class) Any)] [Lower] [Upper] ) diff --git a/stdlib/source/library/lux/target/jvm/type/reflection.lux b/stdlib/source/library/lux/target/jvm/type/reflection.lux index ce31cbbcc..a3a101f12 100644 --- a/stdlib/source/library/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/type/reflection.lux @@ -18,87 +18,87 @@ (abstract: .public (Reflection category) Text - [(def: .public reflection - (-> (Reflection Any) Text) - (|>> :representation)) + (def: .public reflection + (-> (Reflection Any) Text) + (|>> :representation)) - (implementation: .public equivalence - (All (_ category) (Equivalence (Reflection category))) - - (def: (= parameter subject) - (text\= (:representation parameter) (:representation subject)))) + (implementation: .public equivalence + (All (_ category) (Equivalence (Reflection category))) + + (def: (= parameter subject) + (text\= (:representation parameter) (:representation subject)))) - (template [<category> <name> <reflection>] - [(def: .public <name> - (Reflection <category>) - (:abstraction <reflection>))] + (template [<category> <name> <reflection>] + [(def: .public <name> + (Reflection <category>) + (:abstraction <reflection>))] - [Void void "void"] - [Primitive boolean "boolean"] - [Primitive byte "byte"] - [Primitive short "short"] - [Primitive int "int"] - [Primitive long "long"] - [Primitive float "float"] - [Primitive double "double"] - [Primitive char "char"] - ) + [Void void "void"] + [Primitive boolean "boolean"] + [Primitive byte "byte"] + [Primitive short "short"] + [Primitive int "int"] + [Primitive long "long"] + [Primitive float "float"] + [Primitive double "double"] + [Primitive char "char"] + ) - (def: .public class - (-> External (Reflection Class)) - (|>> :abstraction)) + (def: .public class + (-> External (Reflection Class)) + (|>> :abstraction)) - (def: .public (declaration name) - (-> External (Reflection Declaration)) - (:transmutation (..class name))) + (def: .public (declaration name) + (-> External (Reflection Declaration)) + (:transmutation (..class name))) - (def: .public as_class - (-> (Reflection Declaration) (Reflection Class)) - (|>> :transmutation)) + (def: .public as_class + (-> (Reflection Declaration) (Reflection Class)) + (|>> :transmutation)) - (def: .public (array element) - (-> (Reflection Value) (Reflection Array)) - (let [element' (:representation element) - elementR (`` (cond (text.starts_with? //descriptor.array_prefix element') - element' - - (~~ (template [<primitive> <descriptor>] - [(\ ..equivalence = <primitive> element) - (//descriptor.descriptor <descriptor>)] + (def: .public (array element) + (-> (Reflection Value) (Reflection Array)) + (let [element' (:representation element) + elementR (`` (cond (text.starts_with? //descriptor.array_prefix element') + element' + + (~~ (template [<primitive> <descriptor>] + [(\ ..equivalence = <primitive> element) + (//descriptor.descriptor <descriptor>)] - [..boolean //descriptor.boolean] - [..byte //descriptor.byte] - [..short //descriptor.short] - [..int //descriptor.int] - [..long //descriptor.long] - [..float //descriptor.float] - [..double //descriptor.double] - [..char //descriptor.char])) + [..boolean //descriptor.boolean] + [..byte //descriptor.byte] + [..short //descriptor.short] + [..int //descriptor.int] + [..long //descriptor.long] + [..float //descriptor.float] + [..double //descriptor.double] + [..char //descriptor.char])) - (|> element' - //descriptor.class - //descriptor.descriptor - (text.replaced //name.internal_separator - //name.external_separator))))] - (|> elementR - (format //descriptor.array_prefix) - :abstraction))) + (|> element' + //descriptor.class + //descriptor.descriptor + (text.replaced //name.internal_separator + //name.external_separator))))] + (|> elementR + (format //descriptor.array_prefix) + :abstraction))) - (template [<name> <category>] - [(def: .public <name> - (Reflection <category>) - (:transmutation - (..class "java.lang.Object")))] + (template [<name> <category>] + [(def: .public <name> + (Reflection <category>) + (:transmutation + (..class "java.lang.Object")))] - [var Var] - [wildcard Parameter] - ) + [var Var] + [wildcard Parameter] + ) - (def: .public (lower reflection) - (-> (Reflection Class) (Reflection Parameter)) - ..wildcard) + (def: .public (lower reflection) + (-> (Reflection Class) (Reflection Parameter)) + ..wildcard) - (def: .public upper - (-> (Reflection Class) (Reflection Parameter)) - (|>> :transmutation))] + (def: .public upper + (-> (Reflection Class) (Reflection Parameter)) + (|>> :transmutation)) ) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index 86663ce49..b0a2c0303 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -21,141 +21,141 @@ (abstract: .public (Signature category) Text - [(def: .public signature - (-> (Signature Any) Text) - (|>> :representation)) - - (template [<category> <name> <descriptor>] - [(def: .public <name> - (Signature <category>) - (:abstraction (//descriptor.descriptor <descriptor>)))] - - [Void void //descriptor.void] - [Primitive boolean //descriptor.boolean] - [Primitive byte //descriptor.byte] - [Primitive short //descriptor.short] - [Primitive int //descriptor.int] - [Primitive long //descriptor.long] - [Primitive float //descriptor.float] - [Primitive double //descriptor.double] - [Primitive char //descriptor.char] - ) - - (def: .public array - (-> (Signature Value) (Signature Array)) - (|>> :representation - (format //descriptor.array_prefix) - :abstraction)) - - (def: .public wildcard - (Signature Parameter) - (:abstraction "*")) - - (def: .public var_prefix "T") - - (def: .public var - (-> Text (Signature Var)) - (|>> (text.enclosed [..var_prefix //descriptor.class_suffix]) - :abstraction)) - - (def: .public var_name - (-> (Signature Var) Text) - (|>> :representation - (text.replaced ..var_prefix "") - (text.replaced //descriptor.class_suffix ""))) - - (def: .public lower_prefix "-") - (def: .public upper_prefix "+") - - (template [<name> <prefix>] - [(def: .public <name> - (-> (Signature Class) (Signature Parameter)) - (|>> :representation (format <prefix>) :abstraction))] - - [lower ..lower_prefix] - [upper ..upper_prefix] - ) - - (template [<char> <name>] - [(def: .public <name> - <char>)] - - ["<" parameters_start] - [">" parameters_end] - ) - - (def: .public (class name parameters) - (-> External (List (Signature Parameter)) (Signature Class)) - (:abstraction - (format //descriptor.class_prefix - (|> name ///name.internal ///name.read) - (case parameters - #.End - "" - - _ - (format ..parameters_start - (|> parameters - (list\each ..signature) - text.together) - ..parameters_end)) - //descriptor.class_suffix))) - - (def: .public (declaration name variables) - (-> External (List (Signature Var)) (Signature Declaration)) - (:transmutation (..class name variables))) - - (def: .public as_class - (-> (Signature Declaration) (Signature Class)) - (|>> :transmutation)) - - (def: .public arguments_start "(") - (def: .public arguments_end ")") - - (def: .public exception_prefix "^") - - (def: class_bound - (|> (..class "java.lang.Object" (list)) - ..signature - (format ":"))) - - (def: .public (method [type_variables inputs output exceptions]) - (-> [(List (Signature Var)) - (List (Signature Value)) - (Signature Return) - (List (Signature Class))] - (Signature Method)) - (:abstraction - (format (case type_variables - #.End - "" - _ - (|> type_variables - (list\each (|>> ..var_name - (text.suffix ..class_bound))) - text.together - (text.enclosed [..parameters_start - ..parameters_end]))) - (|> inputs - (list\each ..signature) - text.together - (text.enclosed [..arguments_start - ..arguments_end])) - (:representation output) - (|> exceptions - (list\each (|>> :representation (format ..exception_prefix))) - text.together)))) - - (implementation: .public equivalence - (All (_ category) (Equivalence (Signature category))) - - (def: (= parameter subject) - (text\= (:representation parameter) - (:representation subject)))) - - (implementation: .public hash - (All (_ category) (Hash (Signature category))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation text\hash)))] + (def: .public signature + (-> (Signature Any) Text) + (|>> :representation)) + + (template [<category> <name> <descriptor>] + [(def: .public <name> + (Signature <category>) + (:abstraction (//descriptor.descriptor <descriptor>)))] + + [Void void //descriptor.void] + [Primitive boolean //descriptor.boolean] + [Primitive byte //descriptor.byte] + [Primitive short //descriptor.short] + [Primitive int //descriptor.int] + [Primitive long //descriptor.long] + [Primitive float //descriptor.float] + [Primitive double //descriptor.double] + [Primitive char //descriptor.char] + ) + + (def: .public array + (-> (Signature Value) (Signature Array)) + (|>> :representation + (format //descriptor.array_prefix) + :abstraction)) + + (def: .public wildcard + (Signature Parameter) + (:abstraction "*")) + + (def: .public var_prefix "T") + + (def: .public var + (-> Text (Signature Var)) + (|>> (text.enclosed [..var_prefix //descriptor.class_suffix]) + :abstraction)) + + (def: .public var_name + (-> (Signature Var) Text) + (|>> :representation + (text.replaced ..var_prefix "") + (text.replaced //descriptor.class_suffix ""))) + + (def: .public lower_prefix "-") + (def: .public upper_prefix "+") + + (template [<name> <prefix>] + [(def: .public <name> + (-> (Signature Class) (Signature Parameter)) + (|>> :representation (format <prefix>) :abstraction))] + + [lower ..lower_prefix] + [upper ..upper_prefix] + ) + + (template [<char> <name>] + [(def: .public <name> + <char>)] + + ["<" parameters_start] + [">" parameters_end] + ) + + (def: .public (class name parameters) + (-> External (List (Signature Parameter)) (Signature Class)) + (:abstraction + (format //descriptor.class_prefix + (|> name ///name.internal ///name.read) + (case parameters + #.End + "" + + _ + (format ..parameters_start + (|> parameters + (list\each ..signature) + text.together) + ..parameters_end)) + //descriptor.class_suffix))) + + (def: .public (declaration name variables) + (-> External (List (Signature Var)) (Signature Declaration)) + (:transmutation (..class name variables))) + + (def: .public as_class + (-> (Signature Declaration) (Signature Class)) + (|>> :transmutation)) + + (def: .public arguments_start "(") + (def: .public arguments_end ")") + + (def: .public exception_prefix "^") + + (def: class_bound + (|> (..class "java.lang.Object" (list)) + ..signature + (format ":"))) + + (def: .public (method [type_variables inputs output exceptions]) + (-> [(List (Signature Var)) + (List (Signature Value)) + (Signature Return) + (List (Signature Class))] + (Signature Method)) + (:abstraction + (format (case type_variables + #.End + "" + _ + (|> type_variables + (list\each (|>> ..var_name + (text.suffix ..class_bound))) + text.together + (text.enclosed [..parameters_start + ..parameters_end]))) + (|> inputs + (list\each ..signature) + text.together + (text.enclosed [..arguments_start + ..arguments_end])) + (:representation output) + (|> exceptions + (list\each (|>> :representation (format ..exception_prefix))) + text.together)))) + + (implementation: .public equivalence + (All (_ category) (Equivalence (Signature category))) + + (def: (= parameter subject) + (text\= (:representation parameter) + (:representation subject)))) + + (implementation: .public hash + (All (_ category) (Hash (Signature category))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation text\hash))) ) diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index bf36d301e..6e1f1ee98 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -38,328 +38,328 @@ (abstract: .public (Code brand) Text - [(implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) Any []) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: <brand> Any []) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Literal [Computation' Expression' Code]] - [Var [Location' Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [Label [Code]] - ) - - (def: .public nil - Literal - (:abstraction "nil")) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "false" - #1 "true") - :abstraction)) - - (def: .public int - (-> Int Literal) - ... Integers must be turned into hexadecimal to avoid quirks in how Lua parses integers. - ... In particular, the number -9223372036854775808 will be incorrectly parsed as a float by Lua. - (.let [to_hex (\ n.hex encoded)] - (|>> .nat - to_hex - (format "0x") - :abstraction))) - - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "(1.0/0.0)" [])] - - [(f.= f.negative_infinity)] - [(new> "(-1.0/0.0)" [])] - - [(f.= f.not_a_number)] - [(new> "(0.0/0.0)" [])] - - ... else - [%.frac (text.replaced "+" "")]) - :abstraction)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe (text.enclosed' text.double_quote) :abstraction)) - - (def: .public multi - (-> (List Expression) Literal) - (|>> (list\each ..code) - (text.interposed ..input_separator) - :abstraction)) - - (def: .public array - (-> (List Expression) Literal) - (|>> (list\each ..code) - (text.interposed ..input_separator) - (text.enclosed ["{" "}"]) - :abstraction)) - - (def: .public table - (-> (List [Text Expression]) Literal) - (|>> (list\each (.function (_ [key value]) - (format key " = " (:representation value)))) - (text.interposed ..input_separator) - (text.enclosed ["{" "}"]) - :abstraction)) - - (def: .public (item idx array) - (-> Expression Expression Access) - (:abstraction (format (:representation array) "[" (:representation idx) "]"))) - - (def: .public (the field table) - (-> Text Expression Computation) - (:abstraction (format (:representation table) "." field))) - - (def: .public length - (-> Expression Computation) - (|>> :representation - (text.enclosed ["#(" ")"]) - :abstraction)) - - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (|> args - (list\each ..code) + (implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: <brand> Any) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [Label [Code]] + ) + + (def: .public nil + Literal + (:abstraction "nil")) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") + :abstraction)) + + (def: .public int + (-> Int Literal) + ... Integers must be turned into hexadecimal to avoid quirks in how Lua parses integers. + ... In particular, the number -9223372036854775808 will be incorrectly parsed as a float by Lua. + (.let [to_hex (\ n.hex encoded)] + (|>> .nat + to_hex + (format "0x") + :abstraction))) + + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "(1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(new> "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(new> "(0.0/0.0)" [])] + + ... else + [%.frac (text.replaced "+" "")]) + :abstraction)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe (text.enclosed' text.double_quote) :abstraction)) + + (def: .public multi + (-> (List Expression) Literal) + (|>> (list\each ..code) (text.interposed ..input_separator) - (text.enclosed ["(" ")"]) - (format (:representation func)) :abstraction)) - (def: .public (do method args table) - (-> Text (List Expression) Expression Computation) - (|> args - (list\each ..code) + (def: .public array + (-> (List Expression) Literal) + (|>> (list\each ..code) (text.interposed ..input_separator) - (text.enclosed ["(" ")"]) - (format (:representation table) ":" method) + (text.enclosed ["{" "}"]) :abstraction)) - (template [<op> <name>] - [(def: .public (<name> parameter subject) - (-> Expression Expression Expression) - (:abstraction (format "(" - (:representation subject) - " " <op> " " - (:representation parameter) - ")")))] - - ["==" =] - ["<" <] - ["<=" <=] - [">" >] - [">=" >=] - ["+" +] - ["-" -] - ["*" *] - ["^" ^] - ["/" /] - ["//" //] - ["%" %] - [".." concat] - - ["or" or] - ["and" and] - ["|" bit_or] - ["&" bit_and] - ["~" bit_xor] - - ["<<" bit_shl] - [">>" bit_shr] - ) - - (template [<name> <unary>] - [(def: .public (<name> subject) - (-> Expression Expression) - (:abstraction (format "(" <unary> " " (:representation subject) ")")))] - - [not "not"] - [opposite "-"] - ) - - (template [<name> <type>] - [(def: .public <name> - (-> Text <type>) - (|>> :abstraction))] - - [var Var] - [label Label] - ) - - (def: .public statement - (-> Expression Statement) - (|>> :representation :abstraction)) - - (def: .public (then pre! post!) - (-> Statement Statement Statement) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (def: locations - (-> (List Location) Text) - (|>> (list\each ..code) - (text.interposed ..input_separator))) - - (def: .public (local vars) - (-> (List Var) Statement) - (:abstraction (format "local " (..locations vars)))) - - (def: .public (set vars value) - (-> (List Location) Expression Statement) - (:abstraction (format (..locations vars) " = " (:representation value)))) - - (def: .public (let vars value) - (-> (List Var) Expression Statement) - (:abstraction (format "local " (..locations vars) " = " (:representation value)))) - - (def: .public (local/1 var value) - (-> Var Expression Statement) - (:abstraction (format "local " (:representation var) " = " (:representation value)))) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (:abstraction (format "if " (:representation test) - text.new_line "then" (..nested (:representation then!)) - text.new_line "else" (..nested (:representation else!)) - text.new_line "end"))) - - (def: .public (when test then!) - (-> Expression Statement Statement) - (:abstraction (format "if " (:representation test) - text.new_line "then" (..nested (:representation then!)) - text.new_line "end"))) - - (def: .public (while test body!) - (-> Expression Statement Statement) - (:abstraction - (format "while " (:representation test) " do" - (..nested (:representation body!)) - text.new_line "end"))) - - (def: .public (repeat until body!) - (-> Expression Statement Statement) - (:abstraction - (format "repeat" - (..nested (:representation body!)) - text.new_line "until " (:representation until)))) - - (def: .public (for_in vars source body!) - (-> (List Var) Expression Statement Statement) - (:abstraction - (format "for " (|> vars - (list\each ..code) - (text.interposed ..input_separator)) - " in " (:representation source) " do" - (..nested (:representation body!)) - text.new_line "end"))) - - (def: .public (for_step var from to step body!) - (-> Var Expression Expression Expression Statement - Statement) - (:abstraction - (format "for " (:representation var) - " = " (:representation from) - ..input_separator (:representation to) - ..input_separator (:representation step) " do" - (..nested (:representation body!)) - text.new_line "end"))) - - (def: .public (return value) - (-> Expression Statement) - (:abstraction (format "return " (:representation value)))) - - (def: .public (closure args body!) - (-> (List Var) Statement Expression) - (|> (format "function " (|> args - ..locations - (text.enclosed ["(" ")"])) - (..nested (:representation body!)) - text.new_line "end") - (text.enclosed ["(" ")"]) + (def: .public table + (-> (List [Text Expression]) Literal) + (|>> (list\each (.function (_ [key value]) + (format key " = " (:representation value)))) + (text.interposed ..input_separator) + (text.enclosed ["{" "}"]) + :abstraction)) + + (def: .public (item idx array) + (-> Expression Expression Access) + (:abstraction (format (:representation array) "[" (:representation idx) "]"))) + + (def: .public (the field table) + (-> Text Expression Computation) + (:abstraction (format (:representation table) "." field))) + + (def: .public length + (-> Expression Computation) + (|>> :representation + (text.enclosed ["#(" ")"]) :abstraction)) - (template [<name> <code>] - [(def: .public (<name> name args body!) - (-> Var (List Var) Statement Statement) - (:abstraction - (format <code> " " (:representation name) - (|> args - ..locations - (text.enclosed ["(" ")"])) - (..nested (:representation body!)) - text.new_line "end")))] - - [function "function"] - [local_function "local function"] - ) - - (def: .public break - Statement - (:abstraction "break")) - - (def: .public (set_label label) - (-> Label Statement) - (:abstraction (format "::" (:representation label) "::"))) - - (def: .public (go_to label) - (-> Label Statement) - (:abstraction (format "goto " (:representation label))))] + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (|> args + (list\each ..code) + (text.interposed ..input_separator) + (text.enclosed ["(" ")"]) + (format (:representation func)) + :abstraction)) + + (def: .public (do method args table) + (-> Text (List Expression) Expression Computation) + (|> args + (list\each ..code) + (text.interposed ..input_separator) + (text.enclosed ["(" ")"]) + (format (:representation table) ":" method) + :abstraction)) + + (template [<op> <name>] + [(def: .public (<name> parameter subject) + (-> Expression Expression Expression) + (:abstraction (format "(" + (:representation subject) + " " <op> " " + (:representation parameter) + ")")))] + + ["==" =] + ["<" <] + ["<=" <=] + [">" >] + [">=" >=] + ["+" +] + ["-" -] + ["*" *] + ["^" ^] + ["/" /] + ["//" //] + ["%" %] + [".." concat] + + ["or" or] + ["and" and] + ["|" bit_or] + ["&" bit_and] + ["~" bit_xor] + + ["<<" bit_shl] + [">>" bit_shr] + ) + + (template [<name> <unary>] + [(def: .public (<name> subject) + (-> Expression Expression) + (:abstraction (format "(" <unary> " " (:representation subject) ")")))] + + [not "not"] + [opposite "-"] + ) + + (template [<name> <type>] + [(def: .public <name> + (-> Text <type>) + (|>> :abstraction))] + + [var Var] + [label Label] + ) + + (def: .public statement + (-> Expression Statement) + (|>> :representation :abstraction)) + + (def: .public (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (def: locations + (-> (List Location) Text) + (|>> (list\each ..code) + (text.interposed ..input_separator))) + + (def: .public (local vars) + (-> (List Var) Statement) + (:abstraction (format "local " (..locations vars)))) + + (def: .public (set vars value) + (-> (List Location) Expression Statement) + (:abstraction (format (..locations vars) " = " (:representation value)))) + + (def: .public (let vars value) + (-> (List Var) Expression Statement) + (:abstraction (format "local " (..locations vars) " = " (:representation value)))) + + (def: .public (local/1 var value) + (-> Var Expression Statement) + (:abstraction (format "local " (:representation var) " = " (:representation value)))) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (:abstraction (format "if " (:representation test) + text.new_line "then" (..nested (:representation then!)) + text.new_line "else" (..nested (:representation else!)) + text.new_line "end"))) + + (def: .public (when test then!) + (-> Expression Statement Statement) + (:abstraction (format "if " (:representation test) + text.new_line "then" (..nested (:representation then!)) + text.new_line "end"))) + + (def: .public (while test body!) + (-> Expression Statement Statement) + (:abstraction + (format "while " (:representation test) " do" + (..nested (:representation body!)) + text.new_line "end"))) + + (def: .public (repeat until body!) + (-> Expression Statement Statement) + (:abstraction + (format "repeat" + (..nested (:representation body!)) + text.new_line "until " (:representation until)))) + + (def: .public (for_in vars source body!) + (-> (List Var) Expression Statement Statement) + (:abstraction + (format "for " (|> vars + (list\each ..code) + (text.interposed ..input_separator)) + " in " (:representation source) " do" + (..nested (:representation body!)) + text.new_line "end"))) + + (def: .public (for_step var from to step body!) + (-> Var Expression Expression Expression Statement + Statement) + (:abstraction + (format "for " (:representation var) + " = " (:representation from) + ..input_separator (:representation to) + ..input_separator (:representation step) " do" + (..nested (:representation body!)) + text.new_line "end"))) + + (def: .public (return value) + (-> Expression Statement) + (:abstraction (format "return " (:representation value)))) + + (def: .public (closure args body!) + (-> (List Var) Statement Expression) + (|> (format "function " (|> args + ..locations + (text.enclosed ["(" ")"])) + (..nested (:representation body!)) + text.new_line "end") + (text.enclosed ["(" ")"]) + :abstraction)) + + (template [<name> <code>] + [(def: .public (<name> name args body!) + (-> Var (List Var) Statement Statement) + (:abstraction + (format <code> " " (:representation name) + (|> args + ..locations + (text.enclosed ["(" ")"])) + (..nested (:representation body!)) + text.new_line "end")))] + + [function "function"] + [local_function "local function"] + ) + + (def: .public break + Statement + (:abstraction "break")) + + (def: .public (set_label label) + (-> Label Statement) + (:abstraction (format "::" (:representation label) "::"))) + + (def: .public (go_to label) + (-> Label Statement) + (:abstraction (format "goto " (:representation label)))) ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index dd205862f..79272dd3e 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -46,493 +46,493 @@ (abstract: .public (Code brand) Text - [(implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) Any []) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: .public <brand> Any []) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Literal [Computation' Expression' Code]] - [Var [Location' Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [Constant [Location' Computation' Expression' Code]] - [Global [Location' Computation' Expression' Code]] - [Label [Code]] - ) - - (type: .public Argument - (Record - [#reference? Bit - #var Var])) - - (def: .public ; - (-> Expression Statement) - (|>> :representation - (text.suffix ..statement_suffix) - :abstraction)) - - (def: .public var - (-> Text Var) - (|>> (format "$") :abstraction)) - - (template [<name> <type>] - [(def: .public <name> - (-> Text <type>) - (|>> :abstraction))] - - [constant Constant] - [label Label] - ) - - (def: .public (set_label label) - (-> Label Statement) - (:abstraction (format (:representation label) ":"))) - - (def: .public (go_to label) - (-> Label Statement) - (:abstraction - (format "goto " (:representation label) ..statement_suffix))) - - (def: .public null - Literal - (:abstraction "NULL")) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "false" - #1 "true") - :abstraction)) - - (def: .public int - (-> Int Literal) - (.let [to_hex (\ n.hex encoded)] - (|>> .nat - to_hex - (format "0x") - :abstraction))) - - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "+INF" [])] - - [(f.= f.negative_infinity)] - [(new> "-INF" [])] - - [(f.= f.not_a_number)] - [(new> "NAN" [])] - - ... else - [%.frac]) - :abstraction)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - ["$" "\$"] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed [text.double_quote text.double_quote]) - :abstraction)) - - (def: arguments - (-> (List Expression) Text) - (|>> (list\each ..code) (text.interposed ..input_separator) ..group)) - - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (|> (format (:representation func) (..arguments args)) + (implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: .public <brand> Any) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [Constant [Location' Computation' Expression' Code]] + [Global [Location' Computation' Expression' Code]] + [Label [Code]] + ) + + (type: .public Argument + (Record + [#reference? Bit + #var Var])) + + (def: .public ; + (-> Expression Statement) + (|>> :representation + (text.suffix ..statement_suffix) :abstraction)) - ... TODO: Remove when no longer using JPHP. - (def: .public (apply/*' args func) - (-> (List Expression) Expression Computation) - (apply/* (list& func args) (..constant "call_user_func"))) - - (def: parameters - (-> (List Argument) Text) - (|>> (list\each (function (_ [reference? var]) - (.if reference? - (format "&" (:representation var)) - (:representation var)))) - (text.interposed ..input_separator) - ..group)) - - (template [<name> <reference?>] - [(def: .public <name> - (-> Var Argument) - (|>> [<reference?>]))] - - [parameter #0] - [reference #1] - ) - - (def: .public (closure uses arguments body!) - (-> (List Argument) (List Argument) Statement Literal) - (let [uses (case uses - #.End - "" - - _ - (format "use " (..parameters uses)))] - (|> (format "function " (..parameters arguments) - " " uses " " - (..block (:representation body!))) - ..group - :abstraction))) + (def: .public var + (-> Text Var) + (|>> (format "$") :abstraction)) - (syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list\each (|>> %.nat code.local_identifier)))))) - - (syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) - - (template [<arity> <function>+] - [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) - <inputs> (arity_inputs <arity>) - <types> (arity_types <arity>) - <definitions> (template.spliced <function>+)] - (def: .public (<apply> function [<inputs>]) - (-> Expression [<types>] Computation) - (..apply/* (.list <inputs>) function)) - - (template [<function>] - [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) - (<apply> (..constant <function>))))] - - <definitions>))] - - [0 - [["func_num_args"] - ["func_get_args"] - ["time"] - ["phpversion"]]] - - [1 - [["isset"] - ["var_dump"] - ["is_null"] - ["empty"] - ["count"] - ["array_pop"] - ["array_reverse"] - ["intval"] - ["floatval"] - ["strval"] - ["ord"] - ["chr"] - ["print"] - ["exit"] - ["iconv_strlen"] ["strlen"] - ["log"] - ["ceil"] - ["floor"] - ["is_nan"]]] - - [2 - [["intdiv"] - ["fmod"] - ["number_format"] - ["array_key_exists"] - ["call_user_func_array"] - ["array_slice"] - ["array_push"] - ["pack"] - ["unpack"] - ["iconv_strpos"] ["strpos"] - ["pow"] - ["max"]]] - - [3 - [["array_fill"] - ["array_slice"] - ["array_splice"] - ["iconv"] - ["iconv_strpos"] ["strpos"] - ["iconv_substr"] ["substr"]]] - ) - - (def: .public (key_value key value) - (-> Expression Expression Expression) - (:abstraction (format (:representation key) " => " (:representation value)))) - - (def: .public (array/* values) - (-> (List Expression) Literal) - (|> values - (list\each ..code) - (text.interposed ..input_separator) - ..group - (format "array") - :abstraction)) + (template [<name> <type>] + [(def: .public <name> + (-> Text <type>) + (|>> :abstraction))] - (def: .public (array_merge/+ required optionals) - (-> Expression (List Expression) Computation) - (..apply/* (list& required optionals) (..constant "array_merge"))) + [constant Constant] + [label Label] + ) - (def: .public (array/** kvs) - (-> (List [Expression Expression]) Literal) - (|> kvs - (list\each (function (_ [key value]) - (format (:representation key) " => " (:representation value)))) - (text.interposed ..input_separator) - ..group - (format "array") - :abstraction)) + (def: .public (set_label label) + (-> Label Statement) + (:abstraction (format (:representation label) ":"))) - (def: .public (new constructor inputs) - (-> Constant (List Expression) Computation) - (|> (format "new " (:representation constructor) (arguments inputs)) - :abstraction)) + (def: .public (go_to label) + (-> Label Statement) + (:abstraction + (format "goto " (:representation label) ..statement_suffix))) - (def: .public (the field object) - (-> Text Expression Computation) - (|> (format (:representation object) "->" field) - :abstraction)) - - (def: .public (do method inputs object) - (-> Text (List Expression) Expression Computation) - (|> (format (:representation (..the method object)) - (..arguments inputs)) - :abstraction)) + (def: .public null + Literal + (:abstraction "NULL")) - (def: .public (item idx array) - (-> Expression Expression Access) - (|> (format (:representation array) "[" (:representation idx) "]") + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") :abstraction)) - (def: .public (global name) - (-> Text Global) - (|> (..var "GLOBALS") (..item (..string name)) :transmutation)) + (def: .public int + (-> Int Literal) + (.let [to_hex (\ n.hex encoded)] + (|>> .nat + to_hex + (format "0x") + :abstraction))) - (def: .public (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (..group (:representation test)) " ? " - (..group (:representation then)) " : " - (..group (:representation else))) - ..group + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "+INF" [])] + + [(f.= f.negative_infinity)] + [(new> "-INF" [])] + + [(f.= f.not_a_number)] + [(new> "NAN" [])] + + ... else + [%.frac]) :abstraction)) - (template [<name> <op>] - [(def: .public (<name> parameter subject) - (-> Expression Expression Computation) - (|> (format (:representation subject) " " <op> " " (:representation parameter)) - ..group - :abstraction))] - - [or "||"] - [and "&&"] - [== "=="] - [=== "==="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [% "%"] - [bit_or "|"] - [bit_and "&"] - [bit_xor "^"] - [bit_shl "<<"] - [bit_shr ">>"] - [concat "."] - ) - - (template [<unary> <name>] - [(def: .public <name> - (-> Computation Computation) - (|>> :representation (format <unary>) :abstraction))] - - ["!" not] - ["~" bit_not] - ["-" opposite] - ) - - (def: .public (set var value) - (-> Location Expression Computation) - (|> (format (:representation var) " = " (:representation value)) - ..group + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + ["$" "\$"] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed [text.double_quote text.double_quote]) :abstraction)) - (def: .public (set! var value) - (-> Location Expression Statement) - (:abstraction (format (:representation var) " = " (:representation value) ";"))) - - (def: .public (set? var) - (-> Var Computation) - (..apply/1 [var] (..constant "isset"))) - - (template [<name> <modifier>] - [(def: .public <name> - (-> Var Statement) - (|>> :representation (format <modifier> " ") (text.suffix ..statement_suffix) :abstraction))] - - [define_global "global"] - ) - - (template [<name> <modifier> <location>] - [(def: .public (<name> location value) - (-> <location> Expression Statement) - (:abstraction (format <modifier> " " (:representation location) - " = " (:representation value) - ..statement_suffix)))] - - [define_static "static" Var] - [define_constant "const" Constant] - ) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (:abstraction - (format "if" (..group (:representation test)) " " - (..block (:representation then!)) - " else " - (..block (:representation else!))))) - - (def: .public (when test then!) - (-> Expression Statement Statement) - (:abstraction - (format "if" (..group (:representation test)) " " - (..block (:representation then!))))) - - (def: .public (then pre! post!) - (-> Statement Statement Statement) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (def: .public (while test body!) - (-> Expression Statement Statement) - (:abstraction - (format "while" (..group (:representation test)) " " - (..block (:representation body!))))) - - (def: .public (do_while test body!) - (-> Expression Statement Statement) - (:abstraction - (format "do " (..block (:representation body!)) - " while" (..group (:representation test)) - ..statement_suffix))) - - (def: .public (for_each array value body!) - (-> Expression Var Statement Statement) - (:abstraction - (format "foreach(" (:representation array) - " as " (:representation value) - ") " (..block (:representation body!))))) - - (type: .public Except - (Record - [#class Constant - #exception Var - #handler Statement])) - - (def: (catch except) - (-> Except Text) - (let [declaration (format (:representation (value@ #class except)) - " " (:representation (value@ #exception except)))] - (format "catch" (..group declaration) " " - (..block (:representation (value@ #handler except)))))) - - (def: .public (try body! excepts) - (-> Statement (List Except) Statement) - (:abstraction - (format "try " (..block (:representation body!)) - text.new_line - (|> excepts - (list\each catch) - (text.interposed text.new_line))))) - - (template [<name> <keyword>] - [(def: .public <name> - (-> Expression Statement) - (|>> :representation (format <keyword> " ") (text.suffix ..statement_suffix) :abstraction))] - - [throw "throw"] - [return "return"] - [echo "echo"] - ) - - (def: .public (define name value) - (-> Constant Expression Expression) - (..apply/2 (..constant "define") - [(|> name :representation ..string) - value])) - - (def: .public (define_function name arguments body!) - (-> Constant (List Argument) Statement Statement) - (:abstraction - (format "function " (:representation name) - (..parameters arguments) - " " - (..block (:representation body!))))) - - (template [<name> <keyword>] - [(def: .public <name> - Statement - (|> <keyword> - (text.suffix ..statement_suffix) - :abstraction))] - - [break "break"] - [continue "continue"] - ) - - (def: .public splat - (-> Expression Expression) - (|>> :representation (format "...") :abstraction))] + (def: arguments + (-> (List Expression) Text) + (|>> (list\each ..code) (text.interposed ..input_separator) ..group)) + + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (|> (format (:representation func) (..arguments args)) + :abstraction)) + + ... TODO: Remove when no longer using JPHP. + (def: .public (apply/*' args func) + (-> (List Expression) Expression Computation) + (apply/* (list& func args) (..constant "call_user_func"))) + + (def: parameters + (-> (List Argument) Text) + (|>> (list\each (function (_ [reference? var]) + (.if reference? + (format "&" (:representation var)) + (:representation var)))) + (text.interposed ..input_separator) + ..group)) + + (template [<name> <reference?>] + [(def: .public <name> + (-> Var Argument) + (|>> [<reference?>]))] + + [parameter #0] + [reference #1] + ) + + (def: .public (closure uses arguments body!) + (-> (List Argument) (List Argument) Statement Literal) + (let [uses (case uses + #.End + "" + + _ + (format "use " (..parameters uses)))] + (|> (format "function " (..parameters arguments) + " " uses " " + (..block (:representation body!))) + ..group + :abstraction))) + + (syntax: (arity_inputs [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list\each (|>> %.nat code.local_identifier)))))) + + (syntax: (arity_types [arity <code>.nat]) + (in (list.repeated arity (` ..Expression)))) + + (template [<arity> <function>+] + [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) + <inputs> (arity_inputs <arity>) + <types> (arity_types <arity>) + <definitions> (template.spliced <function>+)] + (def: .public (<apply> function [<inputs>]) + (-> Expression [<types>] Computation) + (..apply/* (.list <inputs>) function)) + + (template [<function>] + [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) + (<apply> (..constant <function>))))] + + <definitions>))] + + [0 + [["func_num_args"] + ["func_get_args"] + ["time"] + ["phpversion"]]] + + [1 + [["isset"] + ["var_dump"] + ["is_null"] + ["empty"] + ["count"] + ["array_pop"] + ["array_reverse"] + ["intval"] + ["floatval"] + ["strval"] + ["ord"] + ["chr"] + ["print"] + ["exit"] + ["iconv_strlen"] ["strlen"] + ["log"] + ["ceil"] + ["floor"] + ["is_nan"]]] + + [2 + [["intdiv"] + ["fmod"] + ["number_format"] + ["array_key_exists"] + ["call_user_func_array"] + ["array_slice"] + ["array_push"] + ["pack"] + ["unpack"] + ["iconv_strpos"] ["strpos"] + ["pow"] + ["max"]]] + + [3 + [["array_fill"] + ["array_slice"] + ["array_splice"] + ["iconv"] + ["iconv_strpos"] ["strpos"] + ["iconv_substr"] ["substr"]]] + ) + + (def: .public (key_value key value) + (-> Expression Expression Expression) + (:abstraction (format (:representation key) " => " (:representation value)))) + + (def: .public (array/* values) + (-> (List Expression) Literal) + (|> values + (list\each ..code) + (text.interposed ..input_separator) + ..group + (format "array") + :abstraction)) + + (def: .public (array_merge/+ required optionals) + (-> Expression (List Expression) Computation) + (..apply/* (list& required optionals) (..constant "array_merge"))) + + (def: .public (array/** kvs) + (-> (List [Expression Expression]) Literal) + (|> kvs + (list\each (function (_ [key value]) + (format (:representation key) " => " (:representation value)))) + (text.interposed ..input_separator) + ..group + (format "array") + :abstraction)) + + (def: .public (new constructor inputs) + (-> Constant (List Expression) Computation) + (|> (format "new " (:representation constructor) (arguments inputs)) + :abstraction)) + + (def: .public (the field object) + (-> Text Expression Computation) + (|> (format (:representation object) "->" field) + :abstraction)) + + (def: .public (do method inputs object) + (-> Text (List Expression) Expression Computation) + (|> (format (:representation (..the method object)) + (..arguments inputs)) + :abstraction)) + + (def: .public (item idx array) + (-> Expression Expression Access) + (|> (format (:representation array) "[" (:representation idx) "]") + :abstraction)) + + (def: .public (global name) + (-> Text Global) + (|> (..var "GLOBALS") (..item (..string name)) :transmutation)) + + (def: .public (? test then else) + (-> Expression Expression Expression Computation) + (|> (format (..group (:representation test)) " ? " + (..group (:representation then)) " : " + (..group (:representation else))) + ..group + :abstraction)) + + (template [<name> <op>] + [(def: .public (<name> parameter subject) + (-> Expression Expression Computation) + (|> (format (:representation subject) " " <op> " " (:representation parameter)) + ..group + :abstraction))] + + [or "||"] + [and "&&"] + [== "=="] + [=== "==="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [% "%"] + [bit_or "|"] + [bit_and "&"] + [bit_xor "^"] + [bit_shl "<<"] + [bit_shr ">>"] + [concat "."] + ) + + (template [<unary> <name>] + [(def: .public <name> + (-> Computation Computation) + (|>> :representation (format <unary>) :abstraction))] + + ["!" not] + ["~" bit_not] + ["-" opposite] + ) + + (def: .public (set var value) + (-> Location Expression Computation) + (|> (format (:representation var) " = " (:representation value)) + ..group + :abstraction)) + + (def: .public (set! var value) + (-> Location Expression Statement) + (:abstraction (format (:representation var) " = " (:representation value) ";"))) + + (def: .public (set? var) + (-> Var Computation) + (..apply/1 [var] (..constant "isset"))) + + (template [<name> <modifier>] + [(def: .public <name> + (-> Var Statement) + (|>> :representation (format <modifier> " ") (text.suffix ..statement_suffix) :abstraction))] + + [define_global "global"] + ) + + (template [<name> <modifier> <location>] + [(def: .public (<name> location value) + (-> <location> Expression Statement) + (:abstraction (format <modifier> " " (:representation location) + " = " (:representation value) + ..statement_suffix)))] + + [define_static "static" Var] + [define_constant "const" Constant] + ) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (:abstraction + (format "if" (..group (:representation test)) " " + (..block (:representation then!)) + " else " + (..block (:representation else!))))) + + (def: .public (when test then!) + (-> Expression Statement Statement) + (:abstraction + (format "if" (..group (:representation test)) " " + (..block (:representation then!))))) + + (def: .public (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (def: .public (while test body!) + (-> Expression Statement Statement) + (:abstraction + (format "while" (..group (:representation test)) " " + (..block (:representation body!))))) + + (def: .public (do_while test body!) + (-> Expression Statement Statement) + (:abstraction + (format "do " (..block (:representation body!)) + " while" (..group (:representation test)) + ..statement_suffix))) + + (def: .public (for_each array value body!) + (-> Expression Var Statement Statement) + (:abstraction + (format "foreach(" (:representation array) + " as " (:representation value) + ") " (..block (:representation body!))))) + + (type: .public Except + (Record + [#class Constant + #exception Var + #handler Statement])) + + (def: (catch except) + (-> Except Text) + (let [declaration (format (:representation (value@ #class except)) + " " (:representation (value@ #exception except)))] + (format "catch" (..group declaration) " " + (..block (:representation (value@ #handler except)))))) + + (def: .public (try body! excepts) + (-> Statement (List Except) Statement) + (:abstraction + (format "try " (..block (:representation body!)) + text.new_line + (|> excepts + (list\each catch) + (text.interposed text.new_line))))) + + (template [<name> <keyword>] + [(def: .public <name> + (-> Expression Statement) + (|>> :representation (format <keyword> " ") (text.suffix ..statement_suffix) :abstraction))] + + [throw "throw"] + [return "return"] + [echo "echo"] + ) + + (def: .public (define name value) + (-> Constant Expression Expression) + (..apply/2 (..constant "define") + [(|> name :representation ..string) + value])) + + (def: .public (define_function name arguments body!) + (-> Constant (List Argument) Statement Statement) + (:abstraction + (format "function " (:representation name) + (..parameters arguments) + " " + (..block (:representation body!))))) + + (template [<name> <keyword>] + [(def: .public <name> + Statement + (|> <keyword> + (text.suffix ..statement_suffix) + :abstraction))] + + [break "break"] + [continue "continue"] + ) + + (def: .public splat + (-> Expression Expression) + (|>> :representation (format "...") :abstraction)) ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index a649fbcf1..1a9796a44 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -50,403 +50,403 @@ (abstract: .public (Code brand) Text - [(implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: (<brand> brand) Any [])) - (`` (type: .public (<type> brand) - (<super> (<brand> brand)))))] - - [Expression Code] - [Computation Expression] - [Location Computation] - [Var Location] - [Statement Code] - ) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: <brand> Any [])) - (`` (type: .public <type> (<super> <brand>))))] - - [Literal Computation] - [Access Location] - [Loop Statement] - [Label Code] - ) - - (template [<var> <brand>] - [(abstract: .public <brand> Any []) - - (type: .public <var> (Var <brand>))] - - [SVar Single] - [PVar Poly] - [KVar Keyword] - ) - - (def: .public var - (-> Text SVar) - (|>> :abstraction)) - - (template [<name> <brand> <prefix>] - [(def: .public <name> - (-> SVar (Var <brand>)) - (|>> :representation (format <prefix>) :abstraction))] - - [poly Poly "*"] - [keyword Keyword "**"] - ) - - (def: .public none - Literal - (:abstraction "None")) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "False" - #1 "True") - :abstraction)) - - (def: .public int - (-> Int Literal) - (|>> %.int :abstraction)) - - (def: .public (long value) - (-> Int Literal) - (:abstraction (format (%.int value) "L"))) - - (def: .public float - (-> Frac Literal) - (`` (|>> (cond> (~~ (template [<test> <python>] - [[<test>] - [(new> (format "float(" text.double_quote <python> text.double_quote ")") [])]] - - [(f.= f.positive_infinity) "inf"] - [(f.= f.negative_infinity) "-inf"] - [f.not_a_number? "nan"] - )) - - ... else - [%.frac]) - :abstraction))) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed [text.double_quote text.double_quote]) - :abstraction)) - - (def: .public unicode - (-> Text Literal) - (|>> ..string - :representation - (format "u") - :abstraction)) - - (def: (composite_literal left_delimiter right_delimiter entry_serializer) - (All (_ a) - (-> Text Text (-> a Text) - (-> (List a) Literal))) - (function (_ entries) + (implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: (<brand> brand) Any)) + (`` (type: .public (<type> brand) + (<super> (<brand> brand)))))] + + [Expression Code] + [Computation Expression] + [Location Computation] + [Var Location] + [Statement Code] + ) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: <brand> Any)) + (`` (type: .public <type> (<super> <brand>))))] + + [Literal Computation] + [Access Location] + [Loop Statement] + [Label Code] + ) + + (template [<var> <brand>] + [(abstract: .public <brand> Any) + + (type: .public <var> (Var <brand>))] + + [SVar Single] + [PVar Poly] + [KVar Keyword] + ) + + (def: .public var + (-> Text SVar) + (|>> :abstraction)) + + (template [<name> <brand> <prefix>] + [(def: .public <name> + (-> SVar (Var <brand>)) + (|>> :representation (format <prefix>) :abstraction))] + + [poly Poly "*"] + [keyword Keyword "**"] + ) + + (def: .public none + Literal + (:abstraction "None")) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "False" + #1 "True") + :abstraction)) + + (def: .public int + (-> Int Literal) + (|>> %.int :abstraction)) + + (def: .public (long value) + (-> Int Literal) + (:abstraction (format (%.int value) "L"))) + + (def: .public float + (-> Frac Literal) + (`` (|>> (cond> (~~ (template [<test> <python>] + [[<test>] + [(new> (format "float(" text.double_quote <python> text.double_quote ")") [])]] + + [(f.= f.positive_infinity) "inf"] + [(f.= f.negative_infinity) "-inf"] + [f.not_a_number? "nan"] + )) + + ... else + [%.frac]) + :abstraction))) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed [text.double_quote text.double_quote]) + :abstraction)) + + (def: .public unicode + (-> Text Literal) + (|>> ..string + :representation + (format "u") + :abstraction)) + + (def: (composite_literal left_delimiter right_delimiter entry_serializer) + (All (_ a) + (-> Text Text (-> a Text) + (-> (List a) Literal))) + (function (_ entries) + (<| :abstraction + ... ..expression + (format left_delimiter + (|> entries + (list\each entry_serializer) + (text.interposed ", ")) + right_delimiter)))) + + (template [<name> <pre> <post>] + [(def: .public <name> + (-> (List (Expression Any)) Literal) + (composite_literal <pre> <post> ..code))] + + [tuple "(" ")"] + [list "[" "]"] + ) + + (def: .public (slice from to list) + (-> (Expression Any) (Expression Any) (Expression Any) Access) + (<| :abstraction + ... ..expression + (format (:representation list) "[" (:representation from) ":" (:representation to) "]"))) + + (def: .public (slice_from from list) + (-> (Expression Any) (Expression Any) Access) + (<| :abstraction + ... ..expression + (format (:representation list) "[" (:representation from) ":]"))) + + (def: .public dict + (-> (List [(Expression Any) (Expression Any)]) (Computation Any)) + (composite_literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v))))) + + (def: .public (apply/* func args) + (-> (Expression Any) (List (Expression Any)) (Computation Any)) + (<| :abstraction + ... ..expression + (format (:representation func) "(" (text.interposed ", " (list\each ..code args)) ")"))) + + (template [<name> <brand> <prefix>] + [(def: (<name> var) + (-> (Expression Any) Text) + (format <prefix> (:representation var)))] + + [splat_poly Poly "*"] + [splat_keyword Keyword "**"] + ) + + (template [<name> <splat>] + [(def: .public (<name> args extra func) + (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any)) (<| :abstraction ... ..expression - (format left_delimiter - (|> entries - (list\each entry_serializer) - (text.interposed ", ")) - right_delimiter)))) - - (template [<name> <pre> <post>] - [(def: .public <name> - (-> (List (Expression Any)) Literal) - (composite_literal <pre> <post> ..code))] - - [tuple "(" ")"] - [list "[" "]"] - ) - - (def: .public (slice from to list) - (-> (Expression Any) (Expression Any) (Expression Any) Access) - (<| :abstraction - ... ..expression - (format (:representation list) "[" (:representation from) ":" (:representation to) "]"))) - - (def: .public (slice_from from list) - (-> (Expression Any) (Expression Any) Access) - (<| :abstraction - ... ..expression - (format (:representation list) "[" (:representation from) ":]"))) - - (def: .public dict - (-> (List [(Expression Any) (Expression Any)]) (Computation Any)) - (composite_literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v))))) - - (def: .public (apply/* func args) - (-> (Expression Any) (List (Expression Any)) (Computation Any)) - (<| :abstraction - ... ..expression - (format (:representation func) "(" (text.interposed ", " (list\each ..code args)) ")"))) - - (template [<name> <brand> <prefix>] - [(def: (<name> var) - (-> (Expression Any) Text) - (format <prefix> (:representation var)))] - - [splat_poly Poly "*"] - [splat_keyword Keyword "**"] - ) - - (template [<name> <splat>] - [(def: .public (<name> args extra func) - (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any)) - (<| :abstraction - ... ..expression - (format (:representation func) - (format "(" (|> args - (list\each (function (_ arg) (format (:representation arg) ", "))) - text.together) - (<splat> extra) ")"))))] - - [apply_poly splat_poly] - [apply_keyword splat_keyword] - ) - - (def: .public (the name object) - (-> Text (Expression Any) (Computation Any)) - (:abstraction (format (:representation object) "." name))) - - (def: .public (do method args object) - (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) - (..apply/* (..the method object) args)) - - (template [<name> <apply>] - [(def: .public (<name> args extra method) - (-> (List (Expression Any)) (Expression Any) Text - (-> (Expression Any) (Computation Any))) - (|>> (..the method) (<apply> args extra)))] - - [do_poly apply_poly] - [do_keyword apply_keyword] - ) - - (def: .public (item idx array) - (-> (Expression Any) (Expression Any) Location) - (:abstraction (format (:representation array) "[" (:representation idx) "]"))) - - (def: .public (? test then else) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) - (<| :abstraction - ..expression - (format (:representation then) " if " (:representation test) " else " (:representation else)))) - - (template [<name> <op>] - [(def: .public (<name> param subject) - (-> (Expression Any) (Expression Any) (Computation Any)) - (<| :abstraction - ..expression - (format (:representation subject) " " <op> " " (:representation param))))] - - [is "is"] - [= "=="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [// "//"] - [% "%"] - [** "**"] - [bit_or "|"] - [bit_and "&"] - [bit_xor "^"] - [bit_shl "<<"] - [bit_shr ">>"] - - [or "or"] - [and "and"] - ) - - (template [<name> <unary>] - [(def: .public (<name> subject) - (-> (Expression Any) (Computation Any)) - (<| :abstraction - ... ..expression - (format <unary> " " (:representation subject))))] - - [not "not"] - [opposite "-"] - ) - - (def: .public (lambda arguments body) - (-> (List (Var Any)) (Expression Any) (Computation Any)) - (<| :abstraction - ..expression - (format "lambda " (|> arguments (list\each ..code) (text.interposed ", ")) ": " - (:representation body)))) - - (def: .public (set vars value) - (-> (List (Location Any)) (Expression Any) (Statement Any)) - (:abstraction - (format (|> vars (list\each ..code) (text.interposed ", ")) - " = " - (:representation value)))) - - (def: .public (delete where) - (-> (Location Any) (Statement Any)) - (:abstraction (format "del " (:representation where)))) - - (def: .public (if test then! else!) - (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any)) - (:abstraction - (format "if " (:representation test) ":" - (..nested (:representation then!)) - text.new_line "else:" - (..nested (:representation else!))))) - - (def: .public (when test then!) - (-> (Expression Any) (Statement Any) (Statement Any)) - (:abstraction - (format "if " (:representation test) ":" - (..nested (:representation then!))))) - - (def: .public (then pre! post!) - (-> (Statement Any) (Statement Any) (Statement Any)) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (template [<keyword> <0>] - [(def: .public <0> - (Statement Any) - (:abstraction <keyword>))] - - ["break" break] - ["continue" continue] - ) - - (def: .public (while test body! else!) - (-> (Expression Any) (Statement Any) (Maybe (Statement Any)) Loop) - (:abstraction - (format "while " (:representation test) ":" - (..nested (:representation body!)) - (case else! - {#.Some else!} - (format text.new_line "else:" - (..nested (:representation else!))) - - #.None - "")))) - - (def: .public (for_in var inputs body!) - (-> SVar (Expression Any) (Statement Any) Loop) - (:abstraction - (format "for " (:representation var) " in " (:representation inputs) ":" - (..nested (:representation body!))))) - - (def: .public statement - (-> (Expression Any) (Statement Any)) - (|>> :transmutation)) - - (def: .public pass - (Statement Any) - (:abstraction "pass")) - - (type: .public Except - (Record - [#classes (List SVar) - #exception SVar - #handler (Statement Any)])) - - (def: .public (try body! excepts) - (-> (Statement Any) (List Except) (Statement Any)) - (:abstraction - (format "try:" - (..nested (:representation body!)) - (|> excepts - (list\each (function (_ [classes exception catch!]) - (format text.new_line "except (" (text.interposed ", " (list\each ..code classes)) - ") as " (:representation exception) ":" - (..nested (:representation catch!))))) - text.together)))) - - (template [<name> <keyword> <pre>] - [(def: .public (<name> value) - (-> (Expression Any) (Statement Any)) - (:abstraction - (format <keyword> (<pre> (:representation value)))))] - - [raise "raise " |>] - [return "return " |>] - [print "print" ..expression] - ) - - (def: .public (exec code globals) - (-> (Expression Any) (Maybe (Expression Any)) (Statement Any)) - (let [extra (case globals - {#.Some globals} - (.list globals) - - #.None - (.list))] + (format (:representation func) + (format "(" (|> args + (list\each (function (_ arg) (format (:representation arg) ", "))) + text.together) + (<splat> extra) ")"))))] + + [apply_poly splat_poly] + [apply_keyword splat_keyword] + ) + + (def: .public (the name object) + (-> Text (Expression Any) (Computation Any)) + (:abstraction (format (:representation object) "." name))) + + (def: .public (do method args object) + (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) + (..apply/* (..the method object) args)) + + (template [<name> <apply>] + [(def: .public (<name> args extra method) + (-> (List (Expression Any)) (Expression Any) Text + (-> (Expression Any) (Computation Any))) + (|>> (..the method) (<apply> args extra)))] + + [do_poly apply_poly] + [do_keyword apply_keyword] + ) + + (def: .public (item idx array) + (-> (Expression Any) (Expression Any) Location) + (:abstraction (format (:representation array) "[" (:representation idx) "]"))) + + (def: .public (? test then else) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (<| :abstraction + ..expression + (format (:representation then) " if " (:representation test) " else " (:representation else)))) + + (template [<name> <op>] + [(def: .public (<name> param subject) + (-> (Expression Any) (Expression Any) (Computation Any)) + (<| :abstraction + ..expression + (format (:representation subject) " " <op> " " (:representation param))))] + + [is "is"] + [= "=="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [// "//"] + [% "%"] + [** "**"] + [bit_or "|"] + [bit_and "&"] + [bit_xor "^"] + [bit_shl "<<"] + [bit_shr ">>"] + + [or "or"] + [and "and"] + ) + + (template [<name> <unary>] + [(def: .public (<name> subject) + (-> (Expression Any) (Computation Any)) + (<| :abstraction + ... ..expression + (format <unary> " " (:representation subject))))] + + [not "not"] + [opposite "-"] + ) + + (def: .public (lambda arguments body) + (-> (List (Var Any)) (Expression Any) (Computation Any)) + (<| :abstraction + ..expression + (format "lambda " (|> arguments (list\each ..code) (text.interposed ", ")) ": " + (:representation body)))) + + (def: .public (set vars value) + (-> (List (Location Any)) (Expression Any) (Statement Any)) + (:abstraction + (format (|> vars (list\each ..code) (text.interposed ", ")) + " = " + (:representation value)))) + + (def: .public (delete where) + (-> (Location Any) (Statement Any)) + (:abstraction (format "del " (:representation where)))) + + (def: .public (if test then! else!) + (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any)) + (:abstraction + (format "if " (:representation test) ":" + (..nested (:representation then!)) + text.new_line "else:" + (..nested (:representation else!))))) + + (def: .public (when test then!) + (-> (Expression Any) (Statement Any) (Statement Any)) + (:abstraction + (format "if " (:representation test) ":" + (..nested (:representation then!))))) + + (def: .public (then pre! post!) + (-> (Statement Any) (Statement Any) (Statement Any)) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (template [<keyword> <0>] + [(def: .public <0> + (Statement Any) + (:abstraction <keyword>))] + + ["break" break] + ["continue" continue] + ) + + (def: .public (while test body! else!) + (-> (Expression Any) (Statement Any) (Maybe (Statement Any)) Loop) + (:abstraction + (format "while " (:representation test) ":" + (..nested (:representation body!)) + (case else! + {#.Some else!} + (format text.new_line "else:" + (..nested (:representation else!))) + + #.None + "")))) + + (def: .public (for_in var inputs body!) + (-> SVar (Expression Any) (Statement Any) Loop) + (:abstraction + (format "for " (:representation var) " in " (:representation inputs) ":" + (..nested (:representation body!))))) + + (def: .public statement + (-> (Expression Any) (Statement Any)) + (|>> :transmutation)) + + (def: .public pass + (Statement Any) + (:abstraction "pass")) + + (type: .public Except + (Record + [#classes (List SVar) + #exception SVar + #handler (Statement Any)])) + + (def: .public (try body! excepts) + (-> (Statement Any) (List Except) (Statement Any)) + (:abstraction + (format "try:" + (..nested (:representation body!)) + (|> excepts + (list\each (function (_ [classes exception catch!]) + (format text.new_line "except (" (text.interposed ", " (list\each ..code classes)) + ") as " (:representation exception) ":" + (..nested (:representation catch!))))) + text.together)))) + + (template [<name> <keyword> <pre>] + [(def: .public (<name> value) + (-> (Expression Any) (Statement Any)) (:abstraction - (format "exec" (:representation (..tuple (list& code extra))))))) - - (def: .public (def name args body) - (-> SVar (List (Ex (_ k) (Var k))) (Statement Any) (Statement Any)) - (:abstraction - (format "def " (:representation name) - "(" (|> args (list\each ..code) (text.interposed ", ")) "):" - (..nested (:representation body))))) - - (def: .public (import module_name) - (-> Text (Statement Any)) - (:abstraction (format "import " module_name))) - - (def: .public (comment commentary on) - (All (_ brand) (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..safe commentary) text.new_line - (:representation on))))] + (format <keyword> (<pre> (:representation value)))))] + + [raise "raise " |>] + [return "return " |>] + [print "print" ..expression] + ) + + (def: .public (exec code globals) + (-> (Expression Any) (Maybe (Expression Any)) (Statement Any)) + (let [extra (case globals + {#.Some globals} + (.list globals) + + #.None + (.list))] + (:abstraction + (format "exec" (:representation (..tuple (list& code extra))))))) + + (def: .public (def name args body) + (-> SVar (List (Ex (_ k) (Var k))) (Statement Any) (Statement Any)) + (:abstraction + (format "def " (:representation name) + "(" (|> args (list\each ..code) (text.interposed ", ")) "):" + (..nested (:representation body))))) + + (def: .public (import module_name) + (-> Text (Statement Any)) + (:abstraction (format "import " module_name))) + + (def: .public (comment commentary on) + (All (_ brand) (-> Text (Code brand) (Code brand))) + (:abstraction (format "# " (..safe commentary) text.new_line + (:representation on)))) ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index 323b8c4bb..4de9c2966 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -25,362 +25,362 @@ (abstract: .public (Code kind) Text - [(template [<type> <super>+] - [(with_expansions [<kind> (template.identifier [<type> "'"])] - (abstract: .public (<kind> kind) Any []) - (`` (type: .public <type> (|> Any <kind> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<kind> (template.identifier [<type> "'"])] - (abstract: .public (<kind> kind) Any []) - (`` (type: .public (<type> <brand>) (|> <brand> <kind> (~~ (template.spliced <super>+))))))] - - [Var [Expression' Code]] - ) - - (template [<var> <kind>] - [(abstract: .public <kind> Any []) - (type: .public <var> (Var <kind>))] - - [SVar Single] - [PVar Poly] - ) - - (def: .public var - (-> Text SVar) - (|>> :abstraction)) - - (def: .public var_args - PVar - (:abstraction "...")) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (def: (self_contained code) - (-> Text Expression) - (:abstraction - (format "(" code ")"))) - - (def: nested_new_line - (format text.new_line text.tab)) - - (def: nested - (-> Text Text) - (|>> (text.replaced text.new_line ..nested_new_line) - (format ..nested_new_line))) - - (def: (_block expression) - (-> Text Text) - (format "{" (nested expression) text.new_line "}")) - - (def: .public (block expression) - (-> Expression Expression) - (:abstraction - (format "{" - (..nested (:representation expression)) - text.new_line "}"))) - - (template [<name> <r>] - [(def: .public <name> - Expression - (:abstraction <r>))] - - [null "NULL"] - [n/a "NA"] - ) - - (template [<name>] - [(def: .public <name> Expression n/a)] - - [not_available] - [not_applicable] - [no_answer] - ) - - (def: .public bool - (-> Bit Expression) - (|>> (case> #0 "FALSE" - #1 "TRUE") - :abstraction)) - - (def: .public int - (-> Int Expression) - (|>> %.int :abstraction)) - - (def: .public float - (-> Frac Expression) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "1.0/0.0" [])] - - [(f.= f.negative_infinity)] - [(new> "-1.0/0.0" [])] - - [(f.= f.not_a_number)] - [(new> "0.0/0.0" [])] - - ... else - [%.frac]) - ..self_contained)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - ["|" "\|"] - [text.alarm "\a"] - [text.back_space "\b"] - [text.tab "\t"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Expression) - (|>> ..safe %.text :abstraction)) - - (def: .public (slice from to list) - (-> Expression Expression Expression Expression) - (..self_contained - (format (:representation list) - "[" (:representation from) ":" (:representation to) "]"))) - - (def: .public (slice_from from list) - (-> Expression Expression Expression) - (..self_contained - (format (:representation list) - "[-1" ":-" (:representation from) "]"))) - - (def: .public (apply args func) - (-> (List Expression) Expression Expression) - (let [func (:representation func) - spacing (|> " " - (list.repeated (text.size func)) - text.together)] - (:abstraction - (format func "(" - (|> args - (list\each ..code) - (text.interposed (format "," text.new_line)) - ..nested) - ")")))) - - (template [<name> <function>] - [(def: .public (<name> members) - (-> (List Expression) Expression) - (..apply members (..var <function>)))] - - [vector "c"] - [list "list"] - ) - - (def: .public named_list - (-> (List [Text Expression]) Expression) - (|>> (list\each (.function (_ [key value]) - (:abstraction (format key "=" (:representation value))))) - ..list)) - - (def: .public (apply_kw args kw_args func) - (-> (List Expression) (List [Text Expression]) Expression Expression) - (..self_contained - (format (:representation func) - (format "(" - (text.interposed "," (list\each ..code args)) "," - (text.interposed "," (list\each (.function (_ [key val]) - (format key "=" (:representation val))) - kw_args)) - ")")))) - - (syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> arity - list.indices - (list\each (|>> %.nat code.local_identifier)))))) - - (syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) - - (template [<arity> <function>+] - [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) - <inputs> (arity_inputs <arity>) - <types> (arity_types <arity>) - <definitions> (template.spliced <function>+)] - (def: .public (<apply> function [<inputs>]) - (-> Expression [<types>] Expression) - (..apply (.list <inputs>) function)) - - (template [<function>] - [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) - (-> [<types>] Expression) - (<apply> (..var <function>))))] - - <definitions>))] - - [0 - [["commandArgs"]]] - [1 - [["intToUtf8"]]] - [2 - [["paste"]]] - ) - - (def: .public as::integer - (-> Expression Expression) - (..apply/1 (..var "as.integer"))) - - (def: .public (item idx list) - (-> Expression Expression Expression) - (..self_contained - (format (:representation list) "[[" (:representation idx) "]]"))) - - (def: .public (if test then else) - (-> Expression Expression Expression Expression) - (:abstraction - (format "if(" (:representation test) ")" - " " (.._block (:representation then)) - " else " (.._block (:representation else))))) - - (def: .public (when test then) - (-> Expression Expression Expression) - (:abstraction - (format "if(" (:representation test) ") {" - (.._block (:representation then)) - text.new_line "}"))) - - (def: .public (cond clauses else) - (-> (List [Expression Expression]) Expression Expression) - (list\mix (.function (_ [test then] next) - (if test then next)) - else - (list.reversed clauses))) - - (template [<name> <op>] - [(def: .public (<name> param subject) - (-> Expression Expression Expression) - (..self_contained - (format (:representation subject) - " " <op> " " - (:representation param))))] - - [= "=="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [%% "%%"] - [** "**"] - [or "||"] - [and "&&"] - ) - - (template [<name> <func>] - [(def: .public (<name> param subject) - (-> Expression Expression Expression) - (..apply (.list subject param) (..var <func>)))] - - [bit_or "bitwOr"] - [bit_and "bitwAnd"] - [bit_xor "bitwXor"] - [bit_shl "bitwShiftL"] - [bit_ushr "bitwShiftR"] - ) - - (def: .public (bit_not subject) - (-> Expression Expression) - (..apply (.list subject) (..var "bitwNot"))) - - (template [<name> <op>] - [(def: .public <name> - (-> Expression Expression) - (|>> :representation (format <op>) ..self_contained))] - - [not "!"] - [negate "-"] - ) - - (def: .public (length list) - (-> Expression Expression) - (..apply (.list list) (..var "length"))) - - (def: .public (range from to) - (-> Expression Expression Expression) - (..self_contained - (format (:representation from) ":" (:representation to)))) - - (def: .public (function inputs body) - (-> (List (Ex (_ k) (Var k))) Expression Expression) - (let [args (|> inputs (list\each ..code) (text.interposed ", "))] + (template [<type> <super>+] + [(with_expansions [<kind> (template.identifier [<type> "'"])] + (abstract: .public (<kind> kind) Any) + (`` (type: .public <type> (|> Any <kind> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<kind> (template.identifier [<type> "'"])] + (abstract: .public (<kind> kind) Any) + (`` (type: .public (<type> <brand>) (|> <brand> <kind> (~~ (template.spliced <super>+))))))] + + [Var [Expression' Code]] + ) + + (template [<var> <kind>] + [(abstract: .public <kind> Any) + (type: .public <var> (Var <kind>))] + + [SVar Single] + [PVar Poly] + ) + + (def: .public var + (-> Text SVar) + (|>> :abstraction)) + + (def: .public var_args + PVar + (:abstraction "...")) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (def: (self_contained code) + (-> Text Expression) + (:abstraction + (format "(" code ")"))) + + (def: nested_new_line + (format text.new_line text.tab)) + + (def: nested + (-> Text Text) + (|>> (text.replaced text.new_line ..nested_new_line) + (format ..nested_new_line))) + + (def: (_block expression) + (-> Text Text) + (format "{" (nested expression) text.new_line "}")) + + (def: .public (block expression) + (-> Expression Expression) + (:abstraction + (format "{" + (..nested (:representation expression)) + text.new_line "}"))) + + (template [<name> <r>] + [(def: .public <name> + Expression + (:abstraction <r>))] + + [null "NULL"] + [n/a "NA"] + ) + + (template [<name>] + [(def: .public <name> Expression n/a)] + + [not_available] + [not_applicable] + [no_answer] + ) + + (def: .public bool + (-> Bit Expression) + (|>> (case> #0 "FALSE" + #1 "TRUE") + :abstraction)) + + (def: .public int + (-> Int Expression) + (|>> %.int :abstraction)) + + (def: .public float + (-> Frac Expression) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "1.0/0.0" [])] + + [(f.= f.negative_infinity)] + [(new> "-1.0/0.0" [])] + + [(f.= f.not_a_number)] + [(new> "0.0/0.0" [])] + + ... else + [%.frac]) + ..self_contained)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + ["|" "\|"] + [text.alarm "\a"] + [text.back_space "\b"] + [text.tab "\t"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Expression) + (|>> ..safe %.text :abstraction)) + + (def: .public (slice from to list) + (-> Expression Expression Expression Expression) + (..self_contained + (format (:representation list) + "[" (:representation from) ":" (:representation to) "]"))) + + (def: .public (slice_from from list) + (-> Expression Expression Expression) + (..self_contained + (format (:representation list) + "[-1" ":-" (:representation from) "]"))) + + (def: .public (apply args func) + (-> (List Expression) Expression Expression) + (let [func (:representation func) + spacing (|> " " + (list.repeated (text.size func)) + text.together)] + (:abstraction + (format func "(" + (|> args + (list\each ..code) + (text.interposed (format "," text.new_line)) + ..nested) + ")")))) + + (template [<name> <function>] + [(def: .public (<name> members) + (-> (List Expression) Expression) + (..apply members (..var <function>)))] + + [vector "c"] + [list "list"] + ) + + (def: .public named_list + (-> (List [Text Expression]) Expression) + (|>> (list\each (.function (_ [key value]) + (:abstraction (format key "=" (:representation value))))) + ..list)) + + (def: .public (apply_kw args kw_args func) + (-> (List Expression) (List [Text Expression]) Expression Expression) + (..self_contained + (format (:representation func) + (format "(" + (text.interposed "," (list\each ..code args)) "," + (text.interposed "," (list\each (.function (_ [key val]) + (format key "=" (:representation val))) + kw_args)) + ")")))) + + (syntax: (arity_inputs [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> arity + list.indices + (list\each (|>> %.nat code.local_identifier)))))) + + (syntax: (arity_types [arity <code>.nat]) + (in (list.repeated arity (` ..Expression)))) + + (template [<arity> <function>+] + [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) + <inputs> (arity_inputs <arity>) + <types> (arity_types <arity>) + <definitions> (template.spliced <function>+)] + (def: .public (<apply> function [<inputs>]) + (-> Expression [<types>] Expression) + (..apply (.list <inputs>) function)) + + (template [<function>] + [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) + (-> [<types>] Expression) + (<apply> (..var <function>))))] + + <definitions>))] + + [0 + [["commandArgs"]]] + [1 + [["intToUtf8"]]] + [2 + [["paste"]]] + ) + + (def: .public as::integer + (-> Expression Expression) + (..apply/1 (..var "as.integer"))) + + (def: .public (item idx list) + (-> Expression Expression Expression) + (..self_contained + (format (:representation list) "[[" (:representation idx) "]]"))) + + (def: .public (if test then else) + (-> Expression Expression Expression Expression) + (:abstraction + (format "if(" (:representation test) ")" + " " (.._block (:representation then)) + " else " (.._block (:representation else))))) + + (def: .public (when test then) + (-> Expression Expression Expression) + (:abstraction + (format "if(" (:representation test) ") {" + (.._block (:representation then)) + text.new_line "}"))) + + (def: .public (cond clauses else) + (-> (List [Expression Expression]) Expression Expression) + (list\mix (.function (_ [test then] next) + (if test then next)) + else + (list.reversed clauses))) + + (template [<name> <op>] + [(def: .public (<name> param subject) + (-> Expression Expression Expression) (..self_contained - (format "function(" args ") " - (.._block (:representation body)))))) - - (def: .public (try body warning error finally) - (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression) - (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text) - (.function (_ parameter value preparation) - (|> value - (maybe\each (|>> :representation preparation (format ", " parameter " = "))) - (maybe.else ""))))] - (..self_contained - (format "tryCatch(" - (.._block (:representation body)) - (optional "warning" warning function.identity) - (optional "error" error function.identity) - (optional "finally" finally .._block) - ")")))) - - (def: .public (while test body) - (-> Expression Expression Expression) - (..self_contained - (format "while (" (:representation test) ") " - (.._block (:representation body))))) - - (def: .public (for_in var inputs body) - (-> SVar Expression Expression Expression) - (..self_contained - (format "for (" (:representation var) " in " (:representation inputs) ")" - (.._block (:representation body))))) - - (template [<name> <keyword>] - [(def: .public (<name> message) - (-> Expression Expression) - (..apply (.list message) (..var <keyword>)))] - - [stop "stop"] - [print "print"] - ) - - (def: .public (set! var value) - (-> SVar Expression Expression) - (..self_contained - (format (:representation var) " <- " (:representation value)))) - - (def: .public (set_item! idx value list) - (-> Expression Expression SVar Expression) - (..self_contained - (format (:representation list) "[[" (:representation idx) "]] <- " (:representation value)))) - - (def: .public (then pre post) - (-> Expression Expression Expression) - (:abstraction - (format (:representation pre) - text.new_line - (:representation post))))] + (format (:representation subject) + " " <op> " " + (:representation param))))] + + [= "=="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [%% "%%"] + [** "**"] + [or "||"] + [and "&&"] + ) + + (template [<name> <func>] + [(def: .public (<name> param subject) + (-> Expression Expression Expression) + (..apply (.list subject param) (..var <func>)))] + + [bit_or "bitwOr"] + [bit_and "bitwAnd"] + [bit_xor "bitwXor"] + [bit_shl "bitwShiftL"] + [bit_ushr "bitwShiftR"] + ) + + (def: .public (bit_not subject) + (-> Expression Expression) + (..apply (.list subject) (..var "bitwNot"))) + + (template [<name> <op>] + [(def: .public <name> + (-> Expression Expression) + (|>> :representation (format <op>) ..self_contained))] + + [not "!"] + [negate "-"] + ) + + (def: .public (length list) + (-> Expression Expression) + (..apply (.list list) (..var "length"))) + + (def: .public (range from to) + (-> Expression Expression Expression) + (..self_contained + (format (:representation from) ":" (:representation to)))) + + (def: .public (function inputs body) + (-> (List (Ex (_ k) (Var k))) Expression Expression) + (let [args (|> inputs (list\each ..code) (text.interposed ", "))] + (..self_contained + (format "function(" args ") " + (.._block (:representation body)))))) + + (def: .public (try body warning error finally) + (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression) + (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text) + (.function (_ parameter value preparation) + (|> value + (maybe\each (|>> :representation preparation (format ", " parameter " = "))) + (maybe.else ""))))] + (..self_contained + (format "tryCatch(" + (.._block (:representation body)) + (optional "warning" warning function.identity) + (optional "error" error function.identity) + (optional "finally" finally .._block) + ")")))) + + (def: .public (while test body) + (-> Expression Expression Expression) + (..self_contained + (format "while (" (:representation test) ") " + (.._block (:representation body))))) + + (def: .public (for_in var inputs body) + (-> SVar Expression Expression Expression) + (..self_contained + (format "for (" (:representation var) " in " (:representation inputs) ")" + (.._block (:representation body))))) + + (template [<name> <keyword>] + [(def: .public (<name> message) + (-> Expression Expression) + (..apply (.list message) (..var <keyword>)))] + + [stop "stop"] + [print "print"] + ) + + (def: .public (set! var value) + (-> SVar Expression Expression) + (..self_contained + (format (:representation var) " <- " (:representation value)))) + + (def: .public (set_item! idx value list) + (-> Expression Expression SVar Expression) + (..self_contained + (format (:representation list) "[[" (:representation idx) "]] <- " (:representation value)))) + + (def: .public (then pre post) + (-> Expression Expression Expression) + (:abstraction + (format (:representation pre) + text.new_line + (:representation post)))) ) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 85a3c92c3..f4f967335 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -38,387 +38,387 @@ (abstract: .public (Code brand) Text - [(implementation: .public code_equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public code_hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..code_equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) Any []) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Var [Location' Computation' Expression' Code]] - [LVar [Var' Location' Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: <brand> Any []) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Literal [Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [GVar [Var' Location' Computation' Expression' Code]] - [IVar [Var' Location' Computation' Expression' Code]] - [SVar [Var' Location' Computation' Expression' Code]] - [LVar* [LVar' Var' Location' Computation' Expression' Code]] - [LVar** [LVar' Var' Location' Computation' Expression' Code]] - ) - - (template [<var> <prefix> <constructor>] - [(def: .public <constructor> - (-> Text <var>) - (|>> (format <prefix>) :abstraction))] - - [GVar "$" global] - [IVar "@" instance] - [SVar "@@" static] - ) - - (def: .public local - (-> Text LVar) - (|>> :abstraction)) - - (template [<var> <prefix> <modifier> <unpacker>] - [(template [<name> <input> <output>] - [(def: .public <name> - (-> <input> <output>) - (|>> :representation (format <prefix>) :abstraction))] - - [<modifier> LVar <var>] - [<unpacker> Expression Computation] - )] - - [LVar* "*" variadic splat] - [LVar** "**" variadic_kv double_splat] - ) - - (template [<ruby_name> <lux_name>] - [(def: .public <lux_name> - (..global <ruby_name>))] - - ["@" latest_error] - ["_" last_string_read] - ["." last_line_number_read] - ["&" last_string_matched] - ["~" last_regexp_match] - ["=" case_insensitivity_flag] - ["/" input_record_separator] - ["\" output_record_separator] - ["0" script_name] - ["$" process_id] - ["?" exit_status] - ) - - (template [<ruby_name> <lux_name>] - [(def: .public <lux_name> - (..local <ruby_name>))] - - ["ARGV" command_line_arguments] - ) - - (def: .public nil - Literal - (:abstraction "nil")) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "false" - #1 "true") - :abstraction)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (template [<format> <name> <type> <prep>] - [(def: .public <name> - (-> <type> Literal) - (|>> <prep> <format> :abstraction))] - - [%.int int Int (<|)] - [%.text string Text ..safe] - [(<|) symbol Text (format ":")] - ) - - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "(+1.0/0.0)" [])] - - [(f.= f.negative_infinity)] - [(new> "(-1.0/0.0)" [])] - - [(f.= f.not_a_number)] - [(new> "(+0.0/-0.0)" [])] - - ... else - [%.frac]) - :abstraction)) - - (def: .public (array_range from to array) - (-> Expression Expression Expression Computation) - (|> (format (:representation from) ".." (:representation to)) - (text.enclosed ["[" "]"]) - (format (:representation array)) + (implementation: .public code_equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public code_hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..code_equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [LVar [Var' Location' Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: <brand> Any) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [GVar [Var' Location' Computation' Expression' Code]] + [IVar [Var' Location' Computation' Expression' Code]] + [SVar [Var' Location' Computation' Expression' Code]] + [LVar* [LVar' Var' Location' Computation' Expression' Code]] + [LVar** [LVar' Var' Location' Computation' Expression' Code]] + ) + + (template [<var> <prefix> <constructor>] + [(def: .public <constructor> + (-> Text <var>) + (|>> (format <prefix>) :abstraction))] + + [GVar "$" global] + [IVar "@" instance] + [SVar "@@" static] + ) + + (def: .public local + (-> Text LVar) + (|>> :abstraction)) + + (template [<var> <prefix> <modifier> <unpacker>] + [(template [<name> <input> <output>] + [(def: .public <name> + (-> <input> <output>) + (|>> :representation (format <prefix>) :abstraction))] + + [<modifier> LVar <var>] + [<unpacker> Expression Computation] + )] + + [LVar* "*" variadic splat] + [LVar** "**" variadic_kv double_splat] + ) + + (template [<ruby_name> <lux_name>] + [(def: .public <lux_name> + (..global <ruby_name>))] + + ["@" latest_error] + ["_" last_string_read] + ["." last_line_number_read] + ["&" last_string_matched] + ["~" last_regexp_match] + ["=" case_insensitivity_flag] + ["/" input_record_separator] + ["\" output_record_separator] + ["0" script_name] + ["$" process_id] + ["?" exit_status] + ) + + (template [<ruby_name> <lux_name>] + [(def: .public <lux_name> + (..local <ruby_name>))] + + ["ARGV" command_line_arguments] + ) + + (def: .public nil + Literal + (:abstraction "nil")) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") :abstraction)) - (def: .public array - (-> (List Expression) Literal) - (|>> (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed ["[" "]"]) - :abstraction)) - - (def: .public hash - (-> (List [Expression Expression]) Literal) - (|>> (list\each (.function (_ [k v]) - (format (:representation k) " => " (:representation v)))) - (text.interposed ..input_separator) - (text.enclosed ["{" "}"]) - :abstraction)) - - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (|> args - (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed ["(" ")"]) - (format (:representation func)) + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (template [<format> <name> <type> <prep>] + [(def: .public <name> + (-> <type> Literal) + (|>> <prep> <format> :abstraction))] + + [%.int int Int (<|)] + [%.text string Text ..safe] + [(<|) symbol Text (format ":")] + ) + + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "(+1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(new> "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(new> "(+0.0/-0.0)" [])] + + ... else + [%.frac]) :abstraction)) - (def: .public (apply_lambda/* args lambda) - (-> (List Expression) Expression Computation) - (|> args - (list\each (|>> :representation)) + (def: .public (array_range from to array) + (-> Expression Expression Expression Computation) + (|> (format (:representation from) ".." (:representation to)) + (text.enclosed ["[" "]"]) + (format (:representation array)) + :abstraction)) + + (def: .public array + (-> (List Expression) Literal) + (|>> (list\each (|>> :representation)) (text.interposed ..input_separator) (text.enclosed ["[" "]"]) - (format (:representation lambda)) :abstraction)) - (def: .public (the field object) - (-> Text Expression Access) - (:abstraction (format (:representation object) "." field))) - - (def: .public (item idx array) - (-> Expression Expression Access) - (|> (:representation idx) - (text.enclosed ["[" "]"]) - (format (:representation array)) + (def: .public hash + (-> (List [Expression Expression]) Literal) + (|>> (list\each (.function (_ [k v]) + (format (:representation k) " => " (:representation v)))) + (text.interposed ..input_separator) + (text.enclosed ["{" "}"]) :abstraction)) - (def: .public (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (:representation test) " ? " - (:representation then) " : " - (:representation else)) - (text.enclosed ["(" ")"]) + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (|> args + (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed ["(" ")"]) + (format (:representation func)) + :abstraction)) + + (def: .public (apply_lambda/* args lambda) + (-> (List Expression) Expression Computation) + (|> args + (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed ["[" "]"]) + (format (:representation lambda)) + :abstraction)) + + (def: .public (the field object) + (-> Text Expression Access) + (:abstraction (format (:representation object) "." field))) + + (def: .public (item idx array) + (-> Expression Expression Access) + (|> (:representation idx) + (text.enclosed ["[" "]"]) + (format (:representation array)) + :abstraction)) + + (def: .public (? test then else) + (-> Expression Expression Expression Computation) + (|> (format (:representation test) " ? " + (:representation then) " : " + (:representation else)) + (text.enclosed ["(" ")"]) + :abstraction)) + + (def: .public statement + (-> Expression Statement) + (|>> :representation + (text.suffix ..statement_suffix) :abstraction)) - (def: .public statement - (-> Expression Statement) - (|>> :representation - (text.suffix ..statement_suffix) - :abstraction)) - - (def: .public (then pre! post!) - (-> Statement Statement Statement) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (def: .public (set vars value) - (-> (List Location) Expression Statement) - (:abstraction - (format (|> vars - (list\each (|>> :representation)) - (text.interposed ..input_separator)) - " = " (:representation value) ..statement_suffix))) - - (def: (block content) - (-> Text Text) - (format content - text.new_line "end" ..statement_suffix)) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (<| :abstraction - ..block - (format "if " (:representation test) - (..nested (:representation then!)) - text.new_line "else" - (..nested (:representation else!))))) - - (template [<name> <block>] - [(def: .public (<name> test then!) - (-> Expression Statement Statement) - (<| :abstraction - ..block - (format <block> " " (:representation test) - (..nested (:representation then!)))))] - - [when "if"] - [while "while"] - ) - - (def: .public (for_in var array iteration!) - (-> LVar Expression Statement Statement) - (<| :abstraction - ..block - (format "for " (:representation var) - " in " (:representation array) - " do " - (..nested (:representation iteration!))))) - - (type: .public Rescue - (Record - [#classes (List Text) - #exception LVar - #rescue Statement])) - - (def: .public (begin body! rescues) - (-> Statement (List Rescue) Statement) - (<| :abstraction - ..block - (format "begin" (..nested (:representation body!)) - (|> rescues - (list\each (.function (_ [classes exception rescue]) - (format text.new_line "rescue " (text.interposed ..input_separator classes) - " => " (:representation exception) - (..nested (:representation rescue))))) - (text.interposed text.new_line))))) - - (def: .public (catch expectation body!) - (-> Expression Statement Statement) - (<| :abstraction - ..block - (format "catch(" (:representation expectation) ") do" - (..nested (:representation body!))))) - - (def: .public (return value) - (-> Expression Statement) - (:abstraction (format "return " (:representation value) ..statement_suffix))) - - (def: .public (raise message) - (-> Expression Computation) - (:abstraction (format "raise " (:representation message)))) - - (template [<name> <keyword>] - [(def: .public <name> - Statement - (|> <keyword> - (text.suffix ..statement_suffix) - :abstraction))] - - [next "next"] - [redo "redo"] - [break "break"] - ) - - (def: .public (function name args body!) - (-> LVar (List LVar) Statement Statement) - (<| :abstraction - ..block - (format "def " (:representation name) - (|> args - (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed ["(" ")"])) - (..nested (:representation body!))))) - - (def: .public (lambda name args body!) - (-> (Maybe LVar) (List Var) Statement Literal) - (let [proc (|> (format (|> args - (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed' "|")) - (..nested (:representation body!))) - (text.enclosed ["{" "}"]) - (format "lambda "))] - (|> (case name - #.None - proc - - {#.Some name} - (format (:representation name) " = " proc)) - (text.enclosed ["(" ")"]) - :abstraction))) - - (template [<op> <name>] - [(def: .public (<name> parameter subject) - (-> Expression Expression Computation) - (:abstraction (format "(" (:representation subject) " " <op> " " (:representation parameter) ")")))] - - ["==" =] - [ "<" <] - ["<=" <=] - [ ">" >] - [">=" >=] - - [ "+" +] - [ "-" -] - [ "*" *] - [ "/" /] - [ "%" %] - ["**" pow] - - ["||" or] - ["&&" and] - [ "|" bit_or] - [ "&" bit_and] - [ "^" bit_xor] - - ["<<" bit_shl] - [">>" bit_shr] - ) - - (template [<unary> <name>] - [(def: .public (<name> subject) - (-> Expression Computation) - (:abstraction (format "(" <unary> (:representation subject) ")")))] - - ["!" not] - ["-" opposite] - ) - - (def: .public (comment commentary on) - (All (_ brand) (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..safe commentary) text.new_line - (:representation on))))] + (def: .public (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (def: .public (set vars value) + (-> (List Location) Expression Statement) + (:abstraction + (format (|> vars + (list\each (|>> :representation)) + (text.interposed ..input_separator)) + " = " (:representation value) ..statement_suffix))) + + (def: (block content) + (-> Text Text) + (format content + text.new_line "end" ..statement_suffix)) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (<| :abstraction + ..block + (format "if " (:representation test) + (..nested (:representation then!)) + text.new_line "else" + (..nested (:representation else!))))) + + (template [<name> <block>] + [(def: .public (<name> test then!) + (-> Expression Statement Statement) + (<| :abstraction + ..block + (format <block> " " (:representation test) + (..nested (:representation then!)))))] + + [when "if"] + [while "while"] + ) + + (def: .public (for_in var array iteration!) + (-> LVar Expression Statement Statement) + (<| :abstraction + ..block + (format "for " (:representation var) + " in " (:representation array) + " do " + (..nested (:representation iteration!))))) + + (type: .public Rescue + (Record + [#classes (List Text) + #exception LVar + #rescue Statement])) + + (def: .public (begin body! rescues) + (-> Statement (List Rescue) Statement) + (<| :abstraction + ..block + (format "begin" (..nested (:representation body!)) + (|> rescues + (list\each (.function (_ [classes exception rescue]) + (format text.new_line "rescue " (text.interposed ..input_separator classes) + " => " (:representation exception) + (..nested (:representation rescue))))) + (text.interposed text.new_line))))) + + (def: .public (catch expectation body!) + (-> Expression Statement Statement) + (<| :abstraction + ..block + (format "catch(" (:representation expectation) ") do" + (..nested (:representation body!))))) + + (def: .public (return value) + (-> Expression Statement) + (:abstraction (format "return " (:representation value) ..statement_suffix))) + + (def: .public (raise message) + (-> Expression Computation) + (:abstraction (format "raise " (:representation message)))) + + (template [<name> <keyword>] + [(def: .public <name> + Statement + (|> <keyword> + (text.suffix ..statement_suffix) + :abstraction))] + + [next "next"] + [redo "redo"] + [break "break"] + ) + + (def: .public (function name args body!) + (-> LVar (List LVar) Statement Statement) + (<| :abstraction + ..block + (format "def " (:representation name) + (|> args + (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed ["(" ")"])) + (..nested (:representation body!))))) + + (def: .public (lambda name args body!) + (-> (Maybe LVar) (List Var) Statement Literal) + (let [proc (|> (format (|> args + (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed' "|")) + (..nested (:representation body!))) + (text.enclosed ["{" "}"]) + (format "lambda "))] + (|> (case name + #.None + proc + + {#.Some name} + (format (:representation name) " = " proc)) + (text.enclosed ["(" ")"]) + :abstraction))) + + (template [<op> <name>] + [(def: .public (<name> parameter subject) + (-> Expression Expression Computation) + (:abstraction (format "(" (:representation subject) " " <op> " " (:representation parameter) ")")))] + + ["==" =] + [ "<" <] + ["<=" <=] + [ ">" >] + [">=" >=] + + [ "+" +] + [ "-" -] + [ "*" *] + [ "/" /] + [ "%" %] + ["**" pow] + + ["||" or] + ["&&" and] + [ "|" bit_or] + [ "&" bit_and] + [ "^" bit_xor] + + ["<<" bit_shl] + [">>" bit_shr] + ) + + (template [<unary> <name>] + [(def: .public (<name> subject) + (-> Expression Computation) + (:abstraction (format "(" <unary> (:representation subject) ")")))] + + ["!" not] + ["-" opposite] + ) + + (def: .public (comment commentary on) + (All (_ brand) (-> Text (Code brand) (Code brand))) + (:abstraction (format "# " (..safe commentary) text.new_line + (:representation on)))) ) (def: .public (do method args object) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index 390a43867..692e903bc 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -29,353 +29,353 @@ (abstract: .public (Code k) Text - [(implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (template [<type> <brand> <super>+] - [(abstract: .public (<brand> brand) Any []) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+)))))] - - [Expression Expression' [Code]] - ) - - (template [<type> <brand> <super>+] - [(abstract: .public <brand> Any []) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+)))))] - - [Var Var' [Expression' Code]] - [Computation Computation' [Expression' Code]] - ) - - (type: .public Arguments - (Record - [#mandatory (List Var) - #rest (Maybe Var)])) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (def: .public var - (-> Text Var) - (|>> :abstraction)) - - (def: (arguments [mandatory rest]) - (-> Arguments (Code Any)) - (case rest - {#.Some rest} - (case mandatory - #.End - rest - - _ - (|> (format " . " (:representation rest)) - (format (|> mandatory - (list\each ..code) - (text.interposed " "))) - (text.enclosed ["(" ")"]) - :abstraction)) - - #.None - (|> mandatory - (list\each ..code) - (text.interposed " ") - (text.enclosed ["(" ")"]) - :abstraction))) - - (def: .public nil - Computation - (:abstraction "'()")) - - (def: .public bool - (-> Bit Computation) - (|>> (case> #0 "#f" - #1 "#t") - :abstraction)) - - (def: .public int - (-> Int Computation) - (|>> %.int :abstraction)) - - (def: .public float - (-> Frac Computation) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "+inf.0" [])] - - [(f.= f.negative_infinity)] - [(new> "-inf.0" [])] - - [f.not_a_number?] - [(new> "+nan.0" [])] - - ... else - [%.frac]) - :abstraction)) - - (def: .public positive_infinity Computation (..float f.positive_infinity)) - (def: .public negative_infinity Computation (..float f.negative_infinity)) - (def: .public not_a_number Computation (..float f.not_a_number)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - ["|" "\|"] - [text.alarm "\a"] - [text.back_space "\b"] - [text.tab "\t"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Computation) - (|>> ..safe %.text :abstraction)) - - (def: .public symbol - (-> Text Computation) - (|>> (format "'") :abstraction)) - - (def: form - (-> (List (Code Any)) Code) - (.let [nested_new_line (format text.new_line text.tab)] - (|>> (case> #.End - (:abstraction "()") - - {#.Item head tail} - (|> tail - (list\each (|>> :representation ..nested)) - {#.Item (:representation head)} - (text.interposed nested_new_line) - (text.enclosed ["(" ")"]) - :abstraction))))) - - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (..form {#.Item func args})) - - (template [<name> <function>] - [(def: .public (<name> members) - (-> (List Expression) Computation) - (..apply/* members (..var <function>)))] - - [vector/* "vector"] - [list/* "list"] - ) - - (def: .public apply/0 - (-> Expression Computation) - (..apply/* (list))) - - (template [<lux_name> <scheme_name>] - [(def: .public <lux_name> - (apply/0 (..var <scheme_name>)))] - - [newline/0 "newline"] - ) - - (template [<apply> <arg>+ <type>+ <function>+] - [(`` (def: .public (<apply> procedure) - (-> Expression (~~ (template.spliced <type>+)) Computation) - (function (_ (~~ (template.spliced <arg>+))) - (..apply/* (list (~~ (template.spliced <arg>+))) procedure)))) - - (`` (template [<definition> <function>] - [(def: .public <definition> (<apply> (..var <function>)))] - - (~~ (template.spliced <function>+))))] - - [apply/1 [_0] [Expression] - [[exact/1 "exact"] - [integer->char/1 "integer->char"] - [char->integer/1 "char->integer"] - [number->string/1 "number->string"] - [string->number/1 "string->number"] - [floor/1 "floor"] - [truncate/1 "truncate"] - [string/1 "string"] - [string?/1 "string?"] - [length/1 "length"] - [values/1 "values"] - [null?/1 "null?"] - [car/1 "car"] - [cdr/1 "cdr"] - [raise/1 "raise"] - [error_object_message/1 "error-object-message"] - [make_vector/1 "make-vector"] - [vector_length/1 "vector-length"] - [not/1 "not"] - [string_hash/1 "string-hash"] - [reverse/1 "reverse"] - [display/1 "display"] - [exit/1 "exit"] - [string_length/1 "string-length"] - [load_relative/1 "load-relative"]]] - - [apply/2 [_0 _1] [Expression Expression] - [[append/2 "append"] - [cons/2 "cons"] - [make_vector/2 "make-vector"] - ... [vector_ref/2 "vector-ref"] - [list_tail/2 "list-tail"] - [map/2 "map"] - [string_ref/2 "string-ref"] - [string_append/2 "string-append"] - [make_string/2 "make-string"]]] - - [apply/3 [_0 _1 _2] [Expression Expression Expression] - [[substring/3 "substring"] - [vector_set!/3 "vector-set!"] - [string_contains/3 "string-contains"]]] - - [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression] - [[vector_copy!/5 "vector-copy!"]]] - ) - - ... TODO: define "vector_ref/2" like a normal apply/2 function. - ... "vector_ref/2" as an 'invoke' is problematic, since it only works - ... in Kawa. - ... However, the way Kawa defines "vector-ref" causes trouble, - ... because it does a runtime type-check which throws an error when - ... it checks against custom values/objects/classes made for - ... JVM<->Scheme interop. - ... There are 2 ways to deal with this: - ... 0. To fork Kawa, and get rid of the type-check so the normal - ... "vector-ref" can be used instead. - ... 1. To carry on, and then, when it's time to compile the compiler - ... itself into Scheme, switch from 'invoke' to normal 'vector-ref'. - ... Either way, the 'invoke' needs to go away. - (def: .public (vector_ref/2 vector index) - (-> Expression Expression Computation) - (..form (list (..var "invoke") vector (..symbol "getRaw") index))) - - (template [<lux_name> <scheme_name>] - [(def: .public (<lux_name> param subject) - (-> Expression Expression Computation) - (..apply/2 (..var <scheme_name>) subject param))] - - [=/2 "="] - [eq?/2 "eq?"] - [eqv?/2 "eqv?"] - [</2 "<"] - [<=/2 "<="] - [>/2 ">"] - [>=/2 ">="] - [string=?/2 "string=?"] - [string<?/2 "string<?"] - [+/2 "+"] - [-/2 "-"] - [//2 "/"] - [*/2 "*"] - [expt/2 "expt"] - [remainder/2 "remainder"] - [quotient/2 "quotient"] - [mod/2 "mod"] - [arithmetic_shift/2 "arithmetic-shift"] - [bitwise_and/2 "bitwise-and"] - [bitwise_ior/2 "bitwise-ior"] - [bitwise_xor/2 "bitwise-xor"] - ) - - (template [<lux_name> <scheme_name>] - [(def: .public <lux_name> - (-> (List Expression) Computation) - (|>> (list& (..var <scheme_name>)) ..form))] - - [or "or"] - [and "and"] - ) - - (template [<lux_name> <scheme_name> <var> <pre>] - [(def: .public (<lux_name> bindings body) - (-> (List [<var> Expression]) Expression Computation) - (..form (list (..var <scheme_name>) - (|> bindings - (list\each (function (_ [binding/name binding/value]) - (..form (list (|> binding/name <pre>) - binding/value)))) - ..form) - body)))] - - [let "let" Var (<|)] - [let* "let*" Var (<|)] - [letrec "letrec" Var (<|)] - [let_values "let-values" Arguments ..arguments] - [let*_values "let*-values" Arguments ..arguments] - [letrec_values "letrec-values" Arguments ..arguments] - ) - - (def: .public (if test then else) - (-> Expression Expression Expression Computation) - (..form (list (..var "if") test then else))) - - (def: .public (when test then) - (-> Expression Expression Computation) - (..form (list (..var "when") test then))) - - (def: .public (lambda arguments body) - (-> Arguments Expression Computation) - (..form (list (..var "lambda") - (..arguments arguments) - body))) - - (def: .public (define_function name arguments body) - (-> Var Arguments Expression Computation) - (..form (list (..var "define") - (|> arguments - (revised@ #mandatory (|>> {#.Item name})) - ..arguments) - body))) - - (def: .public (define_constant name value) - (-> Var Expression Computation) - (..form (list (..var "define") name value))) - - (def: .public begin - (-> (List Expression) Computation) - (|>> {#.Item (..var "begin")} ..form)) - - (def: .public (set! name value) - (-> Var Expression Computation) - (..form (list (..var "set!") name value))) - - (def: .public (with_exception_handler handler body) - (-> Expression Expression Computation) - (..form (list (..var "with-exception-handler") handler body))) - - (def: .public (call_with_current_continuation body) - (-> Expression Computation) - (..form (list (..var "call-with-current-continuation") body))) - - (def: .public (guard variable clauses else body) - (-> Var (List [Expression Expression]) (Maybe Expression) Expression Computation) - (..form (list (..var "guard") - (..form (|> (case else - #.None - (list) - - {#.Some else} - (list (..form (list (..var "else") else)))) - (list\composite (list\each (function (_ [when then]) - (..form (list when then))) - clauses)) - (list& variable))) - body)))] + (implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (template [<type> <brand> <super>+] + [(abstract: .public (<brand> brand) Any) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+)))))] + + [Expression Expression' [Code]] + ) + + (template [<type> <brand> <super>+] + [(abstract: .public <brand> Any) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+)))))] + + [Var Var' [Expression' Code]] + [Computation Computation' [Expression' Code]] + ) + + (type: .public Arguments + (Record + [#mandatory (List Var) + #rest (Maybe Var)])) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (def: .public var + (-> Text Var) + (|>> :abstraction)) + + (def: (arguments [mandatory rest]) + (-> Arguments (Code Any)) + (case rest + {#.Some rest} + (case mandatory + #.End + rest + + _ + (|> (format " . " (:representation rest)) + (format (|> mandatory + (list\each ..code) + (text.interposed " "))) + (text.enclosed ["(" ")"]) + :abstraction)) + + #.None + (|> mandatory + (list\each ..code) + (text.interposed " ") + (text.enclosed ["(" ")"]) + :abstraction))) + + (def: .public nil + Computation + (:abstraction "'()")) + + (def: .public bool + (-> Bit Computation) + (|>> (case> #0 "#f" + #1 "#t") + :abstraction)) + + (def: .public int + (-> Int Computation) + (|>> %.int :abstraction)) + + (def: .public float + (-> Frac Computation) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "+inf.0" [])] + + [(f.= f.negative_infinity)] + [(new> "-inf.0" [])] + + [f.not_a_number?] + [(new> "+nan.0" [])] + + ... else + [%.frac]) + :abstraction)) + + (def: .public positive_infinity Computation (..float f.positive_infinity)) + (def: .public negative_infinity Computation (..float f.negative_infinity)) + (def: .public not_a_number Computation (..float f.not_a_number)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + ["|" "\|"] + [text.alarm "\a"] + [text.back_space "\b"] + [text.tab "\t"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Computation) + (|>> ..safe %.text :abstraction)) + + (def: .public symbol + (-> Text Computation) + (|>> (format "'") :abstraction)) + + (def: form + (-> (List (Code Any)) Code) + (.let [nested_new_line (format text.new_line text.tab)] + (|>> (case> #.End + (:abstraction "()") + + {#.Item head tail} + (|> tail + (list\each (|>> :representation ..nested)) + {#.Item (:representation head)} + (text.interposed nested_new_line) + (text.enclosed ["(" ")"]) + :abstraction))))) + + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (..form {#.Item func args})) + + (template [<name> <function>] + [(def: .public (<name> members) + (-> (List Expression) Computation) + (..apply/* members (..var <function>)))] + + [vector/* "vector"] + [list/* "list"] + ) + + (def: .public apply/0 + (-> Expression Computation) + (..apply/* (list))) + + (template [<lux_name> <scheme_name>] + [(def: .public <lux_name> + (apply/0 (..var <scheme_name>)))] + + [newline/0 "newline"] + ) + + (template [<apply> <arg>+ <type>+ <function>+] + [(`` (def: .public (<apply> procedure) + (-> Expression (~~ (template.spliced <type>+)) Computation) + (function (_ (~~ (template.spliced <arg>+))) + (..apply/* (list (~~ (template.spliced <arg>+))) procedure)))) + + (`` (template [<definition> <function>] + [(def: .public <definition> (<apply> (..var <function>)))] + + (~~ (template.spliced <function>+))))] + + [apply/1 [_0] [Expression] + [[exact/1 "exact"] + [integer->char/1 "integer->char"] + [char->integer/1 "char->integer"] + [number->string/1 "number->string"] + [string->number/1 "string->number"] + [floor/1 "floor"] + [truncate/1 "truncate"] + [string/1 "string"] + [string?/1 "string?"] + [length/1 "length"] + [values/1 "values"] + [null?/1 "null?"] + [car/1 "car"] + [cdr/1 "cdr"] + [raise/1 "raise"] + [error_object_message/1 "error-object-message"] + [make_vector/1 "make-vector"] + [vector_length/1 "vector-length"] + [not/1 "not"] + [string_hash/1 "string-hash"] + [reverse/1 "reverse"] + [display/1 "display"] + [exit/1 "exit"] + [string_length/1 "string-length"] + [load_relative/1 "load-relative"]]] + + [apply/2 [_0 _1] [Expression Expression] + [[append/2 "append"] + [cons/2 "cons"] + [make_vector/2 "make-vector"] + ... [vector_ref/2 "vector-ref"] + [list_tail/2 "list-tail"] + [map/2 "map"] + [string_ref/2 "string-ref"] + [string_append/2 "string-append"] + [make_string/2 "make-string"]]] + + [apply/3 [_0 _1 _2] [Expression Expression Expression] + [[substring/3 "substring"] + [vector_set!/3 "vector-set!"] + [string_contains/3 "string-contains"]]] + + [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression] + [[vector_copy!/5 "vector-copy!"]]] + ) + + ... TODO: define "vector_ref/2" like a normal apply/2 function. + ... "vector_ref/2" as an 'invoke' is problematic, since it only works + ... in Kawa. + ... However, the way Kawa defines "vector-ref" causes trouble, + ... because it does a runtime type-check which throws an error when + ... it checks against custom values/objects/classes made for + ... JVM<->Scheme interop. + ... There are 2 ways to deal with this: + ... 0. To fork Kawa, and get rid of the type-check so the normal + ... "vector-ref" can be used instead. + ... 1. To carry on, and then, when it's time to compile the compiler + ... itself into Scheme, switch from 'invoke' to normal 'vector-ref'. + ... Either way, the 'invoke' needs to go away. + (def: .public (vector_ref/2 vector index) + (-> Expression Expression Computation) + (..form (list (..var "invoke") vector (..symbol "getRaw") index))) + + (template [<lux_name> <scheme_name>] + [(def: .public (<lux_name> param subject) + (-> Expression Expression Computation) + (..apply/2 (..var <scheme_name>) subject param))] + + [=/2 "="] + [eq?/2 "eq?"] + [eqv?/2 "eqv?"] + [</2 "<"] + [<=/2 "<="] + [>/2 ">"] + [>=/2 ">="] + [string=?/2 "string=?"] + [string<?/2 "string<?"] + [+/2 "+"] + [-/2 "-"] + [//2 "/"] + [*/2 "*"] + [expt/2 "expt"] + [remainder/2 "remainder"] + [quotient/2 "quotient"] + [mod/2 "mod"] + [arithmetic_shift/2 "arithmetic-shift"] + [bitwise_and/2 "bitwise-and"] + [bitwise_ior/2 "bitwise-ior"] + [bitwise_xor/2 "bitwise-xor"] + ) + + (template [<lux_name> <scheme_name>] + [(def: .public <lux_name> + (-> (List Expression) Computation) + (|>> (list& (..var <scheme_name>)) ..form))] + + [or "or"] + [and "and"] + ) + + (template [<lux_name> <scheme_name> <var> <pre>] + [(def: .public (<lux_name> bindings body) + (-> (List [<var> Expression]) Expression Computation) + (..form (list (..var <scheme_name>) + (|> bindings + (list\each (function (_ [binding/name binding/value]) + (..form (list (|> binding/name <pre>) + binding/value)))) + ..form) + body)))] + + [let "let" Var (<|)] + [let* "let*" Var (<|)] + [letrec "letrec" Var (<|)] + [let_values "let-values" Arguments ..arguments] + [let*_values "let*-values" Arguments ..arguments] + [letrec_values "letrec-values" Arguments ..arguments] + ) + + (def: .public (if test then else) + (-> Expression Expression Expression Computation) + (..form (list (..var "if") test then else))) + + (def: .public (when test then) + (-> Expression Expression Computation) + (..form (list (..var "when") test then))) + + (def: .public (lambda arguments body) + (-> Arguments Expression Computation) + (..form (list (..var "lambda") + (..arguments arguments) + body))) + + (def: .public (define_function name arguments body) + (-> Var Arguments Expression Computation) + (..form (list (..var "define") + (|> arguments + (revised@ #mandatory (|>> {#.Item name})) + ..arguments) + body))) + + (def: .public (define_constant name value) + (-> Var Expression Computation) + (..form (list (..var "define") name value))) + + (def: .public begin + (-> (List Expression) Computation) + (|>> {#.Item (..var "begin")} ..form)) + + (def: .public (set! name value) + (-> Var Expression Computation) + (..form (list (..var "set!") name value))) + + (def: .public (with_exception_handler handler body) + (-> Expression Expression Computation) + (..form (list (..var "with-exception-handler") handler body))) + + (def: .public (call_with_current_continuation body) + (-> Expression Computation) + (..form (list (..var "call-with-current-continuation") body))) + + (def: .public (guard variable clauses else body) + (-> Var (List [Expression Expression]) (Maybe Expression) Expression Computation) + (..form (list (..var "guard") + (..form (|> (case else + #.None + (list) + + {#.Some else} + (list (..form (list (..var "else") else)))) + (list\composite (list\each (function (_ [when then]) + (..form (list when then))) + clauses)) + (list& variable))) + body))) ) |