diff options
| -rw-r--r-- | luxc/src/lux/analyser/lux.clj | 11 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/cache.clj | 2 | ||||
| -rw-r--r-- | luxc/src/lux/type.clj | 44 | ||||
| -rw-r--r-- | stdlib/source/lux/concurrency/actor.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/lux/concurrency/frp.lux | 17 | ||||
| -rw-r--r-- | stdlib/source/lux/concurrency/promise.lux | 62 | ||||
| -rw-r--r-- | stdlib/source/lux/concurrency/stm.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/lux/data/lazy.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 142 | ||||
| -rw-r--r-- | stdlib/source/lux/world/net/tcp.jvm.lux | 3 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/frp.lux | 4 |
11 files changed, 131 insertions, 191 deletions
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 07cf17d2f..18941a0e3 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -428,8 +428,7 @@ (&/fold% (fn [_func _inf-var] (|do [:let [$inf-var (&/$Var _inf-var)] =inf-var (&type/resolve-type $inf-var) - _func* (clean-func-inference $inf-var $output =inf-var _func) - _ (&type/delete-var _inf-var)] + _func* (clean-func-inference $inf-var $output =inf-var _func)] (return _func*))) =func (unravel-inf-appt =input)) @@ -438,8 +437,7 @@ (&/fold% (fn [_func _inf-var] (|do [:let [$inf-var (&/$Var _inf-var)] =inf-var (&type/resolve-type $inf-var) - _func* (clean-func-inference $inf-var $output =inf-var _func) - _ (&type/delete-var _inf-var)] + _func* (clean-func-inference $inf-var $output =inf-var _func)] (return _func*))) =func (&/|reverse (&type/flatten-prod =input))) @@ -545,11 +543,6 @@ _ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value)) _ (&&module/test-macro module-name ?name ==meta (&&/expr-type* =value)) _ (compile-def ?name (optimize =value) ==meta) - ;; TODO: Make the call to &type/reset-mappings unnecessary. - ;; It should not be necessary to reset the mappings of the - ;; type-vars, because those mappings should not stay around - ;; after being cleaned-up. - ;; I must figure out why they're staying around. _ &type/reset-mappings] (return &/$Nil))) diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index 4ec18798e..a0b2b0588 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -229,7 +229,7 @@ (return nil))) (defn ^:private inject-module - "(-> (Module Compiler) (-> Compiler (Lux Null)))" + "(-> Module Compiler (Lux Null))" [module-name module] (fn [compiler] (return* (&/update$ &/$modules diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj index 0834db3a6..897b3bc67 100644 --- a/luxc/src/lux/type.clj +++ b/luxc/src/lux/type.clj @@ -242,7 +242,7 @@ (fn [state] (if-let [tvar (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))] (return* (&/update$ &/$type-context (fn [ts] (&/update$ &/$var-bindings #(&/|put id &/$None %) - ts)) + ts)) state) nil) ((&/fail-with-loc (str "[Type Error] Unknown type-var: " id " | " (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) &/|length))) @@ -253,7 +253,7 @@ (def reset-mappings (fn [state] (return* (&/update$ &/$type-context #(->> % - ;; (&/set$ &/$var-counter 0) + (&/set$ &/$var-counter 0) (&/set$ &/$var-bindings (&/|table))) state) nil))) @@ -279,45 +279,9 @@ (&/get$ &/$ex-counter) &/$Ex)))) -(declare clean*) -(defn delete-var [id] - (|do [? (bound? id) - _ (if ? - (return nil) - (|do [ex existential] - (set-var id ex)))] - (fn [state] - ((|do [mappings* (&/map% (fn [binding] - (|let [[?id ?type] binding] - (if (= id ?id) - (return binding) - (|case ?type - (&/$None) - (return binding) - - (&/$Some ?type*) - (|case ?type* - (&/$Var ?id*) - (if (= id ?id*) - (return (&/T [?id &/$None])) - (return binding)) - - _ - (|do [?type** (clean* id ?type*)] - (return (&/T [?id (&/$Some ?type**)])))) - )))) - (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings)))] - (fn [state] - (return* (&/update$ &/$type-context #(&/set$ &/$var-bindings (&/|remove id mappings*) %) - state) - nil))) - state)))) - (defn with-var [k] - (|do [id create-var - output (k (&/$Var id)) - _ (delete-var id)] - (return output))) + (|do [id create-var] + (k (&/$Var id)))) (defn clean* [?tid type] (|case type diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index b326d0028..f91b3c57f 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -50,12 +50,9 @@ {#.doc "Given a behavior and initial state, spawns an actor and returns it."} (All [s] (-> (Behavior s) s (IO (Actor s)))) (io (let [[handle end] behavior - self (: (Actor ($ +0)) - (@abstract {#mailbox (stm.var (:! (Message ($ +0)) [])) - #kill-switch (: (P.Promise Unit) - (P.promise #.None)) - #obituary (: (P.Promise (Obituary ($ +0))) - (P.promise #.None))})) + self (@abstract {#mailbox (stm.var (:! Message [])) + #kill-switch (P.promise #.None) + #obituary (P.promise #.None)}) mailbox-channel (io.run (stm.follow (get@ #mailbox (@repr self)))) |mailbox| (stm.var mailbox-channel) _ (P/map (function [_] diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index 230eca335..533d2a7e5 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -20,11 +20,10 @@ (&.Promise (Maybe [a (Channel a)]))) ## [Syntax] -(syntax: #export (channel [type s.any]) - {#.doc (doc "Makes an uninitialized Channel (in this case, of Nat)." - (channel Nat))} - (wrap (list (` (: (Channel (~ type)) - (&.promise #.None)))))) +(syntax: #export (channel) + {#.doc (doc "Makes an uninitialized Channel." + (channel))} + (wrap (list (` (&.promise #.None))))) ## [Values] (def: #export (filter p xs) @@ -44,7 +43,7 @@ (^template [<case> <channel-to-write>] <case> (do Monad<IO> - [#let [new-tail (channel ($ +0))] + [#let [new-tail (channel)] done? (&.resolve (#.Some [value new-tail]) <channel-to-write>)] (if done? (wrap (#.Some new-tail)) @@ -97,7 +96,7 @@ (def: #export (merge xss) {#.doc "Fuse all the elements in a list of channels by piping them onto a new output channel."} (All [a] (-> (List (Channel a)) (Channel a))) - (let [output (channel ($ +0))] + (let [output (channel)] (exec (do &.Monad<Promise> [_ (M.map @ (function [input] (pipe' input output)) xss)] (exec (io.run (close output)) @@ -293,7 +292,7 @@ (wrap (#.Some [a (wrap #.None)])))) (def: (apply ff fa) - (let [fb (channel ($ +1))] + (let [fb (channel)] (exec (let [(^open) Functor<Channel>] (map (function [f] (pipe (map f fa) fb)) ff)) @@ -303,7 +302,7 @@ (def: applicative Applicative<Channel>) (def: (join mma) - (let [output (channel ($ +0))] + (let [output (channel)] (exec (let [(^open) Functor<Channel>] (map (function [ma] (pipe ma output)) diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 2de5fa2c8..d45e8e55a 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -1,16 +1,10 @@ (.module: lux - (lux (data (coll [list #* "" Functor<List>]) - number - text/format) - [io #- run] - function - (control ["F" functor] - ["A" applicative] - ["M" monad #+ do Monad] - ["p" parser]) - [macro] - (macro ["s" syntax #+ syntax: Syntax]) + (lux [io #+ IO io] + [function] + (control [functor #+ Functor] + [applicative #+ Applicative] + [monad #+ do Monad]) (concurrency [atom #+ Atom atom]))) (def: #export concurrency-level @@ -31,14 +25,14 @@ #observers (list)})) (def: #export (poll promise) - {#.doc "Polls a Promise's value."} + {#.doc "Polls a promise's value."} (All [a] (-> (Promise a) (Maybe a))) (|> (atom.read promise) io.run (get@ #value))) (def: #export (resolved? promise) - {#.doc "Checks whether a Promise's value has already been resolved."} + {#.doc "Checks whether a promise's value has already been resolved."} (All [a] (-> (Promise a) Bool)) (case (poll promise) #.None @@ -48,9 +42,9 @@ true)) (def: #export (resolve value promise) - {#.doc "Sets an Promise's value if it has not been done yet."} + {#.doc "Sets an promise's value if it has not been done yet."} (All [a] (-> a (Promise a) (IO Bool))) - (do Monad<IO> + (do io.Monad<IO> [old (atom.read promise)] (case (get@ #value old) (#.Some _) @@ -62,8 +56,8 @@ succeeded? (atom.compare-and-swap old new promise)] (if succeeded? (do @ - [_ (M.map @ (function [f] (f value)) - (get@ #observers old))] + [_ (monad.map @ (function [f] (f value)) + (get@ #observers old))] (wrap true)) (resolve value promise)))))) @@ -80,16 +74,14 @@ [] (await f promise)))))) -(struct: #export _ (F.Functor Promise) +(struct: #export _ (Functor Promise) (def: (map f fa) - (let [fb (: (Promise ($ +1)) (promise #.None)) - ## fb (promise' #.None) - ] + (let [fb (promise #.None)] (exec (await (function [a] (resolve (f a) fb)) fa) fb)))) -(struct: #export _ (A.Applicative Promise) +(struct: #export _ (Applicative Promise) (def: functor Functor<Promise>) (def: (wrap a) @@ -97,9 +89,7 @@ #observers (list)})) (def: (apply ff fa) - (let [fb (: (Promise ($ +1)) (promise #.None)) - ## fb (promise' #.None) - ] + (let [fb (promise #.None)] (exec (await (function [f] (io (await (function [a] (resolve (f a) fb)) fa))) @@ -111,9 +101,7 @@ (def: applicative Applicative<Promise>) (def: (join mma) - (let [ma (: (Promise ($ +0)) (promise #.None)) - ## ma (promise' #.None) - ] + (let [ma (promise #.None)] (exec (await (function [ma'] (io (await (function [a'] (resolve a' ma)) ma'))) @@ -131,9 +119,7 @@ (def: #export (alt left right) {#.doc "Heterogeneous alternative combinator."} (All [a b] (-> (Promise a) (Promise b) (Promise (| a b)))) - (let [a|b (: (Promise (| ($ +0) ($ +1))) (promise #.None)) - ## a|b (promise' #.None) - ] + (let [a|b (promise #.None)] (with-expansions [<sides> (do-template [<promise> <tag>] [(await (function [value] (resolve (<tag> value) a|b)) @@ -148,9 +134,7 @@ (def: #export (either left right) {#.doc "Homogeneous alternative combinator."} (All [a] (-> (Promise a) (Promise a) (Promise a))) - (let [left||right (: (Promise ($ +0)) (promise #.None)) - ## left||right (promise' #.None) - ] + (let [left||right (promise #.None)] (`` (exec (~~ (do-template [<promise>] [(await (function [value] (resolve value left||right)) <promise>)] @@ -162,26 +146,24 @@ (def: #export (future computation) {#.doc "Runs an I/O computation on its own process and returns an Promise that will eventually host its result."} (All [a] (-> (IO a) (Promise a))) - (let [!out (: (Promise ($ +0)) (promise #.None)) - ## !out (promise' #.None) - ] + (let [!out (promise #.None)] (exec ("lux process future" (io (io.run (resolve (io.run computation) !out)))) !out))) (def: #export (wait time) - {#.doc "Returns a Promise that will be resolved after the specified amount of milliseconds."} + {#.doc "Returns a promise that will be resolved after the specified amount of milliseconds."} (-> Nat (Promise Unit)) (let [!out (: (Promise Unit) (promise #.None))] (exec ("lux process schedule" time (resolve [] !out)) !out))) (def: #export (time-out time promise) - {#.doc "Wait for a Promise to be resolved within the specified amount of milliseconds."} + {#.doc "Wait for a promise to be resolved within the specified amount of milliseconds."} (All [a] (-> Nat (Promise a) (Promise (Maybe a)))) (alt (wait time) promise)) (def: #export (delay time value) {#.doc "Delivers a value after a certain period has passed."} (All [a] (-> Nat a (Promise a))) - (:: Functor<Promise> map (const value) (wait time))) + (:: Functor<Promise> map (function.const value) (wait time))) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index cc39ae0c3..0fe9ee9df 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -57,7 +57,8 @@ (:! (Var Unit) _var)))) (:: Monad<Maybe> map (function [[_var _original _current]] _current)) - (:! (Maybe ($ +0))))) + (:!!) + )) (def: #export (read var) (All [a] (-> (Var a) (STM a))) @@ -85,13 +86,15 @@ #.Nil (#.Cons [_var _original _current] tx') - (if (is (:! (Var ($ +0)) var) - (:! (Var ($ +0)) _var)) - (#.Cons [(:! (Var ($ +0)) _var) - (:! ($ +0) _original) - (:! ($ +0) value)] + (if (is (:! (Var Unit) var) + (:! (Var Unit) _var)) + (#.Cons {#var (:! (Var Unit) _var) + #original (:! Unit _original) + #current (:! Unit value)} tx') - (#.Cons [_var _original _current] + (#.Cons {#var _var + #original _original + #current _current} (update-tx-value var value tx'))) )) @@ -127,7 +130,8 @@ (def: #export (follow target) {#.doc "Creates a channel that will receive all changes to the value of the given var."} (All [a] (-> (Var a) (IO (frp.Channel a)))) - (let [head (frp.channel ($ +0)) + (let [head (: (frp.Channel ($ +0)) (frp.channel)) + ## head (frp.channel) channel-var (var head) observer (function [label value] (case (io.run (|> channel-var raw-read (frp.write value))) @@ -247,10 +251,10 @@ (:! (frp.Channel [(STM Unit) (P.Promise Unit)])) (P.await (function recur [?inputs] (io (case ?inputs - #.Nil + #.None [] - (#.Cons head tail) + (#.Some [head tail]) (exec (process-commit head) (P.await recur tail))))))) (wrap []))) @@ -264,7 +268,7 @@ For this reason, it's important to note that transactions must be free from side-effects, such as I/O."} (All [a] (-> (STM a) (P.Promise a))) - (let [output (: (P.Promise ($ +0)) (P.promise #.None))] + (let [output (P.promise #.None)] (exec (io.run init-processor!) (io.run (write! [stm-proc output] pending-commits)) output))) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 69f50b5f0..154a3018b 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -14,7 +14,7 @@ (def: (freeze' generator) (All [a] (-> (-> [] a) (Lazy a))) - (let [cache (atom.atom (: (Maybe ($ +0)) #.None))] + (let [cache (atom.atom #.None)] (@abstract (function [_] (case (io.run (atom.read cache)) (#.Some value) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index dbbc26fb8..ba556458a 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -77,7 +77,7 @@ (#GenericArray GenericType) (#GenericWildcard (Maybe [BoundKind GenericType]))) -(type: TypeParam +(type: Type-Paramameter [Text (List GenericType)]) (type: Primitive-Mode @@ -100,13 +100,13 @@ #AbstractIM #DefaultIM) -(type: ClassKind +(type: Class-Kind #Class #Interface) -(type: ClassDecl +(type: Class-Declaration {#class-name Text - #class-params (List TypeParam)}) + #class-params (List Type-Paramameter)}) (type: StackFrame (primitive "java/lang/StackTraceElement")) (type: StackTrace (Array StackFrame)) @@ -122,7 +122,7 @@ {#ann-name Text #ann-params (List AnnotationParam)}) -(type: MemberDecl +(type: Member-Declaration {#member-name Text #member-privacy PrivacyModifier #member-anns (List Annotation)}) @@ -132,7 +132,7 @@ (#VariableField StateModifier GenericType)) (type: MethodDecl - {#method-tvars (List TypeParam) + {#method-tvars (List Type-Paramameter) #method-inputs (List GenericType) #method-output GenericType #method-exs (List GenericType)}) @@ -144,38 +144,38 @@ (type: ConstructorArg [GenericType Code]) -(type: MethodDef +(type: Method-Definition (#ConstructorMethod [Bool - (List TypeParam) + (List Type-Paramameter) (List ArgDecl) (List ConstructorArg) Code (List GenericType)]) (#VirtualMethod [Bool Bool - (List TypeParam) + (List Type-Paramameter) (List ArgDecl) GenericType Code (List GenericType)]) (#OverridenMethod [Bool - ClassDecl - (List TypeParam) + Class-Declaration + (List Type-Paramameter) (List ArgDecl) GenericType Code (List GenericType)]) (#StaticMethod [Bool - (List TypeParam) + (List Type-Paramameter) (List ArgDecl) GenericType Code (List GenericType)]) - (#AbstractMethod [(List TypeParam) + (#AbstractMethod [(List Type-Paramameter) (List ArgDecl) GenericType (List GenericType)]) - (#NativeMethod [(List TypeParam) + (#NativeMethod [(List Type-Paramameter) (List ArgDecl) GenericType (List GenericType)])) @@ -192,7 +192,7 @@ {#import-member-mode Primitive-Mode #import-member-alias Text #import-member-kind ImportMethodKind - #import-member-tvars (List TypeParam) + #import-member-tvars (List Type-Paramameter) #import-member-args (List [Bool GenericType]) #import-member-maybe? Bool #import-member-try? Bool @@ -213,7 +213,7 @@ #import-field-setter? Bool #import-field-type GenericType}) -(type: ImportMemberDecl +(type: Import-Member-Declaration (#EnumDecl (List Text)) (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl]) (#MethodDecl [ImportMethodCommons ImportMethodDecl]) @@ -275,8 +275,8 @@ (def: (generic-class->type' mode type-params in-array? name+params class->type') - (-> Primitive-Mode (List TypeParam) Bool [Text (List GenericType)] - (-> Primitive-Mode (List TypeParam) Bool GenericType Code) + (-> Primitive-Mode (List Type-Paramameter) Bool [Text (List GenericType)] + (-> Primitive-Mode (List Type-Paramameter) Bool GenericType Code) Code) (case [name+params mode in-array?] (^multi [[prim #.Nil] #ManualPrM false] @@ -293,7 +293,7 @@ (` (primitive (~ (code.text name)) [(~+ =params)]))))) (def: (class->type' mode type-params in-array? class) - (-> Primitive-Mode (List TypeParam) Bool GenericType Code) + (-> Primitive-Mode (List Type-Paramameter) Bool GenericType Code) (case class (#GenericTypeVar name) (case (list.find (function [[pname pbounds]] @@ -322,16 +322,16 @@ )) (def: (class->type mode type-params class) - (-> Primitive-Mode (List TypeParam) GenericType Code) + (-> Primitive-Mode (List Type-Paramameter) GenericType Code) (class->type' mode type-params false class)) (def: (type-param-type$ [name bounds]) - (-> TypeParam Code) + (-> Type-Paramameter Code) (code.symbol ["" name])) (def: (class-decl-type$ (^slots [#class-name #class-params])) - (-> ClassDecl Code) - (let [=params (list/map (: (-> TypeParam Code) + (-> Class-Declaration Code) + (let [=params (list/map (: (-> Type-Paramameter Code) (function [[pname pbounds]] (case pbounds #.Nil @@ -363,8 +363,8 @@ (: (Meta Class-Imports) (do Monad<Meta> [current-module macro.current-module-name - defs (macro.defs current-module)] - (wrap (list/fold (: (-> [Text Def] Class-Imports Class-Imports) + definitions (macro.definitions current-module)] + (wrap (list/fold (: (-> [Text Definition] Class-Imports Class-Imports) (function [[short-name [_ meta _]] imports] (case (macro.get-text-ann (ident-for #..jvm-class) meta) (#.Some full-class-name) @@ -373,7 +373,7 @@ _ imports))) empty-imports - defs))))) + definitions))))) (#.Left _) (list) (#.Right imports) imports)) @@ -469,7 +469,7 @@ (def: type-var-class Text "java.lang.Object") (def: (simple-class$ env class) - (-> (List TypeParam) GenericType Text) + (-> (List Type-Paramameter) GenericType Text) (case class (#GenericTypeVar name) (case (list.find (function [[pname pbounds]] @@ -563,7 +563,7 @@ )) (def: (field->parser class-name [[field-name _ _] field]) - (-> Text [MemberDecl FieldDecl] (Syntax Code)) + (-> Text [Member-Declaration FieldDecl] (Syntax Code)) (case field (#ConstantField _) (make-get-const-parser class-name field-name) @@ -573,7 +573,7 @@ (make-put-var-parser class-name field-name)))) (def: (make-constructor-parser params class-name arg-decls) - (-> (List TypeParam) Text (List ArgDecl) (Syntax Code)) + (-> (List Type-Paramameter) Text (List ArgDecl) (Syntax Code)) (do p.Monad<Parser> [[_ args] (: (Syntax [Unit (List Code)]) (s.form ($_ p.seq (s.this (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any))))) @@ -582,7 +582,7 @@ (~+ args)))))) (def: (make-static-method-parser params class-name method-name arg-decls) - (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) + (-> (List Type-Paramameter) Text Text (List ArgDecl) (Syntax Code)) (do p.Monad<Parser> [#let [dotted-name (format "::" method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) @@ -593,7 +593,7 @@ (do-template [<name> <jvm-op>] [(def: (<name> params class-name method-name arg-decls) - (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code)) + (-> (List Type-Paramameter) Text Text (List ArgDecl) (Syntax Code)) (do p.Monad<Parser> [#let [dotted-name (format "::" method-name "!")] [_ args] (: (Syntax [Unit (List Code)]) @@ -607,7 +607,7 @@ ) (def: (method->parser params class-name [[method-name _ _] meth-def]) - (-> (List TypeParam) Text [MemberDecl MethodDef] (Syntax Code)) + (-> (List Type-Paramameter) Text [Member-Declaration Method-Definition] (Syntax Code)) (case meth-def (#ConstructorMethod strict? type-vars args constructor-args return-expr exs) (make-constructor-parser params class-name args) @@ -659,7 +659,7 @@ (not (text.contains? "." name)))) (def: (generic-type^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax GenericType)) + (-> Class-Imports (List Type-Paramameter) (Syntax GenericType)) ($_ p.either (do p.Monad<Parser> [_ (s.this (' ?))] @@ -703,7 +703,7 @@ )) (def: (type-param^ imports) - (-> Class-Imports (Syntax TypeParam)) + (-> Class-Imports (Syntax Type-Paramameter)) (p.either (do p.Monad<Parser> [param-name s.local-symbol] (wrap [param-name (list)])) @@ -714,11 +714,11 @@ (wrap [param-name bounds]))))) (def: (type-params^ imports) - (-> Class-Imports (Syntax (List TypeParam))) + (-> Class-Imports (Syntax (List Type-Paramameter))) (s.tuple (p.some (type-param^ imports)))) (def: (class-decl^ imports) - (-> Class-Imports (Syntax ClassDecl)) + (-> Class-Imports (Syntax Class-Declaration)) (p.either (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name)] @@ -731,7 +731,7 @@ )) (def: (super-class-decl^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax Super-Class-Decl)) + (-> Class-Imports (List Type-Paramameter) (Syntax Super-Class-Decl)) (p.either (do p.Monad<Parser> [name (full-class-name^ imports) _ (assert-no-periods name)] @@ -767,19 +767,19 @@ (wrap (maybe.default (list) anns??)))) (def: (throws-decl'^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax (List GenericType))) + (-> Class-Imports (List Type-Paramameter) (Syntax (List GenericType))) (do p.Monad<Parser> [_ (s.this (' #throws))] (s.tuple (p.some (generic-type^ imports type-vars))))) (def: (throws-decl^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax (List GenericType))) + (-> Class-Imports (List Type-Paramameter) (Syntax (List GenericType))) (do p.Monad<Parser> [exs? (p.maybe (throws-decl'^ imports type-vars))] (wrap (maybe.default (list) exs?)))) (def: (method-decl^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDecl])) + (-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration MethodDecl])) (s.form (do p.Monad<Parser> [tvars (p.default (list) (type-params^ imports)) name s.local-symbol @@ -800,7 +800,7 @@ (:: p.Monad<Parser> wrap []))) (def: (field-decl^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax [MemberDecl FieldDecl])) + (-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration FieldDecl])) (p.either (s.form (do p.Monad<Parser> [_ (s.this (' #const)) name s.local-symbol @@ -817,24 +817,24 @@ (wrap [[name pm anns] (#VariableField [sm type])]))))) (def: (arg-decl^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax ArgDecl)) + (-> Class-Imports (List Type-Paramameter) (Syntax ArgDecl)) (s.tuple (p.seq s.local-symbol (generic-type^ imports type-vars)))) (def: (arg-decls^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax (List ArgDecl))) + (-> Class-Imports (List Type-Paramameter) (Syntax (List ArgDecl))) (p.some (arg-decl^ imports type-vars))) (def: (constructor-arg^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax ConstructorArg)) + (-> Class-Imports (List Type-Paramameter) (Syntax ConstructorArg)) (s.tuple (p.seq (generic-type^ imports type-vars) s.any))) (def: (constructor-args^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax (List ConstructorArg))) + (-> Class-Imports (List Type-Paramameter) (Syntax (List ConstructorArg))) (s.tuple (p.some (constructor-arg^ imports type-vars)))) (def: (constructor-method^ imports class-vars) - (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDef])) + (-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration Method-Definition])) (s.form (do p.Monad<Parser> [pm privacy-modifier^ strict-fp? (s.this? (' #strict)) @@ -852,7 +852,7 @@ (#ConstructorMethod strict-fp? method-vars arg-decls constructor-args body exs)])))) (def: (virtual-method-def^ imports class-vars) - (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDef])) + (-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration Method-Definition])) (s.form (do p.Monad<Parser> [pm privacy-modifier^ strict-fp? (s.this? (' #strict)) @@ -871,7 +871,7 @@ (#VirtualMethod final? strict-fp? method-vars arg-decls return-type body exs)])))) (def: (overriden-method-def^ imports) - (-> Class-Imports (Syntax [MemberDecl MethodDef])) + (-> Class-Imports (Syntax [Member-Declaration Method-Definition])) (s.form (do p.Monad<Parser> [strict-fp? (s.this? (' #strict)) owner-class (class-decl^ imports) @@ -889,7 +889,7 @@ (#OverridenMethod strict-fp? owner-class method-vars arg-decls return-type body exs)])))) (def: (static-method-def^ imports) - (-> Class-Imports (Syntax [MemberDecl MethodDef])) + (-> Class-Imports (Syntax [Member-Declaration Method-Definition])) (s.form (do p.Monad<Parser> [pm privacy-modifier^ strict-fp? (s.this? (' #strict)) @@ -908,7 +908,7 @@ (#StaticMethod strict-fp? method-vars arg-decls return-type body exs)])))) (def: (abstract-method-def^ imports) - (-> Class-Imports (Syntax [MemberDecl MethodDef])) + (-> Class-Imports (Syntax [Member-Declaration Method-Definition])) (s.form (do p.Monad<Parser> [pm privacy-modifier^ _ (s.this (' #abstract)) @@ -925,7 +925,7 @@ (#AbstractMethod method-vars arg-decls return-type exs)])))) (def: (native-method-def^ imports) - (-> Class-Imports (Syntax [MemberDecl MethodDef])) + (-> Class-Imports (Syntax [Member-Declaration Method-Definition])) (s.form (do p.Monad<Parser> [pm privacy-modifier^ _ (s.this (' #native)) @@ -942,7 +942,7 @@ (#NativeMethod method-vars arg-decls return-type exs)])))) (def: (method-def^ imports class-vars) - (-> Class-Imports (List TypeParam) (Syntax [MemberDecl MethodDef])) + (-> Class-Imports (List Type-Paramameter) (Syntax [Member-Declaration Method-Definition])) ($_ p.either (constructor-method^ imports class-vars) (virtual-method-def^ imports class-vars) @@ -956,7 +956,7 @@ (s.form (p.seq s.any s.any))) (def: class-kind^ - (Syntax ClassKind) + (Syntax Class-Kind) (p.either (do p.Monad<Parser> [_ (s.this (' #class))] (wrap #Class)) @@ -972,7 +972,7 @@ s.local-symbol))) (def: (import-member-args^ imports type-vars) - (-> Class-Imports (List TypeParam) (Syntax (List [Bool GenericType]))) + (-> Class-Imports (List Type-Paramameter) (Syntax (List [Bool GenericType]))) (s.tuple (p.some (p.seq (s.this? (' #?)) (generic-type^ imports type-vars))))) (def: import-member-return-flags^ @@ -985,7 +985,7 @@ (s.this (' #auto)))) (def: (import-member-decl^ imports owner-vars) - (-> Class-Imports (List TypeParam) (Syntax ImportMemberDecl)) + (-> Class-Imports (List Type-Paramameter) (Syntax Import-Member-Declaration)) ($_ p.either (s.form (do p.Monad<Parser> [_ (s.this (' #enum)) @@ -1108,11 +1108,11 @@ (format (bound-kind$ bound-kind) (generic-type$ bound)))) (def: (type-param$ [name bounds]) - (-> TypeParam JVM-Code) + (-> Type-Paramameter JVM-Code) (format "(" name " " (spaced (list/map generic-type$ bounds)) ")")) (def: (class-decl$ (^open)) - (-> ClassDecl JVM-Code) + (-> Class-Declaration JVM-Code) (format "(" (sanitize class-name) " " (spaced (list/map type-param$ class-params)) ")")) (def: (super-class-decl$ (^slots [#super-class-name #super-class-params])) @@ -1120,7 +1120,7 @@ (format "(" (sanitize super-class-name) " " (spaced (list/map generic-type$ super-class-params)) ")")) (def: (method-decl$ [[name pm anns] method-decl]) - (-> [MemberDecl MethodDecl] JVM-Code) + (-> [Member-Declaration MethodDecl] JVM-Code) (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl] (with-parens (spaced (list name @@ -1139,7 +1139,7 @@ #DefaultSM "default")) (def: (field-decl$ [[name pm anns] field]) - (-> [MemberDecl FieldDecl] JVM-Code) + (-> [Member-Declaration FieldDecl] JVM-Code) (case field (#ConstantField class value) (with-parens @@ -1170,7 +1170,7 @@ (spaced (list (generic-type$ class) (code.to-text term))))) (def: (method-def$ replacer super-class [[name pm anns] method-def]) - (-> (-> Code Code) Super-Class-Decl [MemberDecl MethodDef] JVM-Code) + (-> (-> Code Code) Super-Class-Decl [Member-Declaration Method-Definition] JVM-Code) (case method-def (#ConstructorMethod strict-fp? type-vars arg-decls constructor-args body exs) (with-parens @@ -1469,7 +1469,7 @@ (~ g!obj)))))))) (def: (class-import$ long-name? [full-name params]) - (-> Bool ClassDecl Code) + (-> Bool Class-Declaration Code) (let [def-name (if long-name? full-name (short-class-name full-name)) @@ -1483,7 +1483,7 @@ [(~+ params')])))))) (def: (member-type-vars class-tvars member) - (-> (List TypeParam) ImportMemberDecl (List TypeParam)) + (-> (List Type-Paramameter) Import-Member-Declaration (List Type-Paramameter)) (case member (#ConstructorDecl [commons _]) (list/compose class-tvars (get@ #import-member-tvars commons)) @@ -1500,7 +1500,7 @@ class-tvars)) (def: (member-def-arg-bindings type-params class member) - (-> (List TypeParam) ClassDecl ImportMemberDecl (Meta [(List Code) (List Code) (List Text) (List Code)])) + (-> (List Type-Paramameter) Class-Declaration Import-Member-Declaration (Meta [(List Code) (List Code) (List Text) (List Code)])) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (let [(^slots [#import-member-tvars #import-member-args]) commons] @@ -1531,7 +1531,7 @@ (:: Monad<Meta> wrap [(list) (list) (list) (list)]))) (def: (member-def-return mode type-params class member) - (-> Primitive-Mode (List TypeParam) ClassDecl ImportMemberDecl (Meta Code)) + (-> Primitive-Mode (List Type-Paramameter) Class-Declaration Import-Member-Declaration (Meta Code)) (case member (#ConstructorDecl _) (:: Monad<Meta> wrap (class-decl-type$ class)) @@ -1543,7 +1543,7 @@ (macro.fail "Only methods have return values."))) (def: (decorate-return-maybe member [return-type return-term]) - (-> ImportMemberDecl [Code Code] [Code Code]) + (-> Import-Member-Declaration [Code Code] [Code Code]) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ #import-member-maybe? commons) @@ -1562,7 +1562,7 @@ (do-template [<name> <tag> <type-trans> <term-trans>] [(def: (<name> member [return-type return-term]) - (-> ImportMemberDecl [Code Code] [Code Code]) + (-> Import-Member-Declaration [Code Code] [Code Code]) (case member (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _])) (if (get@ <tag> commons) @@ -1577,13 +1577,13 @@ ) (def: (free-type-param? [name bounds]) - (-> TypeParam Bool) + (-> Type-Paramameter Bool) (case bounds #.Nil true _ false)) (def: (type-param->type-arg [name _]) - (-> TypeParam Code) + (-> Type-Paramameter Code) (code.symbol ["" name])) (def: (with-mode-output mode output-type body) @@ -1668,7 +1668,7 @@ _ g!input))) (def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix) - (-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Meta (List Code))) + (-> (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 full-name (sanitize full-name) all-params (|> (member-type-vars class-tvars member) @@ -1817,7 +1817,7 @@ ))) (def: (member-import$ type-params long-name? kind class member) - (-> (List TypeParam) Bool ClassKind ClassDecl ImportMemberDecl (Meta (List Code))) + (-> (List Type-Paramameter) Bool Class-Kind Class-Declaration Import-Member-Declaration (Meta (List Code))) (let [[full-name _] class method-prefix (if long-name? full-name @@ -1835,7 +1835,7 @@ (try ("jvm invokestatic:java.lang.Class:forName:java.lang.String" class-name))) (def: (class-kind [class-name _]) - (-> ClassDecl (Meta ClassKind)) + (-> Class-Declaration (Meta Class-Kind)) (let [class-name (sanitize class-name)] (case (load-class class-name) (#.Right class) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index 914f76093..dfc27a0f2 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -104,7 +104,8 @@ (P.future (do (e.ErrorT io.Monad<IO>) [server (ServerSocket::new [(nat-to-int port)]) - #let [output (frp.channel TCP) + #let [output (: (frp.Channel TCP) + (frp.channel)) _ (: (P.Promise Bool) (P.future (loop [tail output] diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index 057f155d0..717eb0624 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -10,7 +10,7 @@ (def: (to-channel values) (-> (List Int) (&.Channel Int)) - (let [_channel (&.channel Int)] + (let [_channel (: (&.Channel Int) (&.channel))] (io.run (do io.Monad<IO> [_ (M.map @ (function [value] (&.write value _channel)) values) @@ -31,7 +31,7 @@ (wrap (do P.Monad<Promise> [elems (&.consume (let [input (to-channel (list 0 1 2 3 4 5)) - output (&.channel Int)] + output (: (&.Channel Int) (&.channel))] (exec (&.pipe input output) output)))] (assert "Can pipe one channel into another." |