From af620cd1d669de6b3086e237eed806af514aa166 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Nov 2017 20:58:59 -0400 Subject: - Re-named lux/type/opaque to lux/type/abstract. --- stdlib/source/lux/concurrency/actor.lux | 10 +- stdlib/source/lux/data/color.lux | 10 +- stdlib/source/lux/data/lazy.lux | 22 ++--- stdlib/source/lux/data/tainted.lux | 6 +- stdlib/source/lux/function.lux | 2 +- stdlib/source/lux/time/duration.lux | 10 +- stdlib/source/lux/time/instant.lux | 12 +-- stdlib/source/lux/type/abstract.lux | 166 ++++++++++++++++++++++++++++++++ stdlib/source/lux/type/opaque.lux | 166 -------------------------------- stdlib/source/lux/world/net/tcp.jvm.lux | 10 +- stdlib/source/lux/world/net/udp.jvm.lux | 8 +- 11 files changed, 211 insertions(+), 211 deletions(-) create mode 100644 stdlib/source/lux/type/abstract.lux delete mode 100644 stdlib/source/lux/type/opaque.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 75bbf15d2..a079d2d28 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -13,7 +13,7 @@ (syntax ["cs" common] (common ["csr" reader] ["csw" writer]))) - (type opaque) + (type abstract) (lang [type])) (// ["A" atom] ["P" promise "P/" Monad] @@ -29,7 +29,7 @@ (with-expansions [ (as-is (-> s (Actor s) (T.Task s))) (as-is [Text s (List )])] - (opaque: #export (Actor s) + (abstract: #export (Actor s) {#.doc "An actor, defined as all the necessities it requires."} {#mailbox (stm.Var ) #kill-switch (P.Promise Unit) @@ -51,9 +51,9 @@ (All [s] (-> (Behavior s) s (IO (Actor s)))) (io (let [[handle end] behavior self (: (Actor ($ +0)) - (@opaque {#mailbox (stm.var (:! (Message ($ +0)) [])) - #kill-switch (P.promise Unit) - #obituary (P.promise (Obituary ($ +0)))})) + (@abstract {#mailbox (stm.var (:! (Message ($ +0)) [])) + #kill-switch (P.promise Unit) + #obituary (P.promise (Obituary ($ +0)))})) mailbox-channel (io.run (stm.follow (get@ #mailbox (@repr self)))) |mailbox| (stm.var mailbox-channel) _ (P/map (function [_] diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 9e5c828e4..2a23c5406 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -3,7 +3,7 @@ (lux (control [eq]) (data (coll [list "L/" Functor])) [math] - (type opaque))) + (type abstract))) (def: rgb Nat +256) (def: top Nat (n/dec rgb)) @@ -21,16 +21,16 @@ (-> Frac Nat) (|>> (f/* rgb-factor) frac-to-nat)) -(opaque: #export Color {} +(abstract: #export Color {} {#red Nat #green Nat #blue Nat} (def: #export (color [red green blue]) (-> [Nat Nat Nat] Color) - (@opaque [(n/% rgb red) - (n/% rgb green) - (n/% rgb blue)])) + (@abstract [(n/% rgb red) + (n/% rgb green) + (n/% rgb blue)])) (def: #export unpack (-> Color [Nat Nat Nat]) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 75b5e29e2..27c60afa9 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -7,23 +7,23 @@ (concurrency [atom]) [macro] (macro ["s" syntax #+ syntax:]) - (type opaque))) + (type abstract))) -(opaque: #export (Lazy a) +(abstract: #export (Lazy a) (-> [] a) (def: #hidden (freeze' generator) (All [a] (-> (-> [] a) (Lazy a))) (let [cache (atom.atom (: (Maybe ($ +0)) #.None))] - (@opaque (function [_] - (case (io.run (atom.read cache)) - (#.Some value) - value - - _ - (let [value (generator [])] - (exec (io.run (atom.compare-and-swap _ (#.Some value) cache)) - value))))))) + (@abstract (function [_] + (case (io.run (atom.read cache)) + (#.Some value) + value + + _ + (let [value (generator [])] + (exec (io.run (atom.compare-and-swap _ (#.Some value) cache)) + value))))))) (def: #export (thaw l-value) (All [a] (-> (Lazy a) a)) diff --git a/stdlib/source/lux/data/tainted.lux b/stdlib/source/lux/data/tainted.lux index 2190c3712..2e15ba974 100644 --- a/stdlib/source/lux/data/tainted.lux +++ b/stdlib/source/lux/data/tainted.lux @@ -1,14 +1,14 @@ (.module: lux (lux (data [product]) - (type opaque))) + (type abstract))) -(opaque: #export (Tainted a) +(abstract: #export (Tainted a) a (def: #export taint (All [a] (-> a (Tainted a))) - (|>> @opaque)) + (|>> @abstract)) (def: #export trust (All [a] (-> (Tainted a) a)) diff --git a/stdlib/source/lux/function.lux b/stdlib/source/lux/function.lux index 2fe4d6c1f..977886551 100644 --- a/stdlib/source/lux/function.lux +++ b/stdlib/source/lux/function.lux @@ -19,6 +19,6 @@ (-> (-> a b c) (-> b a c))) (function [x y] (f y x))) -(struct: #export Monoid (Monoid (All [a] (-> a a))) +(struct: #export Monoid (All [a] (Monoid (-> a a))) (def: identity id) (def: compose ..compose)) diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index 01d7f5847..f2eb63863 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -9,15 +9,15 @@ [text "text/" Monoid] (text ["l" lexer]) ["e" error]) - (type opaque))) + (type abstract))) -(opaque: #export Duration +(abstract: #export Duration {#.doc "Durations have a resolution of milliseconds."} Int (def: #export from-millis (-> Int Duration) - (|>> @opaque)) + (|>> @abstract)) (def: #export to-millis (-> Duration Int) @@ -26,7 +26,7 @@ (do-template [ ] [(def: #export ( param subject) (-> Duration Duration Duration) - (@opaque ( (@repr param) (@repr subject))))] + (@abstract ( (@repr param) (@repr subject))))] [merge i/+] [frame i/%] @@ -34,7 +34,7 @@ (def: #export (scale scalar duration) (-> Int Duration Duration) - (@opaque (i/* scalar (@repr duration)))) + (@abstract (i/* scalar (@repr duration)))) (def: #export (query param subject) (-> Duration Duration Int) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 1285e50e6..381820058 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -14,17 +14,17 @@ [maybe] (coll [list "L/" Fold Functor] [sequence #+ Sequence sequence "sequence/" Functor Fold])) - (type opaque)) + (type abstract)) (// [duration "duration/" Order] [date])) -(opaque: #export Instant +(abstract: #export Instant {#.doc "Instant is defined as milliseconds since the epoch."} Int (def: #export from-millis (-> Int Instant) - (|>> @opaque)) + (|>> @abstract)) (def: #export to-millis (-> Instant Int) @@ -36,7 +36,7 @@ (def: #export (shift duration instant) (-> duration.Duration Instant Instant) - (@opaque (i/+ (duration.to-millis duration) (@repr instant)))) + (@abstract (i/+ (duration.to-millis duration) (@repr instant)))) (def: #export (relative instant) (-> Instant duration.Duration) @@ -44,7 +44,7 @@ (def: #export (absolute offset) (-> duration.Duration Instant) - (|> offset duration.to-millis @opaque)) + (|> offset duration.to-millis @abstract)) (struct: #export _ (Eq Instant) (def: (= param subject) @@ -63,7 +63,7 @@ (def: order Order) (do-template [] [(def: - (|>> @repr (:: number.Enum ) @opaque))] + (|>> @repr (:: number.Enum ) @abstract))] [succ] [pred] )) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux new file mode 100644 index 000000000..8d20c25c5 --- /dev/null +++ b/stdlib/source/lux/type/abstract.lux @@ -0,0 +1,166 @@ +(.module: + lux + (lux (control [applicative] + [monad #+ do Monad] + ["p" parser]) + (data [text "text/" Eq Monoid] + ["E" error] + (coll [list "list/" Functor Monoid])) + [macro] + (macro [code] + ["s" syntax #+ syntax:] + (syntax ["cs" common] + (common ["csr" reader] + ["csw" writer]))))) + +(def: (get k plist) + (All [a] + (-> Text (List [Text a]) (Maybe a))) + (case plist + #.Nil + #.None + + (#.Cons [k' v] plist') + (if (text/= k k') + (#.Some v) + (get k plist')))) + +(def: (put k v plist) + (All [a] + (-> Text a (List [Text a]) (List [Text a]))) + (case plist + #.Nil + (list [k v]) + + (#.Cons [k' v'] plist') + (if (text/= k k') + (#.Cons [k' v] plist') + (#.Cons [k' v'] (put k v plist'))))) + +(def: (remove k plist) + (All [a] + (-> Text (List [Text a]) (List [Text a]))) + (case plist + #.Nil + #.Nil + + (#.Cons [k' v'] plist') + (if (text/= k k') + plist' + (#.Cons [k' v'] (remove k plist'))))) + +(def: down-cast Text "@abstract") +(def: up-cast Text "@repr") +(def: macro-anns Code (' {#.macro? true})) + +(def: representation-name + (-> Text Text) + (|>> ($_ text/compose "{" kind "@" module "}") + (let [[module kind] (ident-for #..Representation)]))) + +(def: (install-casts' this-module-name name type-vars) + (-> Text Text (List Text) (Meta Unit)) + (do macro.Monad + [this-module (macro.find-module this-module-name) + #let [type-varsC (list/map code.local-symbol type-vars) + abstract-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) + representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~@ type-varsC))) + this-module (|> this-module + (update@ #.defs (put down-cast (: Def + [Macro macro-anns + (: Macro + (function [tokens] + (case tokens + (^ (list value)) + (wrap (list (` ((: (All [(~@ type-varsC)] + (-> (~ representation-declaration) (~ abstract-declaration))) + (|>> :!!)) + (~ value))))) + + _ + (macro.fail ($_ text/compose "Wrong syntax for " down-cast)))))]))) + (update@ #.defs (put up-cast (: Def + [Macro macro-anns + (: Macro + (function [tokens] + (case tokens + (^ (list value)) + (wrap (list (` ((: (All [(~@ type-varsC)] + (-> (~ abstract-declaration) (~ representation-declaration))) + (|>> :!!)) + (~ value))))) + + _ + (macro.fail ($_ text/compose "Wrong syntax for " up-cast)))))]))))]] + (function [compiler] + (#E.Success [(update@ #.modules (put this-module-name this-module) compiler) + []])))) + +(def: (un-install-casts' this-module-name) + (-> Text (Meta Unit)) + (do macro.Monad + [this-module (macro.find-module this-module-name) + #let [this-module (|> this-module + (update@ #.defs (remove down-cast)) + (update@ #.defs (remove up-cast)))]] + (function [compiler] + (#E.Success [(update@ #.modules (put this-module-name this-module) compiler) + []])))) + +(syntax: #hidden (install-casts [name s.local-symbol] + [type-vars (s.tuple (p.some s.local-symbol))]) + (do @ + [this-module-name macro.current-module-name + ?down-cast (macro.find-macro [this-module-name down-cast]) + ?up-cast (macro.find-macro [this-module-name up-cast])] + (case [?down-cast ?up-cast] + [#.None #.None] + (do @ + [_ (install-casts' this-module-name name type-vars)] + (wrap (list))) + + _ + (macro.fail ($_ text/compose + "Cannot temporarily define casting functions (" + down-cast " & " up-cast + ") because definitions like that already exist."))))) + +(syntax: #hidden (un-install-casts) + (do macro.Monad + [this-module-name macro.current-module-name + ?down-cast (macro.find-macro [this-module-name down-cast]) + ?up-cast (macro.find-macro [this-module-name up-cast])] + (case [?down-cast ?up-cast] + [(#.Some _) (#.Some _)] + (do @ + [_ (un-install-casts' this-module-name)] + (wrap (list))) + + _ + (macro.fail ($_ text/compose + "Cannot un-define casting functions (" + down-cast " & " up-cast + ") because they do not exist."))))) + +(def: declaration + (s.Syntax [Text (List Text)]) + (p.either (s.form (p.seq s.local-symbol (p.some s.local-symbol))) + (p.seq s.local-symbol (:: p.Monad wrap (list))))) + +(syntax: #export (abstract: [export csr.export] + [[name type-vars] declaration] + [annotations (p.default cs.empty-annotations csr.annotations)] + representation-type + [primitives (p.some s.any)]) + (let [hidden-name (representation-name name) + type-varsC (list/map code.local-symbol type-vars) + abstract-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) + representation-declaration (` ((~ (code.local-symbol hidden-name)) (~@ type-varsC)))] + (wrap (list& (` (type: (~@ (csw.export export)) (~ abstract-declaration) + (~ (csw.annotations annotations)) + (primitive (~ (code.text hidden-name)) [(~@ type-varsC)]))) + (` (type: (~@ (csw.export export)) (~ representation-declaration) + (~ representation-type))) + (` (install-casts (~ (code.local-symbol name)) [(~@ type-varsC)])) + (list/compose primitives + (list (` (un-install-casts)))))))) diff --git a/stdlib/source/lux/type/opaque.lux b/stdlib/source/lux/type/opaque.lux deleted file mode 100644 index 62e284f64..000000000 --- a/stdlib/source/lux/type/opaque.lux +++ /dev/null @@ -1,166 +0,0 @@ -(.module: - lux - (lux (control [applicative] - [monad #+ do Monad] - ["p" parser]) - (data [text "text/" Eq Monoid] - ["E" error] - (coll [list "list/" Functor Monoid])) - [macro] - (macro [code] - ["s" syntax #+ syntax:] - (syntax ["cs" common] - (common ["csr" reader] - ["csw" writer]))))) - -(def: (get k plist) - (All [a] - (-> Text (List [Text a]) (Maybe a))) - (case plist - #.Nil - #.None - - (#.Cons [k' v] plist') - (if (text/= k k') - (#.Some v) - (get k plist')))) - -(def: (put k v plist) - (All [a] - (-> Text a (List [Text a]) (List [Text a]))) - (case plist - #.Nil - (list [k v]) - - (#.Cons [k' v'] plist') - (if (text/= k k') - (#.Cons [k' v] plist') - (#.Cons [k' v'] (put k v plist'))))) - -(def: (remove k plist) - (All [a] - (-> Text (List [Text a]) (List [Text a]))) - (case plist - #.Nil - #.Nil - - (#.Cons [k' v'] plist') - (if (text/= k k') - plist' - (#.Cons [k' v'] (remove k plist'))))) - -(def: down-cast Text "@opaque") -(def: up-cast Text "@repr") -(def: macro-anns Code (' {#.macro? true})) - -(def: representation-name - (-> Text Text) - (|>> ($_ text/compose "{" kind "@" module "}") - (let [[module kind] (ident-for #..Representation)]))) - -(def: (install-casts' this-module-name name type-vars) - (-> Text Text (List Text) (Meta Unit)) - (do macro.Monad - [this-module (macro.find-module this-module-name) - #let [type-varsC (list/map code.local-symbol type-vars) - opaque-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) - representation-declaration (` ((~ (code.local-symbol (representation-name name))) (~@ type-varsC))) - this-module (|> this-module - (update@ #.defs (put down-cast (: Def - [Macro macro-anns - (: Macro - (function [tokens] - (case tokens - (^ (list value)) - (wrap (list (` ((: (All [(~@ type-varsC)] - (-> (~ representation-declaration) (~ opaque-declaration))) - (|>> :!!)) - (~ value))))) - - _ - (macro.fail ($_ text/compose "Wrong syntax for " down-cast)))))]))) - (update@ #.defs (put up-cast (: Def - [Macro macro-anns - (: Macro - (function [tokens] - (case tokens - (^ (list value)) - (wrap (list (` ((: (All [(~@ type-varsC)] - (-> (~ opaque-declaration) (~ representation-declaration))) - (|>> :!!)) - (~ value))))) - - _ - (macro.fail ($_ text/compose "Wrong syntax for " up-cast)))))]))))]] - (function [compiler] - (#E.Success [(update@ #.modules (put this-module-name this-module) compiler) - []])))) - -(def: (un-install-casts' this-module-name) - (-> Text (Meta Unit)) - (do macro.Monad - [this-module (macro.find-module this-module-name) - #let [this-module (|> this-module - (update@ #.defs (remove down-cast)) - (update@ #.defs (remove up-cast)))]] - (function [compiler] - (#E.Success [(update@ #.modules (put this-module-name this-module) compiler) - []])))) - -(syntax: #hidden (install-casts [name s.local-symbol] - [type-vars (s.tuple (p.some s.local-symbol))]) - (do @ - [this-module-name macro.current-module-name - ?down-cast (macro.find-macro [this-module-name down-cast]) - ?up-cast (macro.find-macro [this-module-name up-cast])] - (case [?down-cast ?up-cast] - [#.None #.None] - (do @ - [_ (install-casts' this-module-name name type-vars)] - (wrap (list))) - - _ - (macro.fail ($_ text/compose - "Cannot temporarily define casting functions (" - down-cast " & " up-cast - ") because definitions like that already exist."))))) - -(syntax: #hidden (un-install-casts) - (do macro.Monad - [this-module-name macro.current-module-name - ?down-cast (macro.find-macro [this-module-name down-cast]) - ?up-cast (macro.find-macro [this-module-name up-cast])] - (case [?down-cast ?up-cast] - [(#.Some _) (#.Some _)] - (do @ - [_ (un-install-casts' this-module-name)] - (wrap (list))) - - _ - (macro.fail ($_ text/compose - "Cannot un-define casting functions (" - down-cast " & " up-cast - ") because they do not exist."))))) - -(def: declaration - (s.Syntax [Text (List Text)]) - (p.either (s.form (p.seq s.local-symbol (p.some s.local-symbol))) - (p.seq s.local-symbol (:: p.Monad wrap (list))))) - -(syntax: #export (opaque: [export csr.export] - [[name type-vars] declaration] - [annotations (p.default cs.empty-annotations csr.annotations)] - representation-type - [primitives (p.some s.any)]) - (let [hidden-name (representation-name name) - type-varsC (list/map code.local-symbol type-vars) - opaque-declaration (` ((~ (code.local-symbol name)) (~@ type-varsC))) - representation-declaration (` ((~ (code.local-symbol hidden-name)) (~@ type-varsC)))] - (wrap (list& (` (type: (~@ (csw.export export)) (~ opaque-declaration) - (~ (csw.annotations annotations)) - (primitive (~ (code.text hidden-name)) [(~@ type-varsC)]))) - (` (type: (~@ (csw.export export)) (~ representation-declaration) - (~ representation-type))) - (` (install-casts (~ (code.local-symbol name)) [(~@ type-varsC)])) - (list/compose primitives - (list (` (un-install-casts)))))))) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index 3d71e85f8..914f76093 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -5,7 +5,7 @@ ["T" task] [frp]) (data ["e" error]) - (type opaque) + (type abstract) (world [blob #+ Blob]) [io] [host]) @@ -36,7 +36,7 @@ ############################################################ ############################################################ -(opaque: #export TCP {} +(abstract: #export TCP {} {#socket Socket #in InputStream #out OutputStream} @@ -70,9 +70,9 @@ (do (e.ErrorT io.Monad) [input (Socket::getInputStream [] socket) output (Socket::getOutputStream [] socket)] - (wrap (@opaque {#socket socket - #in input - #out output})))) + (wrap (@abstract {#socket socket + #in input + #out output})))) (def: #export (client address port) (-> //.Address //.Port (T.Task TCP)) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index 4f58f1563..468d3b2b9 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -8,7 +8,7 @@ (data ["e" error] [maybe] (coll [array])) - (type opaque) + (type abstract) (world [blob #+ Blob]) [io] [host]) @@ -54,7 +54,7 @@ +1 (wrap (maybe.assume (array.read +0 addresses))) _ (io.io (ex.throw Multiple-Candidate-Addresses address)))))) -(opaque: #export UDP {} +(abstract: #export UDP {} {#socket DatagramSocket} (def: #export (read data offset length self) @@ -89,12 +89,12 @@ (P.future (do (e.ErrorT io.Monad) [socket (DatagramSocket::new|client [])] - (wrap (@opaque (#socket socket)))))) + (wrap (@abstract (#socket socket)))))) (def: #export (server port) (-> //.Port (T.Task UDP)) (P.future (do (e.ErrorT io.Monad) [socket (DatagramSocket::new|server [(nat-to-int port)])] - (wrap (@opaque (#socket socket)))))) + (wrap (@abstract (#socket socket)))))) ) -- cgit v1.2.3