diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/analysis/macro.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux | 160 | ||||
| -rw-r--r-- | stdlib/source/lux/concurrency/atom.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/concurrency/process.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/lux/data/collection/stack.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 233 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/syntax/common/reader.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/type.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/world/binary.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/world/file.lux | 40 | ||||
| -rw-r--r-- | stdlib/source/lux/world/net/tcp.jvm.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/lux/world/net/udp.jvm.lux | 20 |
13 files changed, 245 insertions, 295 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/analysis/macro.lux b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux index a674dde07..7aa9a01a4 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis/macro.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis/macro.lux @@ -33,12 +33,12 @@ (do error.Monad<Error> [apply-method (|> macro (:coerce Object) - (Object::getClass []) - (Class::getMethod ["apply" _apply-args])) - output (Method::invoke [(:coerce Object macro) - (|> (host.array Object 2) - (host.array-write 0 (:coerce Object inputs)) - (host.array-write 1 (:coerce Object state)))] + (Object::getClass) + (Class::getMethod "apply" _apply-args)) + output (Method::invoke (:coerce Object macro) + (|> (host.array Object 2) + (host.array-write 0 (:coerce Object inputs)) + (host.array-write 1 (:coerce Object state))) apply-method)] (:coerce (Error [Lux (List Code)]) output)))) diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux index 5fac5b1d0..a494b0e44 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -19,7 +19,7 @@ ["." check]] ["." macro ["s" syntax]] - ["." host]] + ["." host (#+ import:)]] [// ["." common] ["/." // @@ -34,12 +34,12 @@ {#method Type #exceptions (List Type)}) -(host.import: #long java/lang/reflect/Type +(import: #long java/lang/reflect/Type (getTypeName [] String)) (do-template [<name>] [(exception: #export (<name> {jvm-type java/lang/reflect/Type}) - (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName [] jvm-type)]))] + (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName jvm-type)]))] [jvm-type-is-not-a-class] [cannot-convert-to-a-class] @@ -421,38 +421,38 @@ _ (////.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) -(host.import: java/lang/Object +(import: java/lang/Object (equals [Object] boolean)) -(host.import: java/lang/ClassLoader) +(import: java/lang/ClassLoader) -(host.import: java/lang/reflect/GenericArrayType +(import: java/lang/reflect/GenericArrayType (getGenericComponentType [] java/lang/reflect/Type)) -(host.import: java/lang/reflect/ParameterizedType +(import: java/lang/reflect/ParameterizedType (getRawType [] java/lang/reflect/Type) (getActualTypeArguments [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/reflect/TypeVariable d) +(import: (java/lang/reflect/TypeVariable d) (getName [] String) (getBounds [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/reflect/WildcardType d) +(import: (java/lang/reflect/WildcardType d) (getLowerBounds [] (Array java/lang/reflect/Type)) (getUpperBounds [] (Array java/lang/reflect/Type))) -(host.import: java/lang/reflect/Modifier +(import: java/lang/reflect/Modifier (#static isStatic [int] boolean) (#static isFinal [int] boolean) (#static isInterface [int] boolean) (#static isAbstract [int] boolean)) -(host.import: java/lang/reflect/Field +(import: java/lang/reflect/Field (getDeclaringClass [] (java/lang/Class Object)) (getModifiers [] int) (getGenericType [] java/lang/reflect/Type)) -(host.import: java/lang/reflect/Method +(import: java/lang/reflect/Method (getName [] String) (getModifiers [] int) (getDeclaringClass [] (Class Object)) @@ -461,14 +461,14 @@ (getGenericReturnType [] java/lang/reflect/Type) (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/reflect/Constructor c) +(import: (java/lang/reflect/Constructor c) (getModifiers [] int) (getDeclaringClass [] (Class c)) (getTypeParameters [] (Array (TypeVariable (Constructor c)))) (getGenericParameterTypes [] (Array java/lang/reflect/Type)) (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/Class c) +(import: (java/lang/Class c) (getName [] String) (getModifiers [] int) (#static forName [String] #try (Class Object)) @@ -484,7 +484,7 @@ (-> Text (Operation (Class Object))) (do ////.Monad<Operation> [] - (case (Class::forName [name]) + (case (Class::forName name) (#e.Success [class]) (wrap class) @@ -496,7 +496,7 @@ (do ////.Monad<Operation> [super (load-class super) sub (load-class sub)] - (wrap (Class::isAssignableFrom [sub] super)))) + (wrap (Class::isAssignableFrom sub super)))) (def: object::throw Handler @@ -562,10 +562,10 @@ (def: (java-type-to-class jvm-type) (-> java/lang/reflect/Type (Operation Text)) (cond (host.instance? Class jvm-type) - (operation/wrap (Class::getName [] (:coerce Class jvm-type))) + (operation/wrap (Class::getName (:coerce Class jvm-type))) (host.instance? ParameterizedType jvm-type) - (java-type-to-class (ParameterizedType::getRawType [] (:coerce ParameterizedType jvm-type))) + (java-type-to-class (ParameterizedType::getRawType (:coerce ParameterizedType jvm-type))) ## else (////.throw cannot-convert-to-a-class jvm-type))) @@ -578,7 +578,7 @@ (def: (java-type-to-lux-type mappings java-type) (-> Mappings java/lang/reflect/Type (Operation Type)) (cond (host.instance? TypeVariable java-type) - (let [var-name (TypeVariable::getName [] (:coerce TypeVariable java-type))] + (let [var-name (TypeVariable::getName (:coerce TypeVariable java-type))] (case (dictionary.get var-name mappings) (#.Some var-type) (operation/wrap var-type) @@ -588,8 +588,8 @@ (host.instance? WildcardType java-type) (let [java-type (:coerce WildcardType java-type)] - (case [(array.read 0 (WildcardType::getUpperBounds [] java-type)) - (array.read 0 (WildcardType::getLowerBounds [] java-type))] + (case [(array.read 0 (WildcardType::getUpperBounds java-type)) + (array.read 0 (WildcardType::getLowerBounds java-type))] (^or [(#.Some bound) _] [_ (#.Some bound)]) (java-type-to-lux-type mappings bound) @@ -598,8 +598,8 @@ (host.instance? Class java-type) (let [java-type (:coerce (Class Object) java-type) - class-name (Class::getName [] java-type)] - (operation/wrap (case (array.size (Class::getTypeParameters [] java-type)) + class-name (Class::getName java-type)] + (operation/wrap (case (array.size (Class::getTypeParameters java-type)) 0 (#.Primitive class-name (list)) @@ -612,21 +612,21 @@ (host.instance? ParameterizedType java-type) (let [java-type (:coerce ParameterizedType java-type) - raw (ParameterizedType::getRawType [] java-type)] + raw (ParameterizedType::getRawType java-type)] (if (host.instance? Class raw) (do ////.Monad<Operation> [paramsT (|> java-type - (ParameterizedType::getActualTypeArguments []) + ParameterizedType::getActualTypeArguments array.to-list (monad.map @ (java-type-to-lux-type mappings)))] - (operation/wrap (#.Primitive (Class::getName [] (:coerce (Class Object) raw)) + (operation/wrap (#.Primitive (Class::getName (:coerce (Class Object) raw)) paramsT))) (////.throw jvm-type-is-not-a-class raw))) (host.instance? GenericArrayType java-type) (do ////.Monad<Operation> [innerT (|> (:coerce GenericArrayType java-type) - (GenericArrayType::getGenericComponentType []) + GenericArrayType::getGenericComponentType (java-type-to-lux-type mappings))] (wrap (#.Primitive "#Array" (list innerT)))) @@ -637,8 +637,8 @@ (-> (Class Object) Type (Operation Mappings)) (case type (#.Primitive name params) - (let [class-name (Class::getName [] class) - class-params (array.to-list (Class::getTypeParameters [] class)) + (let [class-name (Class::getName class) + class-params (array.to-list (Class::getTypeParameters class)) num-class-params (list.size class-params) num-type-params (list.size params)] (cond (not (text/= class-name name)) @@ -655,7 +655,7 @@ ## else (operation/wrap (|> params - (list.zip2 (list/map (TypeVariable::getName []) class-params)) + (list.zip2 (list/map (|>> TypeVariable::getName) class-params)) (dictionary.from-list text.Hash<Text>))) )) @@ -707,15 +707,15 @@ _ (////.assert cannot-cast (format "From class/primitive: " current-name text.new-line " To class/primitive: " to-name text.new-line " For value: " (%code valueC) text.new-line) - (Class::isAssignableFrom [current-class] to-class)) + (Class::isAssignableFrom current-class to-class)) candiate-parents (monad.map @ (function (_ java-type) (do @ [class-name (java-type-to-class java-type) class (load-class class-name)] - (wrap [[class-name java-type] (Class::isAssignableFrom [class] to-class)]))) - (list& (Class::getGenericSuperclass [] current-class) - (array.to-list (Class::getGenericInterfaces [] current-class))))] + (wrap [[class-name java-type] (Class::isAssignableFrom class to-class)]))) + (list& (Class::getGenericSuperclass current-class) + (array.to-list (Class::getGenericInterfaces current-class))))] (case (|> candiate-parents (list.filter product.right) (list/map product.left)) @@ -758,14 +758,14 @@ (-> Text Text (Operation [(Class Object) Field])) (do ////.Monad<Operation> [class (load-class class-name)] - (case (Class::getDeclaredField [field-name] class) + (case (Class::getDeclaredField field-name class) (#e.Success field) - (let [owner (Field::getDeclaringClass [] field)] + (let [owner (Field::getDeclaringClass field)] (if (is? owner class) (wrap [class field]) (////.throw mistaken-field-owner (format " Field: " field-name text.new-line - " Owner Class: " (Class::getName [] owner) text.new-line + " Owner Class: " (Class::getName owner) text.new-line "Target Class: " class-name text.new-line)))) (#e.Error _) @@ -775,26 +775,26 @@ (-> Text Text (Operation [Type Bit])) (do ////.Monad<Operation> [[class fieldJ] (find-field class-name field-name) - #let [modifiers (Field::getModifiers [] fieldJ)]] - (if (Modifier::isStatic [modifiers]) - (let [fieldJT (Field::getGenericType [] fieldJ)] + #let [modifiers (Field::getModifiers fieldJ)]] + (if (Modifier::isStatic modifiers) + (let [fieldJT (Field::getGenericType fieldJ)] (do @ [fieldT (java-type-to-lux-type fresh-mappings fieldJT)] - (wrap [fieldT (Modifier::isFinal [modifiers])]))) + (wrap [fieldT (Modifier::isFinal modifiers)]))) (////.throw not-a-static-field (format class-name "#" field-name))))) (def: (virtual-field class-name field-name objectT) (-> Text Text Type (Operation [Type Bit])) (do ////.Monad<Operation> [[class fieldJ] (find-field class-name field-name) - #let [modifiers (Field::getModifiers [] fieldJ)]] - (if (not (Modifier::isStatic [modifiers])) + #let [modifiers (Field::getModifiers fieldJ)]] + (if (not (Modifier::isStatic modifiers)) (do @ - [#let [fieldJT (Field::getGenericType [] fieldJ) + [#let [fieldJT (Field::getGenericType fieldJ) var-names (|> class - (Class::getTypeParameters []) + Class::getTypeParameters array.to-list - (list/map (TypeVariable::getName [])))] + (list/map (|>> TypeVariable::getName)))] mappings (: (Operation Mappings) (case objectT (#.Primitive _class-name _class-params) @@ -813,7 +813,7 @@ _ (////.throw non-object objectT))) fieldT (java-type-to-lux-type mappings fieldJT)] - (wrap [fieldT (Modifier::isFinal [modifiers])])) + (wrap [fieldT (Modifier::isFinal modifiers)])) (////.throw not-a-virtual-field (format class-name "#" field-name))))) (def: static::get @@ -901,10 +901,10 @@ (def: (java-type-to-parameter type) (-> java/lang/reflect/Type (Operation Text)) (cond (host.instance? Class type) - (operation/wrap (Class::getName [] (:coerce Class type))) + (operation/wrap (Class::getName (:coerce Class type))) (host.instance? ParameterizedType type) - (java-type-to-parameter (ParameterizedType::getRawType [] (:coerce ParameterizedType type))) + (java-type-to-parameter (ParameterizedType::getRawType (:coerce ParameterizedType type))) (or (host.instance? TypeVariable type) (host.instance? WildcardType type)) @@ -912,7 +912,7 @@ (host.instance? GenericArrayType type) (do ////.Monad<Operation> - [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:coerce GenericArrayType type)))] + [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType (:coerce GenericArrayType type)))] (wrap (format componentP "[]"))) ## else @@ -928,22 +928,22 @@ (def: (check-method class method-name method-style arg-classes method) (-> (Class Object) Text Method-Style (List Text) Method (Operation Bit)) (do ////.Monad<Operation> - [parameters (|> (Method::getGenericParameterTypes [] method) + [parameters (|> (Method::getGenericParameterTypes method) array.to-list (monad.map @ java-type-to-parameter)) - #let [modifiers (Method::getModifiers [] method)]] - (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method)) - (text/= method-name (Method::getName [] method)) + #let [modifiers (Method::getModifiers method)]] + (wrap (and (Object::equals class (Method::getDeclaringClass method)) + (text/= method-name (Method::getName method)) (case #Static #Special - (Modifier::isStatic [modifiers]) + (Modifier::isStatic modifiers) _ #1) (case method-style #Special - (not (or (Modifier::isInterface [(Class::getModifiers [] class)]) - (Modifier::isAbstract [modifiers]))) + (not (or (Modifier::isInterface (Class::getModifiers class)) + (Modifier::isAbstract modifiers))) _ #1) @@ -957,10 +957,10 @@ (def: (check-constructor class arg-classes constructor) (-> (Class Object) (List Text) (Constructor Object) (Operation Bit)) (do ////.Monad<Operation> - [parameters (|> (Constructor::getGenericParameterTypes [] constructor) + [parameters (|> (Constructor::getGenericParameterTypes constructor) array.to-list (monad.map @ java-type-to-parameter))] - (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor)) + (wrap (and (Object::equals class (Constructor::getDeclaringClass constructor)) (n/= (list.size arg-classes) (list.size parameters)) (list/fold (function (_ [expectedJC actualJC] prev) (and prev @@ -981,19 +981,19 @@ (def: (method-signature method-style method) (-> Method-Style Method (Operation Method-Signature)) - (let [owner (Method::getDeclaringClass [] method) - owner-name (Class::getName [] owner) + (let [owner (Method::getDeclaringClass method) + owner-name (Class::getName owner) owner-tvars (case method-style #Static (list) _ - (|> (Class::getTypeParameters [] owner) + (|> (Class::getTypeParameters owner) array.to-list - (list/map (TypeVariable::getName [])))) - method-tvars (|> (Method::getTypeParameters [] method) + (list/map (|>> TypeVariable::getName)))) + method-tvars (|> (Method::getTypeParameters method) array.to-list - (list/map (TypeVariable::getName []))) + (list/map (|>> TypeVariable::getName))) num-owner-tvars (list.size owner-tvars) num-method-tvars (list.size method-tvars) all-tvars (list/compose owner-tvars method-tvars) @@ -1008,11 +1008,11 @@ (list.zip2 all-tvars) (dictionary.from-list text.Hash<Text>))))] (do ////.Monad<Operation> - [inputsT (|> (Method::getGenericParameterTypes [] method) + [inputsT (|> (Method::getGenericParameterTypes method) array.to-list (monad.map @ (java-type-to-lux-type mappings))) - outputT (java-type-to-lux-type mappings (Method::getGenericReturnType [] method)) - exceptionsT (|> (Method::getGenericExceptionTypes [] method) + outputT (java-type-to-lux-type mappings (Method::getGenericReturnType method)) + exceptionsT (|> (Method::getGenericExceptionTypes method) array.to-list (monad.map @ (java-type-to-lux-type mappings))) #let [methodT (<| (type.univ-q num-all-tvars) @@ -1049,7 +1049,7 @@ (do ////.Monad<Operation> [class (load-class class-name) candidates (|> class - (Class::getDeclaredMethods []) + Class::getDeclaredMethods array.to-list (monad.map @ (: (-> Method (Operation Evaluation)) (function (_ method) @@ -1058,7 +1058,7 @@ (cond passes? (:: @ map (|>> #Pass) (method-signature method-style method)) - (text/= method-name (Method::getName [] method)) + (text/= method-name (Method::getName method)) (:: @ map (|>> #Hint) (method-signature method-style method)) ## else @@ -1075,14 +1075,14 @@ (def: (constructor-signature constructor) (-> (Constructor Object) (Operation Method-Signature)) - (let [owner (Constructor::getDeclaringClass [] constructor) - owner-name (Class::getName [] owner) - owner-tvars (|> (Class::getTypeParameters [] owner) + (let [owner (Constructor::getDeclaringClass constructor) + owner-name (Class::getName owner) + owner-tvars (|> (Class::getTypeParameters owner) array.to-list - (list/map (TypeVariable::getName []))) - constructor-tvars (|> (Constructor::getTypeParameters [] constructor) + (list/map (|>> TypeVariable::getName))) + constructor-tvars (|> (Constructor::getTypeParameters constructor) array.to-list - (list/map (TypeVariable::getName []))) + (list/map (|>> TypeVariable::getName))) num-owner-tvars (list.size owner-tvars) all-tvars (list/compose owner-tvars constructor-tvars) num-all-tvars (list.size all-tvars) @@ -1096,10 +1096,10 @@ (list.zip2 all-tvars) (dictionary.from-list text.Hash<Text>))))] (do ////.Monad<Operation> - [inputsT (|> (Constructor::getGenericParameterTypes [] constructor) + [inputsT (|> (Constructor::getGenericParameterTypes constructor) array.to-list (monad.map @ (java-type-to-lux-type mappings))) - exceptionsT (|> (Constructor::getGenericExceptionTypes [] constructor) + exceptionsT (|> (Constructor::getGenericExceptionTypes constructor) array.to-list (monad.map @ (java-type-to-lux-type mappings))) #let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT)) @@ -1115,7 +1115,7 @@ (do ////.Monad<Operation> [class (load-class class-name) candidates (|> class - (Class::getConstructors []) + Class::getConstructors array.to-list (monad.map @ (function (_ constructor) (do @ @@ -1207,7 +1207,7 @@ [#let [argsT (list/map product.left argsTC)] class (load-class class-name) _ (////.assert non-interface class-name - (Modifier::isInterface [(Class::getModifiers [] class)])) + (Modifier::isInterface (Class::getModifiers class))) [methodT exceptionsT] (method-candidate class-name method #Interface argsT) [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list/map product.right argsTC))) outputJC (check-jvm outputT)] diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/concurrency/atom.lux index c04930171..2df357124 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/concurrency/atom.lux @@ -25,18 +25,18 @@ (def: #export (atom value) (All [a] (-> a (Atom a))) (:abstraction (for {(~~ (static host.jvm)) - (AtomicReference::new [value])}))) + (AtomicReference::new value)}))) (def: #export (read atom) (All [a] (-> (Atom a) (IO a))) (io (for {(~~ (static host.jvm)) - (AtomicReference::get [] (:representation atom))}))) + (AtomicReference::get (:representation atom))}))) (def: #export (compare-and-swap current new atom) {#.doc (doc "Only mutates an atom if you can present it's current value." "That guarantees that atom was not updated since you last read from it.")} (All [a] (-> a a (Atom a) (IO Bit))) - (io (AtomicReference::compareAndSet [current new] (:representation atom)))) + (io (AtomicReference::compareAndSet current new (:representation atom)))) )) (def: #export (update f atom) diff --git a/stdlib/source/lux/concurrency/process.lux b/stdlib/source/lux/concurrency/process.lux index 2ff56c395..8cb364380 100644 --- a/stdlib/source/lux/concurrency/process.lux +++ b/stdlib/source/lux/concurrency/process.lux @@ -43,14 +43,14 @@ (def: #export parallelism Nat (`` (for {(~~ (static host.jvm)) - (|> (Runtime::getRuntime []) - (Runtime::availableProcessors []) + (|> (Runtime::getRuntime) + (Runtime::availableProcessors) .nat)} 1))) (def: runner (`` (for {(~~ (static host.jvm)) - (ScheduledThreadPoolExecutor::new [(.int ..parallelism)])} + (ScheduledThreadPoolExecutor::new (.int ..parallelism))} (: (Atom (List Process)) (atom.atom (list)))))) @@ -63,9 +63,8 @@ (Runnable [] (run) void (io.run action)))] (case milli-seconds - 0 (Executor::execute [runnable] - runner) - _ (ScheduledThreadPoolExecutor::schedule [runnable (.int milli-seconds) TimeUnit::MILLISECONDS] + 0 (Executor::execute runnable runner) + _ (ScheduledThreadPoolExecutor::schedule runnable (.int milli-seconds) TimeUnit::MILLISECONDS runner)))} (atom.update (|>> (#.Cons {#creation ("lux io current-time") #delay milli-seconds diff --git a/stdlib/source/lux/data/collection/stack.lux b/stdlib/source/lux/data/collection/stack.lux index eec2aae23..6a7e5a215 100644 --- a/stdlib/source/lux/data/collection/stack.lux +++ b/stdlib/source/lux/data/collection/stack.lux @@ -31,13 +31,13 @@ (#.Some value))) (def: #export (pop stack) - (All [a] (-> (Stack a) (Stack a))) + (All [a] (-> (Stack a) (Maybe (Stack a)))) (case stack #.Nil - #.Nil + #.None (#.Cons _ stack') - stack')) + (#.Some stack'))) (def: #export (push value stack) (All [a] (-> a (Stack a) (Stack a))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index b5a2454e1..a91ef498c 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1547,50 +1547,36 @@ _ (:: Monad<Meta> wrap [(list) (list) (list) (list)]))) -(def: (member-def-return mode type-params class member) - (-> Primitive-Mode (List Type-Paramameter) Class-Declaration Import-Member-Declaration (Meta Code)) - (case member - (#ConstructorDecl _) - (:: Monad<Meta> wrap (class-decl-type$ class)) - - (#MethodDecl [_ method]) - (:: Monad<Meta> wrap (class->type mode type-params (get@ #import-method-return method))) - - _ - (macro.fail "Only methods have return values."))) - -(def: (decorate-return-maybe member [return-type return-term]) - (-> Import-Member-Declaration [Code Code] [Code Code]) +(def: (decorate-return-maybe member return-term) + (-> Import-Member-Declaration Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ #import-member-maybe? commons) - [(` (Maybe (~ return-type))) - (` (??? (~ return-term)))] - [return-type - (let [g!temp (code.identifier ["" " Ω "])] - (` (let [(~ g!temp) (~ return-term)] - (if (not (null? (:coerce (primitive "java.lang.Object") - (~ g!temp)))) - (~ g!temp) - (error! "Cannot produce null references from method calls.")))))]) + (` (??? (~ return-term))) + (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] + (` (let [(~ g!temp) (~ return-term)] + (if (not (null? (:coerce (primitive "java.lang.Object") + (~ g!temp)))) + (~ g!temp) + (error! "Cannot produce null references from method calls.")))))) _ - [return-type return-term])) + return-term)) -(do-template [<name> <tag> <type-trans> <term-trans>] - [(def: (<name> member [return-type return-term]) - (-> Import-Member-Declaration [Code Code] [Code Code]) +(do-template [<name> <tag> <term-trans>] + [(def: (<name> member return-term) + (-> Import-Member-Declaration Code Code) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ <tag> commons) - [<type-trans> <term-trans>] - [return-type return-term]) + <term-trans> + return-term) _ - [return-type return-term]))] + return-term))] - [decorate-return-try #import-member-try? (` ((~! error.Error) (~ return-type))) (` (..try (~ return-term)))] - [decorate-return-io #import-member-io? (` ((~! io.IO) (~ return-type))) (` ((~! io.io) (~ return-term)))] + [decorate-return-try #import-member-try? (` (..try (~ return-term)))] + [decorate-return-io #import-member-io? (` ((~! io.io) (~ return-term)))] ) (def: (free-type-param? [name bounds]) @@ -1603,58 +1589,24 @@ (-> Type-Paramameter Code) (code.identifier ["" name])) -(def: (with-mode-output mode output-type body) - (-> Primitive-Mode GenericType Code Code) - (case mode - #ManualPrM - body - - #AutoPrM - (case output-type - (#GenericClass ["byte" _]) - (` (byte-to-long (~ body))) - - (#GenericClass ["short" _]) - (` (short-to-long (~ body))) - - (#GenericClass ["int" _]) - (` (int-to-long (~ body))) - - (#GenericClass ["float" _]) - (` (float-to-double (~ body))) - - _ - body))) - -(def: (auto-conv-class? class) - (-> Text Bit) - (case class - (^or "byte" "short" "int" "float") - #1 - - _ - #0)) - -(def: (auto-conv [class var]) - (-> [Text Code] (List Code)) - (case class - "byte" (list var (` (long-to-byte (~ var)))) - "short" (list var (` (long-to-short (~ var)))) - "int" (list var (` (long-to-int (~ var)))) - "float" (list var (` (double-to-float (~ var)))) - _ (list))) - -(def: (with-mode-inputs mode inputs body) - (-> Primitive-Mode (List [Text Code]) Code Code) - (case mode - #ManualPrM - body - - #AutoPrM - (` (let [(~+ (|> inputs - (list/map auto-conv) - list/join))] - (~ body))))) +(do-template [<name> <byte> <short> <int> <float>] + [(def: (<name> mode [class expression]) + (-> Primitive-Mode [Text Code] Code) + (case mode + #ManualPrM + expression + + #AutoPrM + (case class + "byte" (` (<byte> (~ expression))) + "short" (` (<short> (~ expression))) + "int" (` (<int> (~ expression))) + "float" (` (<float> (~ expression))) + _ expression)))] + + [auto-convert-input long-to-byte long-to-short long-to-int double-to-float] + [auto-convert-output byte-to-long short-to-long int-to-long float-to-double] + ) (def: (with-mode-field-get mode class output) (-> Primitive-Mode GenericType Code Code) @@ -1684,6 +1636,17 @@ "float" (` (double-to-float (~ g!input))) _ g!input))) +(def: (un-quote quoted) + (-> Code Code) + (` ((~' ~) (~ quoted)))) + +(def: (jvm-extension-inputs mode classes inputs) + (-> Primitive-Mode (List Text) (List Code) (List Code)) + (|> inputs + (list/map un-quote) + (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))) (let [[full-name class-tvars] class @@ -1714,63 +1677,51 @@ (#ConstructorDecl [commons _]) (do Monad<Meta> - [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) - #let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) - def-params (list (code.tuple arg-function-inputs)) - jvm-interop (|> (` ((~ (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes)))) - (~+ arg-method-inputs))) - (with-mode-inputs (get@ #import-member-mode commons) - (list.zip2 arg-classes arg-function-inputs))) - [return-type jvm-interop] (|> [return-type jvm-interop] - (decorate-return-maybe member) - (decorate-return-try member) - (decorate-return-io member))]] - (wrap (list (` (def: ((~ def-name) (~+ def-params)) - (All [(~+ all-params)] (-> [(~+ arg-types)] (~ return-type))) - (~ jvm-interop)))))) + [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) + jvm-extension (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes))) + jvm-interop (|> (` ((~ jvm-extension) + (~+ (jvm-extension-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs)))) + (decorate-return-maybe member) + (decorate-return-try member) + (decorate-return-io member))]] + (wrap (list (` ((~! syntax:) ((~ def-name) (~+ arg-function-inputs)) + ((~' wrap) (.list (.` (~ jvm-interop))))))))) (#MethodDecl [commons method]) (with-gensyms [g!obj] (do @ - [return-type (member-def-return (get@ #import-member-mode commons) type-params class member) - #let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))]) + [#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 obj-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))] - ))) - def-params (#.Cons (code.tuple arg-function-inputs) obj-ast) - def-param-types (#.Cons (` [(~+ arg-types)]) class-ast) - jvm-interop (|> (` ((~ (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name - ":" (text.join-with "," arg-classes)))) - (~+ obj-ast) (~+ arg-method-inputs))) - (with-mode-output (get@ #import-member-mode commons) - (get@ #import-method-return method)) - (with-mode-inputs (get@ #import-member-mode commons) - (list.zip2 arg-classes arg-function-inputs))) - [return-type jvm-interop] (|> [return-type jvm-interop] - (decorate-return-maybe member) - (decorate-return-try member) - (decorate-return-io member))]] - (wrap (list (` (def: ((~ def-name) (~+ def-params)) - (All [(~+ all-params)] (-> (~+ def-param-types) (~ return-type))) - (~ jvm-interop))))))) + [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-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-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) (~+ arg-function-inputs) (~+ object-ast)) + ((~' wrap) (.list (.` (~ jvm-interop)))))))))) (#FieldAccessDecl fad) (do Monad<Meta> @@ -1874,11 +1825,11 @@ {#.doc (doc "Allows importing JVM classes, and using them as types." "Their methods, fields and enum options can also be imported." "Also, classes which get imported into a module can also be referred-to with their short names in other macros that require JVM classes." - "Examples:" (import: java/lang/Object (new []) (equals [Object] boolean) (wait [int] #io #try void)) + "Special options can also be given for the return values." "#? means that the values will be returned inside a Maybe type. That way, null becomes #.None." "#try means that the computation might throw an exception, and the return value will be wrapped by the Error type." @@ -1895,23 +1846,23 @@ (import: (java/util/ArrayList a) ([T] toArray [(Array T)] (Array T))) + "#long makes it so the class-type that is generated is of the fully-qualified name." "In this case, it avoids a clash between the java.util.List type, and Lux's own List type." + "All enum options to be imported must be specified." (import: java/lang/Character$UnicodeScript (#enum ARABIC CYRILLIC LATIN)) - "All enum options to be imported must be specified." + "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters." + "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." (import: #long (lux/concurrency/promise/JvmPromise A) (resolve [A] boolean) (poll [] A) (wasResolved [] boolean) (waitOn [lux/Function] void) (#static [A] make [A] (JvmPromise A))) - "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-parameters." - "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)." - "Also, the names of the imported members will look like ClassName.MemberName." - "E.g.:" + "Also, the names of the imported members will look like Class::member" (Object::new []) (Object::equals [other-object] my-object) (java/util/List::size [] my-list) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 83137cef0..07b0a4b9e 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -244,7 +244,7 @@ (wrap [var parser]) [_ (#.Identifier var-name)] - (wrap [(code.identifier var-name) (` any)]) + (wrap [(code.identifier var-name) (` (~! any))]) _ (//.fail "Syntax pattern expects records or identifiers.")))) @@ -262,13 +262,13 @@ (#error.Error (~ g!error)) (#error.Error ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))} - (..run (~ g!tokens) - (: (..Syntax (Meta (List Code))) - ((~! do) (~! p.Monad<Parser>) - [(~+ (join-pairs vars+parsers))] - ((~' wrap) ((~! do) (~! //.Monad<Meta>) - [] - (~ body))))))))))))) + ((~! ..run) (~ g!tokens) + (: ((~! ..Syntax) (Meta (List Code))) + ((~! do) (~! p.Monad<Parser>) + [(~+ (join-pairs vars+parsers))] + ((~' wrap) ((~! do) (~! //.Monad<Meta>) + [] + (~ body))))))))))))) _ (//.fail "Wrong syntax for syntax:")))) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index 0d172fa88..af3b584b8 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -90,6 +90,7 @@ (def: (find-definition-args meta-data) (-> (List [Name Code]) (List Text)) (<| (maybe.default (list)) + (: (Maybe (List Text))) (case (list.find (|>> product.left (name/= ["lux" "func-args"])) meta-data) (^multi (#.Some [_ value]) [(p.run (list value) tuple-meta^) @@ -99,8 +100,7 @@ (#.Some args) _ - #.None) - )) + #.None))) (def: #export (definition compiler) {#.doc "A reader that first macro-expands and then analyses the input Code, to ensure it's a definition."} diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index ff614a328..e010c2a98 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -347,7 +347,7 @@ #let [_ (log! ($_ text/compose ":log!" " @ " (.cursor-description cursor) text.new-line (name/encode valueN) " : " (..to-text valueT) text.new-line))]] - (wrap (list (' [])))) + (wrap (list (code.identifier valueN)))) (#.Right valueC) (macro.with-gensyms [g!value] diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux index 1821c61b9..f3ee40042 100644 --- a/stdlib/source/lux/world/binary.lux +++ b/stdlib/source/lux/world/binary.lux @@ -143,7 +143,7 @@ (ex.throw index-out-of-bounds <description>) ## else - (#error.Success (Arrays::copyOfRange [binary (:coerce Int from) (:coerce Int (inc to))])))))) + (#error.Success (Arrays::copyOfRange binary (:coerce Int from) (:coerce Int (inc to)))))))) (def: #export (slice' from binary) (-> Nat Binary (Error Binary)) @@ -151,10 +151,10 @@ (structure: #export _ (eq.Equivalence Binary) (def: (= reference sample) - (Arrays::equals [reference sample]))) + (Arrays::equals reference sample))) (def: #export (copy bytes source-offset source target-offset target) (-> Nat Nat Binary Nat Binary (Error Binary)) (do error.Monad<Error> - [_ (System::arraycopy [source (.int source-offset) target (.int target-offset) (.int bytes)])] + [_ (System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))] (wrap target))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 76f03a835..1f1d9eabd 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -150,10 +150,10 @@ (do-template [<name> <flag>] [(def: (<name> data file) (do io.Monad<Process> - [stream (FileOutputStream::new [(java/io/File::new file) <flag>]) - _ (OutputStream::write [data] stream) - _ (OutputStream::flush [] stream)] - (AutoCloseable::close [] stream)))] + [stream (FileOutputStream::new (java/io/File::new file) <flag>) + _ (OutputStream::write data stream) + _ (OutputStream::flush stream)] + (AutoCloseable::close stream)))] [append #1] [write #0] @@ -162,33 +162,33 @@ (def: (read file) (do io.Monad<Process> [#let [file' (java/io/File::new file)] - size (java/io/File::length [] file') + size (java/io/File::length file') #let [data (binary.create (.nat size))] - stream (FileInputStream::new [file']) - bytes-read (InputStream::read [data] stream) - _ (AutoCloseable::close [] stream)] + stream (FileInputStream::new file') + bytes-read (InputStream::read data stream) + _ (AutoCloseable::close stream)] (if (i/= size bytes-read) (wrap data) (io.io (ex.throw cannot-read-all-data file))))) (def: size - (|>> [] java/io/File::new - (java/io/File::length []) + (|>> java/io/File::new + java/io/File::length (:: io.Monad<Process> map .nat))) (def: (files dir) (do io.Monad<Process> - [?files (java/io/File::listFiles [] (java/io/File::new dir))] + [?files (java/io/File::listFiles (java/io/File::new dir))] (case ?files (#.Some files) - (monad.map @ (java/io/File::getAbsolutePath []) + (monad.map @ (|>> java/io/File::getAbsolutePath) (array.to-list files)) #.None (io.throw not-a-directory dir)))) (do-template [<name> <method>] - [(def: <name> (|>> [] java/io/File::new (<method> [])))] + [(def: <name> (|>> java/io/File::new <method>))] [file? java/io/File::isFile] [directory? java/io/File::isDirectory] @@ -197,19 +197,19 @@ (def: (can? permission file) (let [jvm-file (java/io/File::new file)] (case permission - #Read (java/io/File::canRead [] jvm-file) - #Write (java/io/File::canWrite [] jvm-file) - #Execute (java/io/File::canExecute [] jvm-file)))) + #Read (java/io/File::canRead jvm-file) + #Write (java/io/File::canWrite jvm-file) + #Execute (java/io/File::canExecute jvm-file)))) (def: last-modified - (|>> [] java/io/File::new - (java/io/File::lastModified []) + (|>> java/io/File::new + (java/io/File::lastModified) (:: io.Monad<Process> map (|>> duration.from-millis instant.absolute)))) (do-template [<name> <exception> <method>] [(def: (<name> subject) (do io.Monad<IO> - [outcome (<method> [] (java/io/File::new subject))] + [outcome (<method> (java/io/File::new subject))] (case outcome (#error.Success #1) (wrap (#error.Success [])) @@ -224,7 +224,7 @@ (do-template [<name> <exception> <method> <parameter-pre>] [(def: (<name> parameter subject) (do io.Monad<IO> - [outcome (<method> [(|> parameter <parameter-pre>)] + [outcome (<method> (|> parameter <parameter-pre>) (java/io/File::new subject))] (case outcome (#error.Success #1) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index ee866203e..50191c407 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -50,7 +50,7 @@ (-> Binary Nat Nat TCP (Task Nat)) (promise.future (do io.Monad<Process> - [bytes-read (InputStream::read [data (.int offset) (.int length)] + [bytes-read (InputStream::read data (.int offset) (.int length) (get@ #in (:representation self)))] (wrap (.nat bytes-read))))) @@ -59,24 +59,24 @@ (let [out (get@ #out (:representation self))] (promise.future (do io.Monad<Process> - [_ (OutputStream::write [data (.int offset) (.int length)] + [_ (OutputStream::write data (.int offset) (.int length) out)] - (Flushable::flush [] out))))) + (Flushable::flush out))))) (def: #export (close self) (-> TCP (Task Any)) (let [(^open ".") (:representation self)] (promise.future (do io.Monad<Process> - [_ (AutoCloseable::close [] in) - _ (AutoCloseable::close [] out)] - (AutoCloseable::close [] socket))))) + [_ (AutoCloseable::close in) + _ (AutoCloseable::close out)] + (AutoCloseable::close socket))))) (def: (tcp-client socket) (-> Socket (Process TCP)) (do io.Monad<Process> - [input (Socket::getInputStream [] socket) - output (Socket::getOutputStream [] socket)] + [input (Socket::getInputStream socket) + output (Socket::getOutputStream socket)] (wrap (:abstraction {#socket socket #in input #out output})))) @@ -86,7 +86,7 @@ (-> //.Address //.Port (Task TCP)) (promise.future (do io.Monad<Process> - [socket (Socket::new [address (.int port)])] + [socket (Socket::new address (.int port))] (tcp-client socket)))) (def: #export (server port) @@ -94,11 +94,11 @@ (frp.Channel TCP)])) (promise.future (do (e.ErrorT io.Monad<IO>) - [server (ServerSocket::new [(.int port)]) + [server (ServerSocket::new (.int port)) #let [signal (: (Promise Any) (promise #.None)) _ (promise.await (function (_ _) - (AutoCloseable::close [] server)) + (AutoCloseable::close server)) signal) output (: (frp.Channel TCP) (frp.channel [])) @@ -107,7 +107,7 @@ (loop [_ []] (do io.Monad<IO> [?client (do (e.ErrorT io.Monad<IO>) - [socket (ServerSocket::accept [] server)] + [socket (ServerSocket::accept server)] (tcp-client socket))] (case ?client (#e.Error error) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index e8eeb1b1b..8b785eb98 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -55,7 +55,7 @@ (def: (resolve address) (-> //.Address (io.IO (e.Error InetAddress))) (do (e.ErrorT io.Monad<IO>) - [addresses (InetAddress::getAllByName [address])] + [addresses (InetAddress::getAllByName address)] (: (io.IO (e.Error InetAddress)) (case (array.size addresses) 0 (io.io (ex.throw cannot-resolve-address address)) @@ -68,14 +68,14 @@ (def: #export (read data offset length self) (-> Binary Nat Nat UDP (T.Task [Nat //.Address //.Port])) (let [(^open ".") (:representation self) - packet (DatagramPacket::new|receive [data (.int offset) (.int length)])] + packet (DatagramPacket::new|receive data (.int offset) (.int length))] (P.future (do (e.ErrorT io.Monad<IO>) - [_ (DatagramSocket::receive [packet] socket) - #let [bytes-read (.nat (DatagramPacket::getLength [] packet))]] + [_ (DatagramSocket::receive packet socket) + #let [bytes-read (.nat (DatagramPacket::getLength packet))]] (wrap [bytes-read - (|> packet (DatagramPacket::getAddress []) (InetAddress::getHostAddress [])) - (.nat (DatagramPacket::getPort [] packet))]))))) + (|> packet DatagramPacket::getAddress InetAddress::getHostAddress) + (.nat (DatagramPacket::getPort packet))]))))) (def: #export (write address port data offset length self) (-> //.Address //.Port Binary Nat Nat UDP (T.Task Any)) @@ -83,26 +83,26 @@ (do (e.ErrorT io.Monad<IO>) [address (resolve address) #let [(^open ".") (:representation self)]] - (DatagramSocket::send (DatagramPacket::new|send [data (.int offset) (.int length) address (.int port)]) + (DatagramSocket::send (DatagramPacket::new|send data (.int offset) (.int length) address (.int port)) socket)))) (def: #export (close self) (-> UDP (T.Task Any)) (let [(^open ".") (:representation self)] (P.future - (AutoCloseable::close [] socket)))) + (AutoCloseable::close socket)))) (def: #export (client _) (-> Any (T.Task UDP)) (P.future (do (e.ErrorT io.Monad<IO>) - [socket (DatagramSocket::new|client [])] + [socket (DatagramSocket::new|client)] (wrap (:abstraction (#socket socket)))))) (def: #export (server port) (-> //.Port (T.Task UDP)) (P.future (do (e.ErrorT io.Monad<IO>) - [socket (DatagramSocket::new|server [(.int port)])] + [socket (DatagramSocket::new|server (.int port))] (wrap (:abstraction (#socket socket)))))) ) |