diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/host.old.lux | 186 |
1 files changed, 93 insertions, 93 deletions
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index af26b4372..70819c754 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -12,14 +12,14 @@ [data ["." maybe] ["." product] - ["." bit ("#@." codec)] + ["." bit ("#\." codec)] number - ["." text ("#@." equivalence monoid) + ["." text ("#\." equivalence monoid) ["%" format (#+ format)]] [collection ["." array (#+ Array)] - ["." list ("#@." monad fold monoid)]]] - ["." type ("#@." equivalence)] + ["." list ("#\." monad fold monoid)]]] + ["." type ("#\." equivalence)] [macro ["." code] [syntax (#+ syntax:)]] @@ -284,7 +284,7 @@ [[name params] _ _] (let [name (sanitize name) - =params (list@map (class->type' mode type-params in-array?) params)] + =params (list\map (class->type' mode type-params in-array?) params)] (` (primitive (~ (code.text name)) [(~+ =params)]))))) (def: (class->type' mode type-params in-array? class) @@ -292,7 +292,7 @@ (case class (#GenericTypeVar name) (case (list.find (function (_ [pname pbounds]) - (and (text@= name pname) + (and (text\= name pname) (not (list.empty? pbounds)))) type-params) #.None @@ -326,7 +326,7 @@ (def: (class-decl-type$ (^slots [#class-name #class-params])) (-> Class-Declaration Code) - (let [=params (list@map (: (-> Type-Parameter Code) + (let [=params (list\map (: (-> Type-Parameter Code) (function (_ [pname pbounds]) (case pbounds #.Nil @@ -345,7 +345,7 @@ (case class (#GenericTypeVar name) (case (list.find (function (_ [pname pbounds]) - (and (text@= name pname) + (and (text\= name pname) (not (list.empty? pbounds)))) env) #.None @@ -411,12 +411,12 @@ (case (f input) (^template [<tag>] [[meta (<tag> parts)] - [meta (<tag> (list@map (pre-walk-replace f) parts))]]) + [meta (<tag> (list\map (pre-walk-replace f) parts))]]) ([#.Form] [#.Tuple]) [meta (#.Record pairs)] - [meta (#.Record (list@map (: (-> [Code Code] [Code Code]) + [meta (#.Record (list\map (: (-> [Code Code] [Code Code]) (function (_ [key val]) [(pre-walk-replace f key) (pre-walk-replace f val)])) pairs))] @@ -450,7 +450,7 @@ [args (: (Parser (List Code)) (s.form (p.after (s.this! (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]] + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls')))) (~+ args)))))) @@ -461,7 +461,7 @@ args (: (Parser (List Code)) (s.form (p.after (s.this! (code.identifier ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]] + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~+ args)))))) @@ -473,7 +473,7 @@ args (: (Parser (List Code)) (s.form (p.after (s.this! (code.identifier ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any))))) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ params)) arg-decls))]] + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ params)) arg-decls))]] (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls')))) (~' _jvm_this) (~+ args))))))] @@ -544,7 +544,7 @@ (do p.monad [name s.local-identifier _ (assert-no-periods name)] - (if (list.member? text.equivalence (list@map product.left type-vars) name) + (if (list.member? text.equivalence (list\map product.left type-vars) name) (wrap (#GenericTypeVar name)) (wrap (#GenericClass name (list))))) (s.tuple (do p.monad @@ -569,7 +569,7 @@ _ (assert-no-periods name) params (p.some recur^) _ (p.assert (format name " cannot be a type-parameter!") - (not (list.member? text.equivalence (list@map product.left type-vars) name)))] + (not (list.member? text.equivalence (list\map product.left type-vars) name)))] (wrap (#GenericClass name params)))) )))) @@ -713,7 +713,7 @@ [pm privacy-modifier^ strict-fp? (p.parses? (s.this! (' #strict))) method-vars ..type-params^ - #let [total-vars (list@compose class-vars method-vars)] + #let [total-vars (list\compose class-vars method-vars)] [_ arg-decls] (s.form (p.and (s.this! (' new)) (..arg-decls^ total-vars))) constructor-args (..constructor-args^ total-vars) @@ -732,7 +732,7 @@ strict-fp? (p.parses? (s.this! (' #strict))) final? (p.parses? (s.this! (' #final))) method-vars ..type-params^ - #let [total-vars (list@compose class-vars method-vars)] + #let [total-vars (list\compose class-vars method-vars)] [name this-name arg-decls] (s.form ($_ p.and s.local-identifier s.local-identifier @@ -755,7 +755,7 @@ [strict-fp? (p.parses? (s.this! (' #strict))) owner-class ..class-decl^ method-vars ..type-params^ - #let [total-vars (list@compose (product.right owner-class) method-vars)] + #let [total-vars (list\compose (product.right owner-class) method-vars)] [name this-name arg-decls] (s.form ($_ p.and s.local-identifier s.local-identifier @@ -879,7 +879,7 @@ [tvars ..type-params^ _ (s.this! (' new)) ?alias import-member-alias^ - #let [total-vars (list@compose owner-vars tvars)] + #let [total-vars (list\compose owner-vars tvars)] ?prim-mode (p.maybe primitive-mode^) args (..import-member-args^ total-vars) [io? try? maybe?] import-member-return-flags^] @@ -900,7 +900,7 @@ tvars ..type-params^ name s.local-identifier ?alias import-member-alias^ - #let [total-vars (list@compose owner-vars tvars)] + #let [total-vars (list\compose owner-vars tvars)] ?prim-mode (p.maybe primitive-mode^) args (..import-member-args^ total-vars) [io? try? maybe?] import-member-return-flags^ @@ -965,7 +965,7 @@ (def: (annotation$ [name params]) (-> Annotation JVM-Code) - (format "(" name " " "{" (text.join-with text.tab (list@map annotation-param$ params)) "}" ")")) + (format "(" name " " "{" (text.join-with text.tab (list\map annotation-param$ params)) "}" ")")) (def: (bound-kind$ kind) (-> BoundKind JVM-Code) @@ -980,7 +980,7 @@ name (#GenericClass name params) - (format "(" (sanitize name) " " (spaced (list@map generic-type$ params)) ")") + (format "(" (sanitize name) " " (spaced (list\map generic-type$ params)) ")") (#GenericArray param) (format "(" array.type-name " " (generic-type$ param) ")") @@ -993,25 +993,25 @@ (def: (type-param$ [name bounds]) (-> Type-Parameter JVM-Code) - (format "(" name " " (spaced (list@map generic-type$ bounds)) ")")) + (format "(" name " " (spaced (list\map generic-type$ bounds)) ")")) (def: (class-decl$ (^open ".")) (-> Class-Declaration JVM-Code) - (format "(" (sanitize class-name) " " (spaced (list@map type-param$ class-params)) ")")) + (format "(" (sanitize class-name) " " (spaced (list\map type-param$ class-params)) ")")) (def: (super-class-decl$ (^slots [#super-class-name #super-class-params])) (-> Super-Class-Decl JVM-Code) - (format "(" (sanitize super-class-name) " " (spaced (list@map generic-type$ super-class-params)) ")")) + (format "(" (sanitize super-class-name) " " (spaced (list\map generic-type$ super-class-params)) ")")) (def: (method-decl$ [[name pm anns] method-decl]) (-> [Member-Declaration MethodDecl] JVM-Code) (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] (with-parens (spaced (list name - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ method-tvars))) - (with-brackets (spaced (list@map generic-type$ method-exs))) - (with-brackets (spaced (list@map generic-type$ method-inputs))) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ method-tvars))) + (with-brackets (spaced (list\map generic-type$ method-exs))) + (with-brackets (spaced (list\map generic-type$ method-inputs))) (generic-type$ method-output)) )))) @@ -1028,7 +1028,7 @@ (#ConstantField class value) (with-parens (spaced (list "constant" name - (with-brackets (spaced (list@map annotation$ anns))) + (with-brackets (spaced (list\map annotation$ anns))) (generic-type$ class) (code.format value)) )) @@ -1038,7 +1038,7 @@ (spaced (list "variable" name (privacy-modifier$ pm) (state-modifier$ sm) - (with-brackets (spaced (list@map annotation$ anns))) + (with-brackets (spaced (list\map annotation$ anns))) (generic-type$ class)) )) )) @@ -1060,12 +1060,12 @@ (with-parens (spaced (list "init" (privacy-modifier$ pm) - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) - (with-brackets (spaced (list@map constructor-arg$ constructor-args))) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) + (with-brackets (spaced (list\map constructor-arg$ constructor-args))) (code.format (pre-walk-replace replacer body)) ))) @@ -1074,12 +1074,12 @@ (spaced (list "virtual" name (privacy-modifier$ pm) - (bit@encode final?) - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (bit\encode final?) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type) (code.format (pre-walk-replace replacer (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)] (~ body)))))))) @@ -1088,7 +1088,7 @@ (let [super-replacer (parser->replacer (s.form (do p.monad [_ (s.this! (' ::super!)) args (s.tuple (p.exactly (list.size arg-decls) s.any)) - #let [arg-decls' (: (List Text) (list@map (|>> product.right (simple-class$ (list))) + #let [arg-decls' (: (List Text) (list\map (|>> product.right (simple-class$ (list))) arg-decls))]] (wrap (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) @@ -1099,11 +1099,11 @@ (spaced (list "override" (class-decl$ class-decl) name - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type) (|> (` (let [(~ (code.local-identifier this-name)) (~' _jvm_this)] (~ body))) @@ -1117,11 +1117,11 @@ (spaced (list "static" name (privacy-modifier$ pm) - (bit@encode strict-fp?) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (bit\encode strict-fp?) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type) (code.format (pre-walk-replace replacer body))))) @@ -1130,10 +1130,10 @@ (spaced (list "abstract" name (privacy-modifier$ pm) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type)))) (#NativeMethod type-vars arg-decls return-type exs) @@ -1141,10 +1141,10 @@ (spaced (list "native" name (privacy-modifier$ pm) - (with-brackets (spaced (list@map annotation$ anns))) - (with-brackets (spaced (list@map type-param$ type-vars))) - (with-brackets (spaced (list@map generic-type$ exs))) - (with-brackets (spaced (list@map arg-decl$ arg-decls))) + (with-brackets (spaced (list\map annotation$ anns))) + (with-brackets (spaced (list\map type-param$ type-vars))) + (with-brackets (spaced (list\map generic-type$ exs))) + (with-brackets (spaced (list\map arg-decl$ arg-decls))) (generic-type$ return-type)))) )) @@ -1203,19 +1203,19 @@ (do meta.monad [current-module meta.current-module-name #let [fully-qualified-class-name (format (sanitize current-module) "." full-class-name) - field-parsers (list@map (field->parser fully-qualified-class-name) fields) - method-parsers (list@map (method->parser (product.right class-decl) fully-qualified-class-name) methods) - replacer (parser->replacer (list@fold p.either + field-parsers (list\map (field->parser fully-qualified-class-name) fields) + method-parsers (list\map (method->parser (product.right class-decl) fully-qualified-class-name) methods) + replacer (parser->replacer (list\fold p.either (p.fail "") - (list@compose field-parsers method-parsers))) + (list\compose field-parsers method-parsers))) def-code (format "jvm class:" (spaced (list (class-decl$ class-decl) (super-class-decl$ super) - (with-brackets (spaced (list@map super-class-decl$ interfaces))) + (with-brackets (spaced (list\map super-class-decl$ interfaces))) (inheritance-modifier$ im) - (with-brackets (spaced (list@map annotation$ annotations))) - (with-brackets (spaced (list@map field-decl$ fields))) - (with-brackets (spaced (list@map (method-def$ replacer super) methods))))))]] + (with-brackets (spaced (list\map annotation$ annotations))) + (with-brackets (spaced (list\map field-decl$ fields))) + (with-brackets (spaced (list\map (method-def$ replacer super) methods))))))]] (wrap (list (` ((~ (code.text def-code)))))))) (syntax: #export (interface: @@ -1230,9 +1230,9 @@ ([] foo [boolean String] void #throws [Exception])))} (let [def-code (format "jvm interface:" (spaced (list (class-decl$ class-decl) - (with-brackets (spaced (list@map super-class-decl$ supers))) - (with-brackets (spaced (list@map annotation$ annotations))) - (spaced (list@map method-decl$ members)))))] + (with-brackets (spaced (list\map super-class-decl$ supers))) + (with-brackets (spaced (list\map annotation$ annotations))) + (spaced (list\map method-decl$ members)))))] (wrap (list (` ((~ (code.text def-code)))))) )) @@ -1257,9 +1257,9 @@ )} (let [def-code (format "jvm anon-class:" (spaced (list (super-class-decl$ super) - (with-brackets (spaced (list@map super-class-decl$ interfaces))) - (with-brackets (spaced (list@map constructor-arg$ constructor-args))) - (with-brackets (spaced (list@map (method-def$ function.identity super) methods))))))] + (with-brackets (spaced (list\map super-class-decl$ interfaces))) + (with-brackets (spaced (list\map constructor-arg$ constructor-args))) + (with-brackets (spaced (list\map (method-def$ function.identity super) methods))))))] (wrap (list (` ((~ (code.text def-code)))))))) (syntax: #export (null) @@ -1354,12 +1354,12 @@ (ClassName::method2 arg3 arg4 arg5)))} (with-gensyms [g!obj] (wrap (list (` (let [(~ g!obj) (~ obj)] - (exec (~+ (list@map (complete-call$ g!obj) methods)) + (exec (~+ (list\map (complete-call$ g!obj) methods)) (~ g!obj)))))))) (def: (class-import$ [full-name params]) (-> Class-Declaration Code) - (let [params' (list@map (|>> product.left code.local-identifier) params)] + (let [params' (list\map (|>> product.left code.local-identifier) params)] (` (def: (~ (code.identifier ["" full-name])) {#..jvm-class (~ (code.text full-name))} Type @@ -1371,7 +1371,7 @@ (-> (List Type-Parameter) Import-Member-Declaration (List Type-Parameter)) (case member (#ConstructorDecl [commons _]) - (list@compose class-tvars (get@ #import-member-tvars commons)) + (list\compose class-tvars (get@ #import-member-tvars commons)) (#MethodDecl [commons _]) (case (get@ #import-member-kind commons) @@ -1379,7 +1379,7 @@ (get@ #import-member-tvars commons) _ - (list@compose class-tvars (get@ #import-member-tvars commons))) + (list\compose class-tvars (get@ #import-member-tvars commons))) _ class-tvars)) @@ -1397,9 +1397,9 @@ (wrap [maybe? arg-name])))) import-member-args) #let [arg-classes (: (List Text) - (list@map (|>> product.right (simple-class$ (list@compose type-params import-member-tvars))) + (list\map (|>> product.right (simple-class$ (list\compose type-params import-member-tvars))) import-member-args)) - arg-types (list@map (: (-> [Bit GenericType] Code) + arg-types (list\map (: (-> [Bit GenericType] Code) (function (_ [maybe? arg]) (let [arg-type (class->type (get@ #import-member-mode commons) type-params arg)] (if maybe? @@ -1479,12 +1479,12 @@ (def: (jvm-extension-inputs mode classes inputs) (-> Primitive-Mode (List Text) (List [Bit Code]) (List Code)) (|> inputs - (list@map (function (_ [maybe? input]) + (list\map (function (_ [maybe? input]) (if maybe? (` ((~! !!!) (~ (un-quote input)))) (un-quote input)))) (list.zip/2 classes) - (list@map (auto-convert-input mode)))) + (list\map (auto-convert-input mode)))) (def: (member-def-interop type-params kind class [arg-function-inputs arg-classes arg-types] member method-prefix) (-> (List Type-Parameter) Class-Kind Class-Declaration [(List [Bit Code]) (List Text) (List Code)] Import-Member-Declaration Text (Meta (List Code))) @@ -1492,7 +1492,7 @@ full-name (sanitize full-name) all-params (|> (member-type-vars class-tvars member) (list.filter free-type-param?) - (list@map type-param->type-arg))] + (list\map type-param->type-arg))] (case member (#EnumDecl enum-members) (do {! meta.monad} @@ -1504,7 +1504,7 @@ _ (let [=class-tvars (|> class-tvars (list.filter free-type-param?) - (list@map type-param->type-arg))] + (list\map type-param->type-arg))] (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)])))))) getter-interop (: (-> Text Code) (function (_ name) @@ -1512,7 +1512,7 @@ (` (def: (~ getter-name) (~ enum-type) ((~ (code.text (format "jvm getstatic" ":" full-name ":" name)))))))))]] - (wrap (list@map getter-interop enum-members))) + (wrap (list\map getter-interop enum-members))) (#ConstructorDecl [commons _]) (do meta.monad @@ -1523,7 +1523,7 @@ (decorate-return-maybe member) (decorate-return-try member) (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list@map product.right arg-function-inputs))) + (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs))) ((~' wrap) (.list (.` (~ jvm-interop))))))))) (#MethodDecl [commons method]) @@ -1550,13 +1550,13 @@ ))) jvm-extension (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name ":" (text.join-with "," arg-classes))) jvm-interop (|> [(simple-class$ (list) (get@ #import-method-return method)) - (` ((~ jvm-extension) (~+ (list@map un-quote object-ast)) + (` ((~ jvm-extension) (~+ (list\map un-quote object-ast)) (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs))))] (auto-convert-output (get@ #import-member-mode commons)) (decorate-return-maybe member) (decorate-return-try member) (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list@map product.right arg-function-inputs)) (~+ object-ast)) + (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list\map product.right arg-function-inputs)) (~+ object-ast)) ((~' wrap) (.list (.` (~ jvm-interop)))))))))) (#FieldAccessDecl fad) @@ -1570,7 +1570,7 @@ tvar-asts (: (List Code) (|> class-tvars (list.filter free-type-param?) - (list@map type-param->type-arg))) + (list\map type-param->type-arg))) getter-name (code.identifier ["" (format method-prefix member-separator import-field-name)]) setter-name (code.identifier ["" (format method-prefix member-separator import-field-name "!")])] getter-interop (with-gensyms [g!obj] @@ -1693,7 +1693,7 @@ (do {! meta.monad} [kind (class-kind class-decl) =members (monad.map ! (member-import$ (product.right class-decl) kind class-decl) members)] - (wrap (list& (class-import$ class-decl) (list@join =members))))) + (wrap (list& (class-import$ class-decl) (list\join =members))))) (syntax: #export (array {type (..generic-type^ (list))} size) @@ -1722,7 +1722,7 @@ (def: (type->class-name type) (-> Type (Meta Text)) - (if (type@= Any type) + (if (type\= Any type) (:: meta.monad wrap "java.lang.Object") (case type (#.Primitive name params) |