diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/host.old.lux | 253 |
1 files changed, 111 insertions, 142 deletions
diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 915cdc7bf..8785cb7ca 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -11,14 +11,14 @@ ["." maybe] ["." product] ["." error (#+ Error)] - ["." bit ("#;." codec)] + ["." bit ("#@." codec)] number - ["." text ("#;." equivalence monoid) + ["." text ("#@." equivalence monoid) format] [collection ["." array (#+ Array)] - ["." list ("#;." monad fold monoid)]]] - ["." type ("#;." equivalence)] + ["." list ("#@." monad fold monoid)]]] + ["." type ("#@." equivalence)] ["." macro (#+ with-gensyms) ["." code] ["s" syntax (#+ syntax: Syntax)]]]) @@ -291,7 +291,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) @@ -299,7 +299,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 @@ -333,7 +333,7 @@ (def: (class-decl-type$ (^slots [#class-name #class-params])) (-> Class-Declaration Code) - (let [=params (list;map (: (-> Type-Paramameter Code) + (let [=params (list@map (: (-> Type-Paramameter Code) (function (_ [pname pbounds]) (case pbounds #.Nil @@ -352,7 +352,7 @@ (def: (get-import name imports) (-> Text Class-Imports (Maybe Text)) (:: maybe.functor map product.right - (list.find (|>> product.left (text;= name)) + (list.find (|>> product.left (text@= name)) imports))) (def: (add-import short+full imports) @@ -366,7 +366,7 @@ (do macro.monad [current-module macro.current-module-name definitions (macro.definitions current-module)] - (wrap (list;fold (: (-> [Text Definition] Class-Imports Class-Imports) + (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) (function (_ [short-name [_ meta _]] imports) (case (macro.get-text-ann (name-of #..jvm-class) meta) (#.Some full-class-name) @@ -475,7 +475,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 @@ -541,12 +541,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))] @@ -580,7 +580,7 @@ [args (: (Syntax (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)))))) @@ -591,7 +591,7 @@ args (: (Syntax (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)))))) @@ -603,7 +603,7 @@ args (: (Syntax (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))))))] @@ -678,7 +678,7 @@ (do p.monad [name (full-class-name^ imports) _ (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.form (do p.monad @@ -704,7 +704,7 @@ _ (assert-no-periods name) params (p.some (generic-type^ imports type-vars)) _ (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)))) )) @@ -845,7 +845,7 @@ [pm privacy-modifier^ strict-fp? (s.this? (' #strict)) method-vars (p.default (list) (type-params^ imports)) - #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^ imports total-vars))) constructor-args (constructor-args^ imports total-vars) @@ -864,7 +864,7 @@ strict-fp? (s.this? (' #strict)) final? (s.this? (' #final)) method-vars (p.default (list) (type-params^ imports)) - #let [total-vars (list;compose class-vars method-vars)] + #let [total-vars (list@compose class-vars method-vars)] [name arg-decls] (s.form (p.and s.local-identifier (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) @@ -882,7 +882,7 @@ [strict-fp? (s.this? (' #strict)) owner-class (class-decl^ imports) method-vars (p.default (list) (type-params^ imports)) - #let [total-vars (list;compose (product.right owner-class) method-vars)] + #let [total-vars (list@compose (product.right owner-class) method-vars)] [name arg-decls] (s.form (p.and s.local-identifier (arg-decls^ imports total-vars))) return-type (generic-type^ imports total-vars) @@ -1001,7 +1001,7 @@ [tvars (p.default (list) (type-params^ imports)) _ (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^ imports total-vars) [io? try? maybe?] import-member-return-flags^] @@ -1022,7 +1022,7 @@ tvars (p.default (list) (type-params^ imports)) 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^ imports total-vars) [io? try? maybe?] import-member-return-flags^ @@ -1087,7 +1087,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) @@ -1102,7 +1102,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) ")") @@ -1115,25 +1115,25 @@ (def: (type-param$ [name bounds]) (-> Type-Paramameter 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)) )))) @@ -1150,7 +1150,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.to-text value)) )) @@ -1160,7 +1160,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)) )) )) @@ -1182,12 +1182,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.to-text (pre-walk-replace replacer body)) ))) @@ -1196,12 +1196,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.to-text (pre-walk-replace replacer body))))) @@ -1209,7 +1209,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) @@ -1220,11 +1220,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) (|> body (pre-walk-replace replacer) @@ -1237,11 +1237,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.to-text (pre-walk-replace replacer body))))) @@ -1250,10 +1250,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) @@ -1261,10 +1261,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)))) )) @@ -1326,19 +1326,19 @@ (do macro.monad [current-module macro.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: @@ -1357,9 +1357,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)))))) )) @@ -1385,9 +1385,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) @@ -1485,7 +1485,7 @@ (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$ long-name? [full-name params]) @@ -1493,7 +1493,7 @@ (let [def-name (if long-name? full-name (short-class-name full-name)) - params' (list;map (|>> product.left code.local-identifier) params)] + params' (list@map (|>> product.left code.local-identifier) params)] (` (def: (~ (code.identifier ["" def-name])) {#.type? #1 #..jvm-class (~ (code.text full-name))} @@ -1506,7 +1506,7 @@ (-> (List Type-Paramameter) Import-Member-Declaration (List Type-Paramameter)) (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) @@ -1514,7 +1514,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)) @@ -1532,9 +1532,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? @@ -1614,12 +1614,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.zip2 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-Paramameter) Class-Kind Class-Declaration [(List [Bit Code]) (List Text) (List Code)] Import-Member-Declaration Text (Meta (List Code))) @@ -1627,7 +1627,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 macro.monad @@ -1639,7 +1639,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) @@ -1647,7 +1647,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 macro.monad @@ -1658,7 +1658,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]) @@ -1667,34 +1667,31 @@ [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) (^slots [#import-member-kind]) commons (^slots [#import-method-name]) method - [jvm-op object-ast class-ast] (: [Text (List Code) (List Code)] - (case import-member-kind - #StaticIMK - ["invokestatic" - (list) - (list)] - - #VirtualIMK - (case kind - #Class - ["invokevirtual" - (list g!obj) - (list (class-decl-type$ class))] - - #Interface - ["invokeinterface" - (list g!obj) - (list (class-decl-type$ class))] - ))) + [jvm-op object-ast] (: [Text (List Code)] + (case import-member-kind + #StaticIMK + ["invokestatic" + (list)] + + #VirtualIMK + (case kind + #Class + ["invokevirtual" + (list g!obj)] + + #Interface + ["invokeinterface" + (list g!obj)] + ))) 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) @@ -1708,7 +1705,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] @@ -1840,7 +1837,7 @@ (do macro.monad [kind (class-kind class-decl) =members (monad.map @ (member-import$ (product.right class-decl) long-name? kind class-decl) members)] - (wrap (list& (class-import$ long-name? class-decl) (list;join =members))))) + (wrap (list& (class-import$ long-name? class-decl) (list@join =members))))) (syntax: #export (array {#let [imports (class-imports *compiler*)]} {type (generic-type^ imports (list))} @@ -1870,7 +1867,7 @@ (def: (type->class-name type) (-> Type (Meta Text)) - (if (type;= Any type) + (if (type@= Any type) (:: macro.monad wrap "java.lang.Object") (case type (#.Primitive name params) @@ -1948,34 +1945,6 @@ (wrap (list (` (let [(~ g!array) (~ array)] (..array-write (~ idx) (~ value) (~ g!array))))))))) -(def: simple-bindings^ - (Syntax (List [Text Code])) - (s.tuple (p.some (p.and s.local-identifier s.any)))) - -(syntax: #export (with-open - {bindings simple-bindings^} - body) - {#.doc (doc "Creates a local-binding with the desired resources, and runs the body (assumed to be in the IO type)." - "Afterwards, closes all resources (assumed to be subclasses of java.io.Closeable), and returns the value resulting from running the body." - (with-open [my-res1 (res1-constructor ___) - my-res2 (res1-constructor ___)] - (do io.monad - [foo (do-something my-res1) - bar (do-something-else my-res2)] - (do-one-last-thing foo bar))))} - (with-gensyms [g!output g!_] - (let [inits (list;join (list;map (function (_ [res-name res-ctor]) - (list (code.identifier ["" res-name]) res-ctor)) - bindings)) - closes (list;map (function (_ res) - (` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code.identifier ["" (product.left res)])))))) - bindings)] - (wrap (list (` (do (~! io.monad) - [(~+ inits) - (~ g!output) (~ body) - (~' #let) [(~ g!_) (exec (~+ (list.reverse closes)) [])]] - ((~' wrap) (~ g!output))))))))) - (syntax: #export (class-for {#let [imports (class-imports *compiler*)]} {type (generic-type^ imports (list))}) {#.doc (doc "Loads the class as a java.lang.Class object." |