From ba93f7da278a3fdc71729d7a0325c99cec74ca3c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Aug 2018 22:36:47 -0400 Subject: Adapted new-luxc to latest stdlib changes. --- new-luxc/source/luxc/lang/host/jvm.lux | 3 +- new-luxc/source/luxc/lang/host/jvm/def.lux | 173 +++++++++++---------- new-luxc/source/luxc/lang/host/jvm/inst.lux | 47 +++--- new-luxc/source/luxc/lang/translation/jvm.lux | 30 ++-- .../lang/translation/jvm/procedure/common.jvm.lux | 6 +- new-luxc/source/program.lux | 3 - .../translation/scheme/extension/common.jvm.lux | 6 +- stdlib/source/lux/concurrency/process.lux | 4 +- stdlib/source/lux/control/order.lux | 2 +- stdlib/source/lux/data/text/buffer.lux | 6 +- stdlib/source/lux/data/text/encoding.lux | 4 +- stdlib/source/lux/host.jvm.lux | 47 +++--- stdlib/source/lux/world/console.lux | 14 +- stdlib/source/lux/world/environment.jvm.lux | 14 +- 14 files changed, 177 insertions(+), 182 deletions(-) diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index cb5bb46fb..49f02c0f0 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -151,7 +151,8 @@ ## Labels (def: #export new-label (-> Any Label) - org/objectweb/asm/Label::new) + (function (_ _) + (org/objectweb/asm/Label::new))) (def: #export (simple-class name) (-> Text Class) diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index ff31157b0..e8efe306b 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -77,43 +77,43 @@ (def: (version-flag version) (-> $.Version Int) (case version - #$.V1_1 Opcodes::V1_1 - #$.V1_2 Opcodes::V1_2 - #$.V1_3 Opcodes::V1_3 - #$.V1_4 Opcodes::V1_4 - #$.V1_5 Opcodes::V1_5 - #$.V1_6 Opcodes::V1_6 - #$.V1_7 Opcodes::V1_7 - #$.V1_8 Opcodes::V1_8)) + #$.V1_1 (Opcodes::V1_1) + #$.V1_2 (Opcodes::V1_2) + #$.V1_3 (Opcodes::V1_3) + #$.V1_4 (Opcodes::V1_4) + #$.V1_5 (Opcodes::V1_5) + #$.V1_6 (Opcodes::V1_6) + #$.V1_7 (Opcodes::V1_7) + #$.V1_8 (Opcodes::V1_8))) (def: (visibility-flag visibility) (-> $.Visibility Int) (case visibility - #$.Public Opcodes::ACC_PUBLIC - #$.Protected Opcodes::ACC_PROTECTED - #$.Private Opcodes::ACC_PRIVATE + #$.Public (Opcodes::ACC_PUBLIC) + #$.Protected (Opcodes::ACC_PROTECTED) + #$.Private (Opcodes::ACC_PRIVATE) #$.Default +0)) (def: (class-flags config) (-> $.Class-Config Int) ($_ i/+ - (if (get@ #$.finalC config) Opcodes::ACC_FINAL +0))) + (if (get@ #$.finalC config) (Opcodes::ACC_FINAL) +0))) (def: (method-flags config) (-> $.Method-Config Int) ($_ i/+ - (if (get@ #$.staticM config) Opcodes::ACC_STATIC +0) - (if (get@ #$.finalM config) Opcodes::ACC_FINAL +0) - (if (get@ #$.synchronizedM config) Opcodes::ACC_SYNCHRONIZED +0) - (if (get@ #$.strictM config) Opcodes::ACC_STRICT +0))) + (if (get@ #$.staticM config) (Opcodes::ACC_STATIC) +0) + (if (get@ #$.finalM config) (Opcodes::ACC_FINAL) +0) + (if (get@ #$.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0) + (if (get@ #$.strictM config) (Opcodes::ACC_STRICT) +0))) (def: (field-flags config) (-> $.Field-Config Int) ($_ i/+ - (if (get@ #$.staticF config) Opcodes::ACC_STATIC +0) - (if (get@ #$.finalF config) Opcodes::ACC_FINAL +0) - (if (get@ #$.transientF config) Opcodes::ACC_TRANSIENT +0) - (if (get@ #$.volatileF config) Opcodes::ACC_VOLATILE +0))) + (if (get@ #$.staticF config) (Opcodes::ACC_STATIC) +0) + (if (get@ #$.finalF config) (Opcodes::ACC_FINAL) +0) + (if (get@ #$.transientF config) (Opcodes::ACC_TRANSIENT) +0) + (if (get@ #$.volatileF config) (Opcodes::ACC_VOLATILE) +0))) (def: class-to-type (-> $.Class $.Type) @@ -150,8 +150,8 @@ (def: class-computes Int ($_ i/+ - ClassWriter::COMPUTE_MAXS - ## ClassWriter::COMPUTE_FRAMES + (ClassWriter::COMPUTE_MAXS) + ## (ClassWriter::COMPUTE_FRAMES) )) (do-template [ ] @@ -160,24 +160,24 @@ (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) $.Class (List $.Class) $.Def (host.type (Array byte))) (let [writer (|> (do-to (ClassWriter::new class-computes) - (ClassWriter::visit [(version-flag version) - ($_ i/+ - Opcodes::ACC_SUPER - - (visibility-flag visibility) - (class-flags config)) - ($t.binary-name name) - (parameters-signature parameters super interfaces) - (|> super product.left $t.binary-name) - (|> interfaces - (list/map (|>> product.left $t.binary-name)) - string-array)])) + (ClassWriter::visit (version-flag version) + ($_ i/+ + (Opcodes::ACC_SUPER) + + (visibility-flag visibility) + (class-flags config)) + ($t.binary-name name) + (parameters-signature parameters super interfaces) + (|> super product.left $t.binary-name) + (|> interfaces + (list/map (|>> product.left $t.binary-name)) + string-array))) definitions) - _ (ClassWriter::visitEnd [] writer)] - (ClassWriter::toByteArray [] writer)))] + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer)))] [class +0] - [abstract Opcodes::ACC_ABSTRACT] + [abstract (Opcodes::ACC_ABSTRACT)] ) (def: $Object $.Class ["java.lang.Object" (list)]) @@ -187,82 +187,83 @@ (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) (List $.Class) $.Def (host.type (Array byte))) (let [writer (|> (do-to (ClassWriter::new class-computes) - (ClassWriter::visit [(version-flag version) - ($_ i/+ - Opcodes::ACC_SUPER - Opcodes::ACC_INTERFACE - (visibility-flag visibility) - (class-flags config)) - ($t.binary-name name) - (parameters-signature parameters $Object interfaces) - (|> $Object product.left $t.binary-name) - (|> interfaces - (list/map (|>> product.left $t.binary-name)) - string-array)])) + (ClassWriter::visit (version-flag version) + ($_ i/+ + (Opcodes::ACC_SUPER) + (Opcodes::ACC_INTERFACE) + (visibility-flag visibility) + (class-flags config)) + ($t.binary-name name) + (parameters-signature parameters $Object interfaces) + (|> $Object product.left $t.binary-name) + (|> interfaces + (list/map (|>> product.left $t.binary-name)) + string-array))) definitions) - _ (ClassWriter::visitEnd [] writer)] - (ClassWriter::toByteArray [] writer))) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer))) (def: #export (method visibility config name type then) (-> $.Visibility $.Method-Config Text $.Method $.Inst $.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod [($_ i/+ - (visibility-flag visibility) - (method-flags config)) - ($t.binary-name name) - ($t.method-descriptor type) - ($t.method-signature type) - (exceptions-array type)] + (let [=method (ClassWriter::visitMethod ($_ i/+ + (visibility-flag visibility) + (method-flags config)) + ($t.binary-name name) + ($t.method-descriptor type) + ($t.method-signature type) + (exceptions-array type) writer) - _ (MethodVisitor::visitCode [] =method) + _ (MethodVisitor::visitCode =method) _ (then =method) - _ (MethodVisitor::visitMaxs [+0 +0] =method) - _ (MethodVisitor::visitEnd [] =method)] + _ (MethodVisitor::visitMaxs +0 +0 =method) + _ (MethodVisitor::visitEnd =method)] writer))) (def: #export (abstract-method visibility config name type) (-> $.Visibility $.Method-Config Text $.Method $.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod [($_ i/+ - (visibility-flag visibility) - (method-flags config) - Opcodes::ACC_ABSTRACT) - ($t.binary-name name) - ($t.method-descriptor type) - ($t.method-signature type) - (exceptions-array type)] + (let [=method (ClassWriter::visitMethod ($_ i/+ + (visibility-flag visibility) + (method-flags config) + (Opcodes::ACC_ABSTRACT)) + ($t.binary-name name) + ($t.method-descriptor type) + ($t.method-signature type) + (exceptions-array type) writer) - _ (MethodVisitor::visitEnd [] =method)] + _ (MethodVisitor::visitEnd =method)] writer))) (def: #export (field visibility config name type) (-> $.Visibility $.Field-Config Text $.Type $.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField [($_ i/+ - (visibility-flag visibility) - (field-flags config)) - ($t.binary-name name) - ($t.descriptor type) - ($t.signature type) - (host.null)] writer) - (FieldVisitor::visitEnd []))] + (let [=field (do-to (ClassWriter::visitField ($_ i/+ + (visibility-flag visibility) + (field-flags config)) + ($t.binary-name name) + ($t.descriptor type) + ($t.signature type) + (host.null) + writer) + (FieldVisitor::visitEnd))] writer))) (do-template [ ] [(def: #export ( visibility config name value) (-> $.Visibility $.Field-Config Text $.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField [($_ i/+ - (visibility-flag visibility) - (field-flags config)) - ($t.binary-name name) - ($t.descriptor ) - ($t.signature ) - ( value)] + (let [=field (do-to (ClassWriter::visitField ($_ i/+ + (visibility-flag visibility) + (field-flags config)) + ($t.binary-name name) + ($t.descriptor ) + ($t.signature ) + ( value) writer) - (FieldVisitor::visitEnd []))] + (FieldVisitor::visitEnd))] writer)))] [boolean-field Bit $t.boolean id] diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index cb8d47960..44ce0839a 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -121,18 +121,18 @@ (def: #export make-label (All [s] (Operation s Label)) (function (_ state) - (#error.Success [state (Label::new [])]))) + (#error.Success [state (Label::new)]))) (def: #export (with-label action) (-> (-> Label Inst) Inst) - (action (Label::new []))) + (action (Label::new))) (do-template [ ] [(def: #export ( value) (-> Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitLdcInsn [( value)]))))] + (MethodVisitor::visitLdcInsn ( value)))))] [boolean Bit id] [int Int host.long-to-int] @@ -143,20 +143,20 @@ ) (syntax: (prefix {base s.local-identifier}) - (wrap (list (code.local-identifier (format "Opcodes::" base))))) + (wrap (list (` ((~ (code.local-identifier (format "Opcodes::" base)))))))) (def: #export NULL Inst (function (_ visitor) (do-to visitor - (MethodVisitor::visitInsn [(prefix ACONST_NULL)])))) + (MethodVisitor::visitInsn (prefix ACONST_NULL))))) (do-template [] [(def: #export Inst (function (_ visitor) (do-to visitor - (MethodVisitor::visitInsn [(prefix )]))))] + (MethodVisitor::visitInsn (prefix )))))] [NOP] @@ -217,7 +217,7 @@ (-> Nat Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitVarInsn [(prefix ) (.int register)]))))] + (MethodVisitor::visitVarInsn (prefix ) (.int register)))))] [ILOAD] [LLOAD] [DLOAD] [ALOAD] [ISTORE] [LSTORE] [ASTORE] @@ -228,7 +228,7 @@ (-> Text Text //.Type Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitFieldInsn [ (type.binary-name class) field (type.descriptor type)]))))] + (MethodVisitor::visitFieldInsn () (type.binary-name class) field (type.descriptor type)))))] [GETSTATIC Opcodes::GETSTATIC] [PUTSTATIC Opcodes::PUTSTATIC] @@ -242,7 +242,7 @@ (-> Text Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTypeInsn [ (type.binary-name class)]))))] + (MethodVisitor::visitTypeInsn () (type.binary-name class)))))] [CHECKCAST Opcodes::CHECKCAST] [NEW Opcodes::NEW] @@ -254,22 +254,23 @@ (-> Primitive Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitIntInsn [Opcodes::NEWARRAY (case type - #//.Boolean Opcodes::T_BOOLEAN - #//.Byte Opcodes::T_BYTE - #//.Short Opcodes::T_SHORT - #//.Int Opcodes::T_INT - #//.Long Opcodes::T_LONG - #//.Float Opcodes::T_FLOAT - #//.Double Opcodes::T_DOUBLE - #//.Char Opcodes::T_CHAR)])))) + (MethodVisitor::visitIntInsn (Opcodes::NEWARRAY) + (case type + #//.Boolean (Opcodes::T_BOOLEAN) + #//.Byte (Opcodes::T_BYTE) + #//.Short (Opcodes::T_SHORT) + #//.Int (Opcodes::T_INT) + #//.Long (Opcodes::T_LONG) + #//.Float (Opcodes::T_FLOAT) + #//.Double (Opcodes::T_DOUBLE) + #//.Char (Opcodes::T_CHAR)))))) (do-template [ ] [(def: #export ( class method-name method-signature interface?) (-> Text Text //.Method Bit Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitMethodInsn [ (type.binary-name class) method-name (type.method-descriptor method-signature) interface?]))))] + (MethodVisitor::visitMethodInsn () (type.binary-name class) method-name (type.method-descriptor method-signature) interface?))))] [INVOKESTATIC Opcodes::INVOKESTATIC] [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL] @@ -282,7 +283,7 @@ (-> //.Label Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitJumpInsn [(prefix ) @where]))))] + (MethodVisitor::visitJumpInsn (prefix ) @where))))] [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL] [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE] @@ -302,19 +303,19 @@ (recur (inc idx))) []))] (do-to visitor - (MethodVisitor::visitTableSwitchInsn [min max default labels-array]))))) + (MethodVisitor::visitTableSwitchInsn min max default labels-array))))) (def: #export (try @from @to @handler exception) (-> //.Label //.Label //.Label Text Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTryCatchBlock [@from @to @handler (type.binary-name exception)])))) + (MethodVisitor::visitTryCatchBlock @from @to @handler (type.binary-name exception))))) (def: #export (label @label) (-> //.Label Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitLabel [@label])))) + (MethodVisitor::visitLabel @label)))) (def: #export (array type) (-> //.Type Inst) diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index b8c00c8a4..560994256 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -57,16 +57,16 @@ (def: ClassLoader::defineClass Method - (case (Class::getDeclaredMethod ["defineClass" - (|> (host.array (Class Object) 4) - (host.array-write 0 (:coerce (Class Object) (host.class-for String))) - (host.array-write 1 (Object::getClass [] (host.array byte 0))) - (host.array-write 2 (:coerce (Class Object) Integer::TYPE)) - (host.array-write 3 (:coerce (Class Object) Integer::TYPE)))] + (case (Class::getDeclaredMethod "defineClass" + (|> (host.array (Class Object) 4) + (host.array-write 0 (:coerce (Class Object) (host.class-for String))) + (host.array-write 1 (Object::getClass (host.array byte 0))) + (host.array-write 2 (:coerce (Class Object) (Integer::TYPE))) + (host.array-write 3 (:coerce (Class Object) (Integer::TYPE)))) (host.class-for java/lang/ClassLoader)) (#error.Success method) (do-to method - (AccessibleObject::setAccessible [#1])) + (AccessibleObject::setAccessible #1)) (#error.Error error) (error! error))) @@ -75,11 +75,11 @@ (def: (define-class class-name bytecode loader) (-> Text ByteCode ClassLoader (Error Object)) - (Method::invoke [loader - (array.from-list (list (:coerce Object class-name) - (:coerce Object bytecode) - (:coerce Object (host.long-to-int +0)) - (:coerce Object (host.long-to-int (.int (host.array-length bytecode))))))] + (Method::invoke loader + (array.from-list (list (:coerce Object class-name) + (:coerce Object bytecode) + (:coerce Object (host.long-to-int +0)) + (:coerce Object (host.long-to-int (.int (host.array-length bytecode)))))) ClassLoader::defineClass)) (type: Store (Atom (Dictionary Text ByteCode))) @@ -124,7 +124,7 @@ (def: (load! name loader) (-> Text ClassLoader (Error (Class Object))) - (ClassLoader::loadClass [name] loader)) + (ClassLoader::loadClass name loader)) (def: #export value-field Text "_value") (def: #export $Object jvm.Type (type.class "java.lang.Object" (list))) @@ -143,9 +143,9 @@ (def: (class-value class-name class) (-> Text (Class Object) (Error Any)) - (case (Class::getField [..value-field] class) + (case (Class::getField ..value-field class) (#error.Success field) - (case (Field::get [#.None] field) + (case (Field::get #.None field) (#error.Success ?value) (case ?value (#.Some value) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index e45a6f8cf..e439ecdd6 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -149,9 +149,9 @@ Nullary (|>> (_.wrap )))] - [frac::smallest (_.double Double::MIN_VALUE) #$.Double] - [frac::min (_.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] - [frac::max (_.double Double::MAX_VALUE) #$.Double] + [frac::smallest (_.double (Double::MIN_VALUE)) #$.Double] + [frac::min (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double] + [frac::max (_.double (Double::MAX_VALUE)) #$.Double] ) (do-template [ ] diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 7b29f7283..1084c18b2 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -3,9 +3,6 @@ [control [monad (#+ do)] ["p" parser]] - [concurrency - ["." promise (#+ Promise)] - ["." task (#+ Task)]] [data ["." error] [text diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux index 0854fcaa9..a503949dd 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/extension/common.jvm.lux @@ -125,9 +125,9 @@ Nullary ( ))] - [frac::smallest Double::MIN_VALUE _.float] - [frac::min (f/* -1.0 Double::MAX_VALUE) _.float] - [frac::max Double::MAX_VALUE _.float] + [frac::smallest (Double::MIN_VALUE) _.float] + [frac::min (f/* -1.0 (Double::MAX_VALUE)) _.float] + [frac::max (Double::MAX_VALUE) _.float] ) (do-template [ ] diff --git a/stdlib/source/lux/concurrency/process.lux b/stdlib/source/lux/concurrency/process.lux index 8cb364380..e63aba14d 100644 --- a/stdlib/source/lux/concurrency/process.lux +++ b/stdlib/source/lux/concurrency/process.lux @@ -95,9 +95,7 @@ processes)] swapped? (atom.compare-and-swap! processes pending runner)] (if swapped? - (do @ - [_ (monad.seq @ ready)] - (recur [])) + (monad.seq @ ready) (error! (ex.construct cannot-continue-running-processes [])))) )))) ))) diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux index 7b07325a1..ef9030c2d 100644 --- a/stdlib/source/lux/control/order.lux +++ b/stdlib/source/lux/control/order.lux @@ -38,6 +38,6 @@ (-> (Order a) a a a)) (if (:: order y x) x y))] - [max >] [min <] + [max >] ) diff --git a/stdlib/source/lux/data/text/buffer.lux b/stdlib/source/lux/data/text/buffer.lux index 38b47e875..02b0001d0 100644 --- a/stdlib/source/lux/data/text/buffer.lux +++ b/stdlib/source/lux/data/text/buffer.lux @@ -44,7 +44,7 @@ (let [[capacity transform] (:representation buffer) append! (: (-> Text StringBuilder StringBuilder) (function (_ chunk builder) - (exec (Appendable::append [(:coerce CharSequence chunk)] + (exec (Appendable::append (:coerce CharSequence chunk) builder) builder)))] (:abstraction [(n/+ (//.size chunk) capacity) @@ -66,9 +66,9 @@ (-> Buffer Text) (for {(~~ (static _.jvm)) (let [[capacity transform] (:representation buffer)] - (|> (StringBuilder::new [(.int capacity)]) + (|> (StringBuilder::new (.int capacity)) transform - (StringBuilder::toString [])))} + StringBuilder::toString))} ## default (row/fold (function (_ chunk total) (format total chunk)) diff --git a/stdlib/source/lux/data/text/encoding.lux b/stdlib/source/lux/data/text/encoding.lux index 029505b21..de4bdf310 100644 --- a/stdlib/source/lux/data/text/encoding.lux +++ b/stdlib/source/lux/data/text/encoding.lux @@ -18,9 +18,9 @@ (def: #export (to-utf8 value) (-> Text Binary) (`` (for {(~~ (static _.jvm)) - (String::getBytes [..utf8] value)}))) + (String::getBytes ..utf8 (:coerce String value))}))) (def: #export (from-utf8 value) (-> Binary (Error Text)) (`` (for {(~~ (static _.jvm)) - (#error.Success (String::new [value ..utf8]))}))) + (#error.Success (String::new value ..utf8))}))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 26aa009b0..969935dc3 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -184,8 +184,8 @@ (List GenericType)])) (type: Partial-Call - {#pc-method Code - #pc-args Code}) + {#pc-method Name + #pc-args (List Code)}) (type: ImportMethodKind #StaticIMK @@ -960,7 +960,7 @@ (def: partial-call^ (Syntax Partial-Call) - (s.form (p.and s.any s.any))) + (s.form (p.and s.identifier (p.some s.any)))) (def: class-kind^ (Syntax Class-Kind) @@ -1271,7 +1271,7 @@ (def: (complete-call$ g!obj [method args]) (-> Code Partial-Call Code) - (` ((~ method) (~ args) (~ g!obj)))) + (` ((~ (code.identifier method)) (~+ args) (~ g!obj)))) ## [Syntax] (def: object-super-class @@ -1473,13 +1473,11 @@ (finish-the-computation ___))))} (wrap (list (` ("jvm object synchronized" (~ lock) (~ body)))))) -(syntax: #export (do-to - obj - {methods (p.some partial-call^)}) +(syntax: #export (do-to obj {methods (p.some partial-call^)}) {#.doc (doc "Call a variety of methods on an object. Then, return the object." (do-to object - (ClassName::method1 [arg0 arg1 arg2]) - (ClassName::method2 [arg3 arg4 arg5])))} + (ClassName::method1 arg0 arg1 arg2) + (ClassName::method2 arg3 arg4 arg5)))} (with-gensyms [g!obj] (wrap (list (` (let [(~ g!obj) (~ obj)] (exec (~+ (list/map (complete-call$ g!obj) methods)) @@ -1517,18 +1515,16 @@ class-tvars)) (def: (member-def-arg-bindings type-params class member) - (-> (List Type-Paramameter) Class-Declaration Import-Member-Declaration (Meta [(List Code) (List Code) (List Text) (List Code)])) + (-> (List Type-Paramameter) Class-Declaration Import-Member-Declaration (Meta [(List [Bit Code]) (List Text) (List Code)])) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] (do Monad [arg-inputs (monad.map @ - (: (-> [Bit GenericType] (Meta [Code Code])) + (: (-> [Bit GenericType] (Meta [Bit Code])) (function (_ [maybe? _]) (with-gensyms [arg-name] - (wrap [arg-name (if maybe? - (` (!!! (~ arg-name))) - arg-name)])))) + (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))) @@ -1539,13 +1535,11 @@ (if maybe? (` (Maybe (~ arg-type))) arg-type)))) - import-member-args) - arg-function-inputs (list/map product.left arg-inputs) - arg-method-inputs (list/map product.right arg-inputs)]] - (wrap [arg-function-inputs arg-method-inputs arg-classes arg-types]))) + import-member-args)]] + (wrap [arg-inputs arg-classes arg-types]))) _ - (:: Monad wrap [(list) (list) (list) (list)]))) + (:: Monad wrap [(list) (list) (list)]))) (def: (decorate-return-maybe member return-term) (-> Import-Member-Declaration Code Code) @@ -1613,14 +1607,17 @@ (` ((~' ~) (~ quoted)))) (def: (jvm-extension-inputs mode classes inputs) - (-> Primitive-Mode (List Text) (List Code) (List Code)) + (-> Primitive-Mode (List Text) (List [Bit Code]) (List Code)) (|> inputs - (list/map un-quote) + (list/map (function (_ [maybe? input]) + (if maybe? + (` ((~! !!!) (~ (un-quote input)))) + (un-quote input)))) (list.zip2 classes) (list/map (auto-convert-input mode)))) -(def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix) - (-> (List Type-Paramameter) Class-Kind Class-Declaration [(List Code) (List Code) (List Text) (List Code)] Import-Member-Declaration Text (Meta (List Code))) +(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))) (let [[full-name class-tvars] class full-name (sanitize full-name) all-params (|> (member-type-vars class-tvars member) @@ -1656,7 +1653,7 @@ (decorate-return-maybe member) (decorate-return-try member) (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ arg-function-inputs)) + (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list/map product.right arg-function-inputs))) ((~' wrap) (.list (.` (~ jvm-interop))))))))) (#MethodDecl [commons method]) @@ -1692,7 +1689,7 @@ (decorate-return-maybe member) (decorate-return-try member) (decorate-return-io member))]] - (wrap (list (` ((~! syntax:) ((~ def-name) (~+ 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) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 85db061c8..cf7d2f2d4 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -50,28 +50,28 @@ (def: #export open (Process (Console Process)) (do io.Monad - [?jvm-console (System::console [])] + [?jvm-console (System::console)] (case ?jvm-console #.None (io.fail (ex.construct cannot-open [])) (#.Some jvm-console) - (let [jvm-input System::in - jvm-output System::out] + (let [jvm-input (System::in) + jvm-output (System::out)] (<| io.from-io wrap (: (Console Process)) ## TODO: Remove ASAP (structure (def: (read _) (|> jvm-input - (InputStream::read []) + InputStream::read (:: io.Functor map .nat))) (def: (read-line _) - (|> jvm-console (java/io/Console::readLine []))) + (java/io/Console::readLine jvm-console)) (def: (write message) - (|> jvm-output (PrintStream::print [message]))) + (PrintStream::print message jvm-output)) (def: close (|>> (ex.construct cannot-close) io.fail))))))))) @@ -79,4 +79,4 @@ (def: #export (write-line message Console) (All [!] (-> Text (Console !) (! Any))) - (:: Console write (format message ""))) + (:: Console write (format message text.new-line))) diff --git a/stdlib/source/lux/world/environment.jvm.lux b/stdlib/source/lux/world/environment.jvm.lux index 019dab706..2a64c31f8 100644 --- a/stdlib/source/lux/world/environment.jvm.lux +++ b/stdlib/source/lux/world/environment.jvm.lux @@ -30,20 +30,20 @@ (def: (consume-iterator f iterator) (All [a b] (-> (-> a b) (Iterator a) (List b))) - (if (Iterator::hasNext [] iterator) - (#.Cons (f (Iterator::next [] iterator)) + (if (Iterator::hasNext iterator) + (#.Cons (f (Iterator::next iterator)) (consume-iterator f iterator)) #.Nil)) (def: (entry-to-kv entry) (All [k v] (-> (Map$Entry k v) [k v])) - [(Map$Entry::getKey [] entry) - (Map$Entry::getValue [] entry)]) + [(Map$Entry::getKey entry) + (Map$Entry::getValue entry)]) (def: #export read (IO Context) - (io (|> (System::getenv []) - (Map::entrySet []) - (Set::iterator []) + (io (|> (System::getenv) + Map::entrySet + Set::iterator (consume-iterator entry-to-kv) (dictionary.from-list text.Hash)))) -- cgit v1.2.3