diff options
author | Eduardo Julian | 2021-09-08 03:08:13 -0400 |
---|---|---|
committer | Eduardo Julian | 2021-09-08 03:08:13 -0400 |
commit | 392582885500d8201bbe502943ca4b02c5c77ac0 (patch) | |
tree | 6e7410546048547560c767dba9c303d3f2f9597a | |
parent | 609cc6c16e75c13d87183c38245136fa038b0496 (diff) |
Normalized the syntax of "abstract:" and "actor:".
Diffstat (limited to '')
90 files changed, 10931 insertions, 11161 deletions
diff --git a/stdlib/source/documentation/lux/control/concurrency/actor.lux b/stdlib/source/documentation/lux/control/concurrency/actor.lux index 240b1aefe..1bbb4febe 100644 --- a/stdlib/source/documentation/lux/control/concurrency/actor.lux +++ b/stdlib/source/documentation/lux/control/concurrency/actor.lux @@ -47,35 +47,31 @@ \n "but allows the actor to handle previous mail.")) (with_expansions [<examples> (as_is (actor: .public (stack a) - {} - (List a) - ((on_mail mail state self) - (do (try.with async.monad) - [.let [_ (debug.log! "BEFORE")] - output (mail state self) - .let [_ (debug.log! "AFTER")]] - (in output))) + [((on_mail mail state self) + (do (try.with async.monad) + [.let [_ (debug.log! "BEFORE")] + output (mail state self) + .let [_ (debug.log! "AFTER")]] + (in output))) - (message: .public (push {value a} state self) - (List a) - (let [state' (#.Item value state)] - (async.resolved (#try.Success [state' state']))))) + (message: .public (push {value a} state self) + (List a) + (let [state' (#.Item value state)] + (async.resolved (#try.Success [state' state']))))]) (actor: .public counter - {} - Nat - (message: .public (count! {increment Nat} state self) - Any - (let [state' (n.+ increment state)] - (async.resolved (#try.Success [state' state'])))) + [(message: .public (count! {increment Nat} state self) + Any + (let [state' (n.+ increment state)] + (async.resolved (#try.Success [state' state'])))) - (message: .public (read! state self) - Nat - (async.resolved (#try.Success [state state])))))] + (message: .public (read! state self) + Nat + (async.resolved (#try.Success [state state])))]))] (documentation: /.actor: (format "Defines a named actor, with its behavior and internal state." \n "Messages for the actor must be defined after the on_mail handler.") diff --git a/stdlib/source/documentation/lux/type/abstract.lux b/stdlib/source/documentation/lux/type/abstract.lux index a0bf8147b..b1a945167 100644 --- a/stdlib/source/documentation/lux/type/abstract.lux +++ b/stdlib/source/documentation/lux/type/abstract.lux @@ -41,95 +41,83 @@ (format "Define abstract/nominal types which hide their representation details." \n "You can convert between the abstraction and its representation selectively to access the value, while hiding it from others.") [(abstract: String - {} - Text - (def: (string value) - (-> Text String) - (:abstraction value)) + [(def: (string value) + (-> Text String) + (:abstraction value)) - (def: (text value) - (-> String Text) - (:representation value)))] + (def: (text value) + (-> String Text) + (:representation value))])] ["Type-parameters are optional." (abstract: (Duplicate a) - {} - [a a] - (def: (duplicate value) - (All (_ a) (-> a (Duplicate a))) - (:abstraction [value value])))] + [(def: (duplicate value) + (All (_ a) (-> a (Duplicate a))) + (:abstraction [value value]))])] ["Definitions can be nested." (abstract: (Single a) - {} - a - (def: (single value) - (All (_ a) (-> a (Single a))) - (:abstraction value)) + [(def: (single value) + (All (_ a) (-> a (Single a))) + (:abstraction value)) - (abstract: (Double a) - {} + (abstract: (Double a) + [a a] - [a a] + [(def: (double value) + (All (_ a) (-> a (Double a))) + (:abstraction [value value])) - (def: (double value) - (All (_ a) (-> a (Double a))) - (:abstraction [value value])) + (def: (single' value) + (All (_ a) (-> a (Single a))) + (:abstraction Single [value value])) - (def: (single' value) - (All (_ a) (-> a (Single a))) - (:abstraction Single [value value])) - - (let [value 0123] - (same? value - (|> value - single' - (:representation Single) - double - :representation)))))] + (let [value 0123] + (same? value + (|> value + single' + (:representation Single) + double + :representation)))])])] ["Type-parameters do not necessarily have to be used in the representation type." "If they are not used, they become phantom types and can be used to customize types without changing the representation." (abstract: (JavaScript a) - {} - Text - (abstract: Expression {} Any) - (abstract: Statement {} Any) + [(abstract: Expression Any []) + (abstract: Statement Any []) - (def: (+ x y) - (-> (JavaScript Expression) (JavaScript Expression) (JavaScript Expression)) - (:abstraction - (format "(" (:representation x) "+" (:representation y) ")"))) + (def: (+ x y) + (-> (JavaScript Expression) (JavaScript Expression) (JavaScript Expression)) + (:abstraction + (format "(" (:representation x) "+" (:representation y) ")"))) - (def: (while test body) - (-> (JavaScript Expression) (JavaScript Statement) (JavaScript Statement)) - (:abstraction - (format "while(" (:representation test) ") {" - (:representation body) - "}"))))]) + (def: (while test body) + (-> (JavaScript Expression) (JavaScript Statement) (JavaScript Statement)) + (:abstraction + (format "while(" (:representation test) ") {" + (:representation body) + "}")))])]) (documentation: /.:transmutation "Transmutes an abstract/nominal type's phantom types." [(abstract: (JavaScript a) - {} - Text - (abstract: Expression {} Any) - (abstract: Statement {} Any) + [(abstract: Expression Any []) + (abstract: Statement Any []) - (def: (statement expression) - (-> (JavaScript Expression) (JavaScript Statement)) - (:transmutation expression)) + (def: (statement expression) + (-> (JavaScript Expression) (JavaScript Statement)) + (:transmutation expression)) - (def: (statement' expression) - (-> (JavaScript Expression) (JavaScript Statement)) - (:transmutation JavaScript expression)))]) + (def: (statement' expression) + (-> (JavaScript Expression) (JavaScript Statement)) + (:transmutation JavaScript expression))])]) (documentation: /.^:representation "Pattern-matching macro to easily extract a representation." diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index d127feec3..27d413c10 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -23,12 +23,11 @@ ["[0]" code] [syntax {"+" [syntax:]} ["|[0]|" input] - ["|[0]|" annotations]]] + ["|[0]|" export]]] [math [number ["n" nat]]] - ["[0]" meta {"+" [monad]} - ["[0]" annotation]] + ["[0]" meta {"+" [monad]}] [type {"+" [:sharing]} ["[0]" abstract {"+" [abstract: :representation :abstraction]}]]]] [// @@ -63,138 +62,136 @@ (in #.End)))) (abstract: .public (Actor s) - {} - (Record [#obituary [(Async <Obituary>) (Resolver <Obituary>)] #mailbox (Atom <Mailbox>)]) - (type: .public (Mail s) - <Mail>) - - (type: .public (Obituary s) - <Obituary>) - - (type: .public (Behavior o s) - (Record - [#on_init (-> o s) - #on_mail (-> (Mail s) s (Actor s) (Async (Try s)))])) - - (def: .public (spawn! behavior init) - (All (_ o s) (-> (Behavior o s) o (IO (Actor s)))) - (io (let [[on_init on_mail] behavior - self (:sharing [o s] - (Behavior o s) - behavior - - (Actor s) - (:abstraction [#obituary (async.async []) - #mailbox (atom (async.async []))])) - process (loop [state (on_init init) - [|mailbox| _] (io.run! (atom.read! (value@ #mailbox (:representation self))))] - (do [! async.monad] - [[head tail] |mailbox| - ?state' (on_mail head state self)] - (case ?state' - (#try.Failure error) - (let [[_ resolve] (value@ #obituary (:representation self))] - (exec (io.run! - (do io.monad - [pending (..pending tail)] - (resolve [error state (#.Item head pending)]))) - (in []))) - - (#try.Success state') - (recur state' tail))))] - self))) - - (def: .public (alive? actor) - (All (_ s) (-> (Actor s) (IO Bit))) - (let [[obituary _] (value@ #obituary (:representation actor))] - (|> obituary - async.value - (\ io.functor each - (|>> (case> #.None - bit.yes - - _ - bit.no)))))) - - (def: .public (obituary' actor) - (All (_ s) (-> (Actor s) (IO (Maybe (Obituary s))))) - (let [[obituary _] (value@ #obituary (:representation actor))] - (async.value obituary))) - - (def: .public obituary - (All (_ s) (-> (Actor s) (Async (Obituary s)))) - (|>> :representation - (value@ #obituary) - product.left)) - - (def: .public (mail! mail actor) - (All (_ s) (-> (Mail s) (Actor s) (IO (Try Any)))) - (do [! io.monad] - [alive? (..alive? actor)] - (if alive? - (let [entry [mail (async.async [])]] - (do ! - [|mailbox|&resolve (atom.read! (value@ #mailbox (:representation actor)))] - (loop [[|mailbox| resolve] |mailbox|&resolve] - (do ! - [|mailbox| (async.value |mailbox|)] - (case |mailbox| - #.None - (do ! - [resolved? (resolve entry)] - (if resolved? - (do ! - [_ (atom.write! (product.right entry) (value@ #mailbox (:representation actor)))] - (in (#try.Success []))) - (recur |mailbox|&resolve))) - - (#.Some [_ |mailbox|']) - (recur |mailbox|')))))) - (in (exception.except ..dead []))))) - - (type: .public (Message s o) - (-> s (Actor s) (Async (Try [s o])))) - - (def: (mail message) - (All (_ s o) (-> (Message s o) [(Async (Try o)) (Mail s)])) - (let [[async resolve] (:sharing [s o] - (Message s o) - message - - [(Async (Try o)) - (Resolver (Try o))] - (async.async []))] - [async - (function (_ state self) - (do [! async.monad] - [outcome (message state self)] - (case outcome - (#try.Success [state' return]) - (exec - (io.run! (resolve (#try.Success return))) - (async.resolved (#try.Success state'))) - - (#try.Failure error) - (exec - (io.run! (resolve (#try.Failure error))) - (async.resolved (#try.Failure error))))))])) - - (def: .public (tell! message actor) - (All (_ s o) (-> (Message s o) (Actor s) (Async (Try o)))) - (let [[async mail] (..mail message)] - (do async.monad - [outcome (async.future (..mail! mail actor))] - (case outcome - (#try.Success) - async - - (#try.Failure error) - (in (#try.Failure error)))))) + [(type: .public (Mail s) + <Mail>) + + (type: .public (Obituary s) + <Obituary>) + + (type: .public (Behavior o s) + (Record + [#on_init (-> o s) + #on_mail (-> (Mail s) s (Actor s) (Async (Try s)))])) + + (def: .public (spawn! behavior init) + (All (_ o s) (-> (Behavior o s) o (IO (Actor s)))) + (io (let [[on_init on_mail] behavior + self (:sharing [o s] + (Behavior o s) + behavior + + (Actor s) + (:abstraction [#obituary (async.async []) + #mailbox (atom (async.async []))])) + process (loop [state (on_init init) + [|mailbox| _] (io.run! (atom.read! (value@ #mailbox (:representation self))))] + (do [! async.monad] + [[head tail] |mailbox| + ?state' (on_mail head state self)] + (case ?state' + (#try.Failure error) + (let [[_ resolve] (value@ #obituary (:representation self))] + (exec (io.run! + (do io.monad + [pending (..pending tail)] + (resolve [error state (#.Item head pending)]))) + (in []))) + + (#try.Success state') + (recur state' tail))))] + self))) + + (def: .public (alive? actor) + (All (_ s) (-> (Actor s) (IO Bit))) + (let [[obituary _] (value@ #obituary (:representation actor))] + (|> obituary + async.value + (\ io.functor each + (|>> (case> #.None + bit.yes + + _ + bit.no)))))) + + (def: .public (obituary' actor) + (All (_ s) (-> (Actor s) (IO (Maybe (Obituary s))))) + (let [[obituary _] (value@ #obituary (:representation actor))] + (async.value obituary))) + + (def: .public obituary + (All (_ s) (-> (Actor s) (Async (Obituary s)))) + (|>> :representation + (value@ #obituary) + product.left)) + + (def: .public (mail! mail actor) + (All (_ s) (-> (Mail s) (Actor s) (IO (Try Any)))) + (do [! io.monad] + [alive? (..alive? actor)] + (if alive? + (let [entry [mail (async.async [])]] + (do ! + [|mailbox|&resolve (atom.read! (value@ #mailbox (:representation actor)))] + (loop [[|mailbox| resolve] |mailbox|&resolve] + (do ! + [|mailbox| (async.value |mailbox|)] + (case |mailbox| + #.None + (do ! + [resolved? (resolve entry)] + (if resolved? + (do ! + [_ (atom.write! (product.right entry) (value@ #mailbox (:representation actor)))] + (in (#try.Success []))) + (recur |mailbox|&resolve))) + + (#.Some [_ |mailbox|']) + (recur |mailbox|')))))) + (in (exception.except ..dead []))))) + + (type: .public (Message s o) + (-> s (Actor s) (Async (Try [s o])))) + + (def: (mail message) + (All (_ s o) (-> (Message s o) [(Async (Try o)) (Mail s)])) + (let [[async resolve] (:sharing [s o] + (Message s o) + message + + [(Async (Try o)) + (Resolver (Try o))] + (async.async []))] + [async + (function (_ state self) + (do [! async.monad] + [outcome (message state self)] + (case outcome + (#try.Success [state' return]) + (exec + (io.run! (resolve (#try.Success return))) + (async.resolved (#try.Success state'))) + + (#try.Failure error) + (exec + (io.run! (resolve (#try.Failure error))) + (async.resolved (#try.Failure error))))))])) + + (def: .public (tell! message actor) + (All (_ s o) (-> (Message s o) (Actor s) (Async (Try o)))) + (let [[async mail] (..mail message)] + (do async.monad + [outcome (async.future (..mail! mail actor))] + (case outcome + (#try.Success) + async + + (#try.Failure error) + (in (#try.Failure error))))))] ) ) @@ -228,13 +225,18 @@ (Parser Text) <code>.local_identifier) +(def: on_mail^ + (Parser (Maybe On_MailC)) + (<>.maybe (<code>.form (<>.and (<code>.form (<>.after (<code>.this! (' on_mail)) + ($_ <>.and ..argument ..argument ..argument))) + <code>.any)))) + (def: behavior^ (Parser BehaviorC) - (let [on_mail_args ($_ <>.and ..argument ..argument ..argument)] - ($_ <>.and - (<>.maybe (<code>.form (<>.and (<code>.form (<>.after (<code>.this! (' on_mail)) on_mail_args)) - <code>.any))) - (<>.some <code>.any)))) + (<code>.tuple + ($_ <>.and + ..on_mail^ + (<>.some <code>.any)))) (def: (on_mail g!_ ?on_mail) (-> Code (Maybe On_MailC) Code) @@ -250,37 +252,32 @@ (~ bodyC))))) (def: actorP - (Parser [Code [Text (List Text)] |annotations|.Annotations Code BehaviorC]) - (let [private ($_ <>.and - ..actor_decl^ - |annotations|.parser - <code>.any - behavior^)] - ($_ <>.either - (<>.and <code>.any private) - (<>.and (<>\in (` .private)) private)))) - -(syntax: .public (actor: [[export_policy [name vars] annotations state_type [?on_mail messages]] ..actorP]) + (Parser [Code [Text (List Text)] Code BehaviorC]) + (|export|.parser + ($_ <>.and + ..actor_decl^ + <code>.any + behavior^))) + +(syntax: .public (actor: [[export_policy [name vars] state_type [?on_mail messages]] ..actorP]) (with_identifiers [g!_] (do meta.monad [g!type (macro.identifier (format name "_abstract_type")) .let [g!actor (code.local_identifier name) g!vars (list\each code.local_identifier vars)]] (in (list (` ((~! abstract:) (~ export_policy) ((~ g!type) (~+ g!vars)) - {} - (~ state_type) - (def: (~ export_policy) (~ g!actor) - (All ((~ g!_) (~+ g!vars)) - (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) - [#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) - #..on_mail (~ (..on_mail g!_ ?on_mail))]) + [(def: (~ export_policy) (~ g!actor) + (All ((~ g!_) (~+ g!vars)) + (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) + [#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) + #..on_mail (~ (..on_mail g!_ ?on_mail))]) - (~+ messages)))))))) + (~+ messages)]))))))) (syntax: .public (actor [[state_type init] (<code>.record (<>.and <code>.any <code>.any)) - [?on_mail messages] behavior^]) + ?on_mail on_mail^]) (with_identifiers [g!_] (in (list (` (: ((~! io.IO) (..Actor (~ state_type))) (..spawn! (: (..Behavior (~ state_type) (~ state_type)) @@ -312,17 +309,14 @@ (<>.and <code>.identifier (\ <>.monad in (list))))) (def: messageP - (Parser [Code Signature |annotations|.Annotations Code Code]) - (let [private ($_ <>.and - ..signature^ - (<>.else |annotations|.empty |annotations|.parser) - <code>.any - <code>.any)] - ($_ <>.either - (<>.and <code>.any private) - (<>.and (<>\in (` .private)) private)))) - -(syntax: .public (message: [[export_policy signature annotations output_type body] ..messageP]) + (Parser [Code Signature Code Code]) + (|export|.parser + ($_ <>.and + ..signature^ + <code>.any + <code>.any))) + +(syntax: .public (message: [[export_policy signature output_type body] ..messageP]) (with_identifiers [g!_ g!return] (do meta.monad [actor_scope abstract.current @@ -335,7 +329,6 @@ g!state (|> signature (value@ #state) code.local_identifier) g!self (|> signature (value@ #self) code.local_identifier)]] (in (list (` (def: (~ export_policy) ((~ g!message) (~+ g!inputsC)) - (~ (|annotations|.format annotations)) (All ((~ g!_) (~+ g!all_vars)) (-> (~+ g!inputsT) (..Message (~ (value@ #abstract.abstraction actor_scope)) diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index aec52dcf9..903ac8bd9 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -18,66 +18,64 @@ ["[0]" atom {"+" [Atom atom]}]]) (abstract: .public (Async a) - {} - (Atom [(Maybe a) (List (-> a (IO Any)))]) - (type: .public (Resolver a) - (-> a (IO Bit))) - - ... Sets an async's value if it has not been done yet. - (def: (resolver async) - (All (_ a) (-> (Async a) (Resolver a))) - (function (resolve value) - (let [async (:representation async)] - (do [! io.monad] - [(^@ old [_value _observers]) (atom.read! async)] - (case _value - (#.Some _) - (in #0) - - #.None - (do ! - [.let [new [(#.Some value) #.None]] - succeeded? (atom.compare_and_swap! old new async)] - (if succeeded? - (do ! - [_ (monad.each ! (function (_ f) (f value)) - _observers)] - (in #1)) - (resolve value)))))))) - - (def: .public (resolved value) - (All (_ a) (-> a (Async a))) - (:abstraction (atom [(#.Some value) (list)]))) - - (def: .public (async _) - (All (_ a) (-> Any [(Async a) (Resolver a)])) - (let [async (:abstraction (atom [#.None (list)]))] - [async (..resolver async)])) - - (def: .public value - (All (_ a) (-> (Async a) (IO (Maybe a)))) - (|>> :representation - atom.read! - (\ io.functor each product.left))) - - (def: .public (upon! f async) - (All (_ a) (-> (-> a (IO Any)) (Async a) (IO Any))) - (do [! io.monad] - [.let [async (:representation async)] - (^@ old [_value _observers]) (atom.read! async)] - (case _value - (#.Some value) - (f value) - - #.None - (let [new [_value (#.Item f _observers)]] - (do ! - [swapped? (atom.compare_and_swap! old new async)] - (if swapped? - (in []) - (upon! f (:abstraction async)))))))) + [(type: .public (Resolver a) + (-> a (IO Bit))) + + ... Sets an async's value if it has not been done yet. + (def: (resolver async) + (All (_ a) (-> (Async a) (Resolver a))) + (function (resolve value) + (let [async (:representation async)] + (do [! io.monad] + [(^@ old [_value _observers]) (atom.read! async)] + (case _value + (#.Some _) + (in #0) + + #.None + (do ! + [.let [new [(#.Some value) #.None]] + succeeded? (atom.compare_and_swap! old new async)] + (if succeeded? + (do ! + [_ (monad.each ! (function (_ f) (f value)) + _observers)] + (in #1)) + (resolve value)))))))) + + (def: .public (resolved value) + (All (_ a) (-> a (Async a))) + (:abstraction (atom [(#.Some value) (list)]))) + + (def: .public (async _) + (All (_ a) (-> Any [(Async a) (Resolver a)])) + (let [async (:abstraction (atom [#.None (list)]))] + [async (..resolver async)])) + + (def: .public value + (All (_ a) (-> (Async a) (IO (Maybe a)))) + (|>> :representation + atom.read! + (\ io.functor each product.left))) + + (def: .public (upon! f async) + (All (_ a) (-> (-> a (IO Any)) (Async a) (IO Any))) + (do [! io.monad] + [.let [async (:representation async)] + (^@ old [_value _observers]) (atom.read! async)] + (case _value + (#.Some value) + (f value) + + #.None + (let [new [_value (#.Item f _observers)]] + (do ! + [swapped? (atom.compare_and_swap! old new async)] + (if swapped? + (in []) + (upon! f (:abstraction async))))))))] ) (def: .public resolved? diff --git a/stdlib/source/library/lux/control/concurrency/atom.lux b/stdlib/source/library/lux/control/concurrency/atom.lux index 802ea9298..6309f4f35 100644 --- a/stdlib/source/library/lux/control/concurrency/atom.lux +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -47,37 +47,35 @@ @.scheme "scheme array read"} (as_is))] (abstract: .public (Atom a) - {} - (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference a)] (for {@.old <jvm> @.jvm <jvm>} (array.Array a))) - (def: .public (atom value) - (All (_ a) (-> a (Atom a))) - (:abstraction (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::new value)] - (for {@.old <jvm> - @.jvm <jvm>} - (<write> 0 value (<new> 1)))))) + [(def: .public (atom value) + (All (_ a) (-> a (Atom a))) + (:abstraction (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::new value)] + (for {@.old <jvm> + @.jvm <jvm>} + (<write> 0 value (<new> 1)))))) - (def: .public (read! atom) - (All (_ a) (-> (Atom a) (IO a))) - (io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] - (for {@.old <jvm> - @.jvm <jvm>} - (<read> 0 (:representation atom)))))) + (def: .public (read! atom) + (All (_ a) (-> (Atom a) (IO a))) + (io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::get (:representation atom))] + (for {@.old <jvm> + @.jvm <jvm>} + (<read> 0 (:representation atom)))))) - (def: .public (compare_and_swap! current new atom) - (All (_ a) (-> a a (Atom a) (IO Bit))) - (io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))] - (for {@.old <jvm> - @.jvm <jvm>} - (let [old (<read> 0 (:representation atom))] - (if (same? old current) - (exec (<write> 0 new (:representation atom)) - true) - false)))))) + (def: .public (compare_and_swap! current new atom) + (All (_ a) (-> a a (Atom a) (IO Bit))) + (io.io (with_expansions [<jvm> (java/util/concurrent/atomic/AtomicReference::compareAndSet current new (:representation atom))] + (for {@.old <jvm> + @.jvm <jvm>} + (let [old (<read> 0 (:representation atom))] + (if (same? old current) + (exec (<write> 0 new (:representation atom)) + true) + false))))))] )) (def: .public (update! f atom) diff --git a/stdlib/source/library/lux/control/concurrency/semaphore.lux b/stdlib/source/library/lux/control/concurrency/semaphore.lux index 3b0461579..bcbd71158 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -31,95 +31,91 @@ #waiting_list (Queue (Resolver Any))])) (abstract: .public Semaphore - {} - (Atom State) - (def: most_positions_possible - (.nat (\ i.interval top))) - - (def: .public (semaphore initial_open_positions) - (-> Nat Semaphore) - (let [max_positions (n.min initial_open_positions - ..most_positions_possible)] - (:abstraction (atom.atom [#max_positions max_positions - #open_positions (.int max_positions) - #waiting_list queue.empty])))) - - (def: .public (wait! semaphore) - (Ex (_ k) (-> Semaphore (Async Any))) - (let [semaphore (:representation semaphore) - [signal sink] (: [(Async Any) (Resolver Any)] - (async.async []))] - (exec - (io.run! - (with_expansions [<had_open_position?> (as_is (value@ #open_positions) (i.> -1))] - (do io.monad - [[_ state'] (atom.update! (|>> (revised@ #open_positions --) - (if> [<had_open_position?>] - [] - [(revised@ #waiting_list (queue.end sink))])) - semaphore)] - (with_expansions [<go_ahead> (sink []) - <get_in_line> (in false)] - (if (|> state' <had_open_position?>) - <go_ahead> - <get_in_line>))))) - signal))) - - (exception: .public (semaphore_is_maxed_out {max_positions Nat}) - (exception.report - ["Max Positions" (%.nat max_positions)])) - - (def: .public (signal! semaphore) - (Ex (_ k) (-> Semaphore (Async (Try Int)))) - (let [semaphore (:representation semaphore)] - (async.future - (do [! io.monad] - [[pre post] (atom.update! (function (_ state) - (if (i.= (.int (value@ #max_positions state)) - (value@ #open_positions state)) - state - (|> state - (revised@ #open_positions ++) - (revised@ #waiting_list queue.next)))) - semaphore)] - (if (same? pre post) - (in (exception.except ..semaphore_is_maxed_out [(value@ #max_positions pre)])) - (do ! - [_ (case (queue.front (value@ #waiting_list pre)) - #.None - (in true) - - (#.Some sink) - (sink []))] - (in (#try.Success (value@ #open_positions post))))))))) + [(def: most_positions_possible + (.nat (\ i.interval top))) + + (def: .public (semaphore initial_open_positions) + (-> Nat Semaphore) + (let [max_positions (n.min initial_open_positions + ..most_positions_possible)] + (:abstraction (atom.atom [#max_positions max_positions + #open_positions (.int max_positions) + #waiting_list queue.empty])))) + + (def: .public (wait! semaphore) + (Ex (_ k) (-> Semaphore (Async Any))) + (let [semaphore (:representation semaphore) + [signal sink] (: [(Async Any) (Resolver Any)] + (async.async []))] + (exec + (io.run! + (with_expansions [<had_open_position?> (as_is (value@ #open_positions) (i.> -1))] + (do io.monad + [[_ state'] (atom.update! (|>> (revised@ #open_positions --) + (if> [<had_open_position?>] + [] + [(revised@ #waiting_list (queue.end sink))])) + semaphore)] + (with_expansions [<go_ahead> (sink []) + <get_in_line> (in false)] + (if (|> state' <had_open_position?>) + <go_ahead> + <get_in_line>))))) + signal))) + + (exception: .public (semaphore_is_maxed_out {max_positions Nat}) + (exception.report + ["Max Positions" (%.nat max_positions)])) + + (def: .public (signal! semaphore) + (Ex (_ k) (-> Semaphore (Async (Try Int)))) + (let [semaphore (:representation semaphore)] + (async.future + (do [! io.monad] + [[pre post] (atom.update! (function (_ state) + (if (i.= (.int (value@ #max_positions state)) + (value@ #open_positions state)) + state + (|> state + (revised@ #open_positions ++) + (revised@ #waiting_list queue.next)))) + semaphore)] + (if (same? pre post) + (in (exception.except ..semaphore_is_maxed_out [(value@ #max_positions pre)])) + (do ! + [_ (case (queue.front (value@ #waiting_list pre)) + #.None + (in true) + + (#.Some sink) + (sink []))] + (in (#try.Success (value@ #open_positions post)))))))))] ) (abstract: .public Mutex - {} - Semaphore - (def: .public (mutex _) - (-> Any Mutex) - (:abstraction (semaphore 1))) - - (def: acquire! - (-> Mutex (Async Any)) - (|>> :representation ..wait!)) - - (def: release! - (-> Mutex (Async Any)) - (|>> :representation ..signal!)) - - (def: .public (synchronize! mutex procedure) - (All (_ a) (-> Mutex (IO (Async a)) (Async a))) - (do async.monad - [_ (..acquire! mutex) - output (io.run! procedure) - _ (..release! mutex)] - (in output))) + [(def: .public (mutex _) + (-> Any Mutex) + (:abstraction (semaphore 1))) + + (def: acquire! + (-> Mutex (Async Any)) + (|>> :representation ..wait!)) + + (def: release! + (-> Mutex (Async Any)) + (|>> :representation ..signal!)) + + (def: .public (synchronize! mutex procedure) + (All (_ a) (-> Mutex (IO (Async a)) (Async a))) + (do async.monad + [_ (..acquire! mutex) + output (io.run! procedure) + _ (..release! mutex)] + (in output)))] ) (def: .public limit @@ -129,49 +125,47 @@ (:~ (refinement.type limit))) (abstract: .public Barrier - {} - (Record [#limit Limit #count (Atom Nat) #start_turnstile Semaphore #end_turnstile Semaphore]) - (def: .public (barrier limit) - (-> Limit Barrier) - (:abstraction [#limit limit - #count (atom.atom 0) - #start_turnstile (..semaphore 0) - #end_turnstile (..semaphore 0)])) - - (def: (un_block! times turnstile) - (-> Nat Semaphore (Async Any)) - (loop [step 0] - (if (n.< times step) + [(def: .public (barrier limit) + (-> Limit Barrier) + (:abstraction [#limit limit + #count (atom.atom 0) + #start_turnstile (..semaphore 0) + #end_turnstile (..semaphore 0)])) + + (def: (un_block! times turnstile) + (-> Nat Semaphore (Async Any)) + (loop [step 0] + (if (n.< times step) + (do async.monad + [outcome (..signal! turnstile)] + (recur (++ step))) + (\ async.monad in [])))) + + (template [<phase> <update> <goal> <turnstile>] + [(def: (<phase> (^:representation barrier)) + (-> Barrier (Async Any)) (do async.monad - [outcome (..signal! turnstile)] - (recur (++ step))) - (\ async.monad in [])))) - - (template [<phase> <update> <goal> <turnstile>] - [(def: (<phase> (^:representation barrier)) - (-> Barrier (Async Any)) - (do async.monad - [.let [limit (refinement.value (value@ #limit barrier)) - goal <goal> - [_ count] (io.run! (atom.update! <update> (value@ #count barrier))) - reached? (n.= goal count)]] - (if reached? - (..un_block! (-- limit) (value@ <turnstile> barrier)) - (..wait! (value@ <turnstile> barrier)))))] - - [start! ++ limit #start_turnstile] - [end! -- 0 #end_turnstile] - ) - - (def: .public (block! barrier) - (-> Barrier (Async Any)) - (do async.monad - [_ (..start! barrier)] - (..end! barrier))) + [.let [limit (refinement.value (value@ #limit barrier)) + goal <goal> + [_ count] (io.run! (atom.update! <update> (value@ #count barrier))) + reached? (n.= goal count)]] + (if reached? + (..un_block! (-- limit) (value@ <turnstile> barrier)) + (..wait! (value@ <turnstile> barrier)))))] + + [start! ++ limit #start_turnstile] + [end! -- 0 #end_turnstile] + ) + + (def: .public (block! barrier) + (-> Barrier (Async Any)) + (do async.monad + [_ (..start! barrier)] + (..end! barrier)))] ) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index c62540890..6b89926ff 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -24,55 +24,53 @@ (-> a (IO Any))) (abstract: .public (Var a) - {} - (Atom [a (List (Sink a))]) - (def: .public (var value) - (All (_ a) (-> a (Var a))) - (:abstraction (atom.atom [value (list)]))) - - (def: read! - (All (_ a) (-> (Var a) a)) - (|>> :representation atom.read! io.run! product.left)) - - (def: (un_follow! sink var) - (All (_ a) (-> (Sink a) (Var a) (IO Any))) - (do io.monad - [_ (atom.update! (function (_ [value observers]) - [value (list.only (|>> (same? sink) not) observers)]) - (:representation var))] - (in []))) - - (def: (write! new_value var) - (All (_ a) (-> a (Var a) (IO Any))) - (do [! io.monad] - [.let [var' (:representation var)] - (^@ old [old_value observers]) (atom.read! var') - succeeded? (atom.compare_and_swap! old [new_value observers] var')] - (if succeeded? - (do ! - [_ (monad.each ! (function (_ sink) - (do ! - [result (\ sink feed new_value)] - (case result - (#try.Success _) - (in []) - - (#try.Failure _) - (un_follow! sink var)))) - observers)] - (in [])) - (write! new_value var)))) - - (def: .public (follow! target) - (All (_ a) (-> (Var a) (IO [(Channel a) (Sink a)]))) - (do io.monad - [.let [[channel sink] (frp.channel [])] - _ (atom.update! (function (_ [value observers]) - [value (#.Item sink observers)]) - (:representation target))] - (in [channel sink]))) + [(def: .public (var value) + (All (_ a) (-> a (Var a))) + (:abstraction (atom.atom [value (list)]))) + + (def: read! + (All (_ a) (-> (Var a) a)) + (|>> :representation atom.read! io.run! product.left)) + + (def: (un_follow! sink var) + (All (_ a) (-> (Sink a) (Var a) (IO Any))) + (do io.monad + [_ (atom.update! (function (_ [value observers]) + [value (list.only (|>> (same? sink) not) observers)]) + (:representation var))] + (in []))) + + (def: (write! new_value var) + (All (_ a) (-> a (Var a) (IO Any))) + (do [! io.monad] + [.let [var' (:representation var)] + (^@ old [old_value observers]) (atom.read! var') + succeeded? (atom.compare_and_swap! old [new_value observers] var')] + (if succeeded? + (do ! + [_ (monad.each ! (function (_ sink) + (do ! + [result (\ sink feed new_value)] + (case result + (#try.Success _) + (in []) + + (#try.Failure _) + (un_follow! sink var)))) + observers)] + (in [])) + (write! new_value var)))) + + (def: .public (follow! target) + (All (_ a) (-> (Var a) (IO [(Channel a) (Sink a)]))) + (do io.monad + [.let [[channel sink] (frp.channel [])] + _ (atom.update! (function (_ [value observers]) + [value (#.Item sink observers)]) + (:representation target))] + (in [channel sink])))] ) (type: (Tx_Frame a) diff --git a/stdlib/source/library/lux/control/io.lux b/stdlib/source/library/lux/control/io.lux index 8ff12b40b..654415bd3 100644 --- a/stdlib/source/library/lux/control/io.lux +++ b/stdlib/source/library/lux/control/io.lux @@ -15,54 +15,52 @@ ["[0]" template]]]]) (abstract: .public (IO a) - {} - (-> Any a) - (def: label - (All (_ _ a) (-> (-> Any a) (IO a))) - (|>> :abstraction)) + [(def: label + (All (_ _ a) (-> (-> Any a) (IO a))) + (|>> :abstraction)) - (template: (!io computation) - [(:abstraction (template.with_locals [g!func g!arg] - (function (g!func g!arg) - computation)))]) + (template: (!io computation) + [(:abstraction (template.with_locals [g!func g!arg] + (function (g!func g!arg) + computation)))]) - (template: (run!' io) - ... creatio ex nihilo - [((:representation io) [])]) + (template: (run!' io) + ... creatio ex nihilo + [((:representation io) [])]) - (syntax: .public (io [computation <code>.any]) - (with_identifiers [g!func g!arg] - (in (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) - (~ computation)))))))) + (syntax: .public (io [computation <code>.any]) + (with_identifiers [g!func g!arg] + (in (list (` ((~! ..label) (function ((~ g!func) (~ g!arg)) + (~ computation)))))))) - (def: .public run! - (All (_ _ a) (-> (IO a) a)) - (|>> ..run!')) + (def: .public run! + (All (_ _ a) (-> (IO a) a)) + (|>> ..run!')) - (implementation: .public functor - (Functor IO) - - (def: (each f) - (|>> ..run!' f !io))) + (implementation: .public functor + (Functor IO) + + (def: (each f) + (|>> ..run!' f !io))) - (implementation: .public apply - (Apply IO) - - (def: &functor ..functor) + (implementation: .public apply + (Apply IO) + + (def: &functor ..functor) - (def: (on fa ff) - (!io ((..run!' ff) (..run!' fa))))) + (def: (on fa ff) + (!io ((..run!' ff) (..run!' fa))))) - (implementation: .public monad - (Monad IO) - - (def: &functor ..functor) + (implementation: .public monad + (Monad IO) + + (def: &functor ..functor) - (def: in - (|>> !io)) - - (def: conjoint - (|>> ..run!' ..run!' !io))) + (def: in + (|>> !io)) + + (def: conjoint + (|>> ..run!' ..run!' !io)))] ) diff --git a/stdlib/source/library/lux/control/lazy.lux b/stdlib/source/library/lux/control/lazy.lux index e38166d14..16b501d9e 100644 --- a/stdlib/source/library/lux/control/lazy.lux +++ b/stdlib/source/library/lux/control/lazy.lux @@ -18,27 +18,25 @@ abstract]]]) (abstract: .public (Lazy a) - {} - (-> [] a) - (def: (lazy' generator) - (All (_ a) (-> (-> [] a) (Lazy a))) - (let [cache (atom.atom #.None)] - (:abstraction (function (_ _) - (case (io.run! (atom.read! cache)) - (#.Some value) - value + [(def: (lazy' generator) + (All (_ a) (-> (-> [] a) (Lazy a))) + (let [cache (atom.atom #.None)] + (:abstraction (function (_ _) + (case (io.run! (atom.read! cache)) + (#.Some value) + value - _ - (let [value (generator [])] - (exec - (io.run! (atom.compare_and_swap! _ (#.Some value) cache)) - value))))))) + _ + (let [value (generator [])] + (exec + (io.run! (atom.compare_and_swap! _ (#.Some value) cache)) + value))))))) - (def: .public (value lazy) - (All (_ a) (-> (Lazy a) a)) - ((:representation lazy) []))) + (def: .public (value lazy) + (All (_ a) (-> (Lazy a) a)) + ((:representation lazy) []))]) (syntax: .public (lazy [expression <code>.any]) (with_identifiers [g!_] diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux index 49b19e07f..5d7ff9ebb 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -25,49 +25,47 @@ ["|[0]|" annotations]]]]]) (abstract: .public (Capability brand input output) - {} - (-> input output) - (def: capability - (All (_ brand input output) - (-> (-> input output) - (Capability brand input output))) - (|>> :abstraction)) + [(def: capability + (All (_ brand input output) + (-> (-> input output) + (Capability brand input output))) + (|>> :abstraction)) - (def: .public (use capability input) - (All (_ brand input output) - (-> (Capability brand input output) - input - output)) - ((:representation capability) input)) + (def: .public (use capability input) + (All (_ brand input output) + (-> (Capability brand input output) + input + output)) + ((:representation capability) input)) - (syntax: .public (capability: [[export_policy declaration annotations [forger input output]] - (|export|.parser - ($_ <>.and - |declaration|.parser - (<>.maybe |annotations|.parser) - (<c>.form ($_ <>.and <c>.local_identifier <c>.any <c>.any))))]) - (macro.with_identifiers [g!_] - (do [! meta.monad] - [this_module meta.current_module_name - .let [[name vars] declaration] - g!brand (\ ! each (|>> %.code code.text) - (macro.identifier (format (%.name [this_module name])))) - .let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] - (in (list (` (type: (~ export_policy) - (~ (|declaration|.format declaration)) - (~ capability))) - (` (def: (~ (code.local_identifier forger)) - (All ((~ g!_) (~+ (list\each code.local_identifier vars))) - (-> (-> (~ input) (~ output)) - (~ capability))) - (~! ..capability))) - ))))) + (syntax: .public (capability: [[export_policy declaration annotations [forger input output]] + (|export|.parser + ($_ <>.and + |declaration|.parser + (<>.maybe |annotations|.parser) + (<c>.form ($_ <>.and <c>.local_identifier <c>.any <c>.any))))]) + (macro.with_identifiers [g!_] + (do [! meta.monad] + [this_module meta.current_module_name + .let [[name vars] declaration] + g!brand (\ ! each (|>> %.code code.text) + (macro.identifier (format (%.name [this_module name])))) + .let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] + (in (list (` (type: (~ export_policy) + (~ (|declaration|.format declaration)) + (~ capability))) + (` (def: (~ (code.local_identifier forger)) + (All ((~ g!_) (~+ (list\each code.local_identifier vars))) + (-> (-> (~ input) (~ output)) + (~ capability))) + (~! ..capability))) + ))))) - (def: .public (async capability) - (All (_ brand input output) - (-> (Capability brand input (IO output)) - (Capability brand input (Async output)))) - (..capability (|>> ((:representation capability)) async.future))) + (def: .public (async capability) + (All (_ brand input output) + (-> (Capability brand input (IO output)) + (Capability brand input (Async output)))) + (..capability (|>> ((:representation capability)) async.future)))] ) diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux index 498469d63..f0a55bdd4 100644 --- a/stdlib/source/library/lux/control/security/policy.lux +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -9,89 +9,85 @@ abstract]]]) (abstract: .public (Policy brand value label) - {} - value - (type: .public (Can_Upgrade brand label value) - (-> value (Policy brand value label))) - - (type: .public (Can_Downgrade brand label value) - (-> (Policy brand value label) value)) - - (type: .public (Privilege brand label) - (Record - [#can_upgrade (Can_Upgrade brand label) - #can_downgrade (Can_Downgrade brand label)])) - - (type: .public (Delegation brand from to) - (All (_ value) - (-> (Policy brand value from) - (Policy brand value to)))) - - (def: .public (delegation downgrade upgrade) - (All (_ brand from to) - (-> (Can_Downgrade brand from) (Can_Upgrade brand to) - (Delegation brand from to))) - (|>> downgrade upgrade)) - - (type: .public (Context brand scope label) - (-> (Privilege brand label) - (scope label))) - - (def: privilege - Privilege - [#can_upgrade (|>> :abstraction) - #can_downgrade (|>> :representation)]) - - (def: .public (with_policy context) - (All (_ brand scope) - (Ex (_ label) - (-> (Context brand scope label) - (scope label)))) - (context ..privilege)) - - (def: (of_policy constructor) - (-> Type Type) - (type (All (_ brand label) - (constructor (All (_ value) (Policy brand value label)))))) - - (implementation: .public functor - (:~ (..of_policy Functor)) - - (def: (each f fa) - (|> fa :representation f :abstraction))) - - (implementation: .public apply - (:~ (..of_policy Apply)) - - (def: &functor ..functor) - - (def: (on fa ff) - (:abstraction ((:representation ff) (:representation fa))))) - - (implementation: .public monad - (:~ (..of_policy Monad)) - - (def: &functor ..functor) - (def: in (|>> :abstraction)) - (def: conjoint (|>> :representation))) + [(type: .public (Can_Upgrade brand label value) + (-> value (Policy brand value label))) + + (type: .public (Can_Downgrade brand label value) + (-> (Policy brand value label) value)) + + (type: .public (Privilege brand label) + (Record + [#can_upgrade (Can_Upgrade brand label) + #can_downgrade (Can_Downgrade brand label)])) + + (type: .public (Delegation brand from to) + (All (_ value) + (-> (Policy brand value from) + (Policy brand value to)))) + + (def: .public (delegation downgrade upgrade) + (All (_ brand from to) + (-> (Can_Downgrade brand from) (Can_Upgrade brand to) + (Delegation brand from to))) + (|>> downgrade upgrade)) + + (type: .public (Context brand scope label) + (-> (Privilege brand label) + (scope label))) + + (def: privilege + Privilege + [#can_upgrade (|>> :abstraction) + #can_downgrade (|>> :representation)]) + + (def: .public (with_policy context) + (All (_ brand scope) + (Ex (_ label) + (-> (Context brand scope label) + (scope label)))) + (context ..privilege)) + + (def: (of_policy constructor) + (-> Type Type) + (type (All (_ brand label) + (constructor (All (_ value) (Policy brand value label)))))) + + (implementation: .public functor + (:~ (..of_policy Functor)) + + (def: (each f fa) + (|> fa :representation f :abstraction))) + + (implementation: .public apply + (:~ (..of_policy Apply)) + + (def: &functor ..functor) + + (def: (on fa ff) + (:abstraction ((:representation ff) (:representation fa))))) + + (implementation: .public monad + (:~ (..of_policy Monad)) + + (def: &functor ..functor) + (def: in (|>> :abstraction)) + (def: conjoint (|>> :representation)))] ) (template [<brand> <value> <upgrade> <downgrade>] [(abstract: .public <brand> - {} - Any - (type: .public <value> - (Policy <brand>)) - - (type: .public <upgrade> - (Can_Upgrade <brand>)) - - (type: .public <downgrade> - (Can_Downgrade <brand>)) + [(type: .public <value> + (Policy <brand>)) + + (type: .public <upgrade> + (Can_Upgrade <brand>)) + + (type: .public <downgrade> + (Can_Downgrade <brand>))] )] [Privacy Private Can_Conceal Can_Reveal] diff --git a/stdlib/source/library/lux/control/thread.lux b/stdlib/source/library/lux/control/thread.lux index c583a4709..b2945a7a0 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -18,42 +18,40 @@ (-> ! a)) (abstract: .public (Box t v) - {} - (Array v) - (def: .public (box init) - (All (_ a) (-> a (All (_ !) (Thread ! (Box ! a))))) - (function (_ !) - (|> (array.empty 1) - (array.write! 0 init) - :abstraction))) - - (def: .public (read! box) - (All (_ ! a) (-> (Box ! a) (Thread ! a))) - (function (_ !) - (for {@.old - ("jvm aaload" (:representation box) 0) - - @.jvm - ("jvm array read object" - (|> 0 - (:as (primitive "java.lang.Long")) - "jvm object cast" - "jvm conversion long-to-int") - (:representation box)) - - @.js ("js array read" 0 (:representation box)) - @.python ("python array read" 0 (:representation box)) - @.lua ("lua array read" 0 (:representation box)) - @.ruby ("ruby array read" 0 (:representation box)) - @.php ("php array read" 0 (:representation box)) - @.scheme ("scheme array read" 0 (:representation box))}))) - - (def: .public (write! value box) - (All (_ a) (-> a (All (_ !) (-> (Box ! a) (Thread ! Any))))) - (function (_ !) - (|> box :representation (array.write! 0 value) :abstraction))) + [(def: .public (box init) + (All (_ a) (-> a (All (_ !) (Thread ! (Box ! a))))) + (function (_ !) + (|> (array.empty 1) + (array.write! 0 init) + :abstraction))) + + (def: .public (read! box) + (All (_ ! a) (-> (Box ! a) (Thread ! a))) + (function (_ !) + (for {@.old + ("jvm aaload" (:representation box) 0) + + @.jvm + ("jvm array read object" + (|> 0 + (:as (primitive "java.lang.Long")) + "jvm object cast" + "jvm conversion long-to-int") + (:representation box)) + + @.js ("js array read" 0 (:representation box)) + @.python ("python array read" 0 (:representation box)) + @.lua ("lua array read" 0 (:representation box)) + @.ruby ("ruby array read" 0 (:representation box)) + @.php ("php array read" 0 (:representation box)) + @.scheme ("scheme array read" 0 (:representation box))}))) + + (def: .public (write! value box) + (All (_ a) (-> a (All (_ !) (-> (Box ! a) (Thread ! Any))))) + (function (_ !) + (|> box :representation (array.write! 0 value) :abstraction)))] ) (def: .public (result thread) diff --git a/stdlib/source/library/lux/data/collection/queue/priority.lux b/stdlib/source/library/lux/data/collection/queue/priority.lux index f6fc98d98..28f1f135f 100644 --- a/stdlib/source/library/lux/data/collection/queue/priority.lux +++ b/stdlib/source/library/lux/data/collection/queue/priority.lux @@ -38,90 +38,88 @@ @)) (abstract: .public (Queue a) - {} - (Maybe (Tree :@: Priority a)) - (def: .public empty - Queue - (:abstraction #.None)) - - (def: .public (front queue) - (All (_ a) (-> (Queue a) (Maybe a))) - (do maybe.monad - [tree (:representation queue)] - (tree.one (n.= (tree.tag tree)) - tree))) - - (def: .public (size queue) - (All (_ a) (-> (Queue a) Nat)) - (case (:representation queue) - #.None - 0 - - (#.Some tree) - (loop [node tree] - (case (tree.root node) - (0 #0 _) - 1 - - (0 #1 [left right]) - (n.+ (recur left) (recur right)))))) - - (def: .public (member? equivalence queue member) - (All (_ a) (-> (Equivalence a) (Queue a) a Bit)) - (case (:representation queue) - #.None - false - - (#.Some tree) - (loop [node tree] - (case (tree.root node) - (0 #0 reference) - (\ equivalence = reference member) - - (0 #1 [left right]) - (or (recur left) - (recur right)))))) - - (def: .public (next queue) - (All (_ a) (-> (Queue a) (Queue a))) - (:abstraction + [(def: .public empty + Queue + (:abstraction #.None)) + + (def: .public (front queue) + (All (_ a) (-> (Queue a) (Maybe a))) (do maybe.monad - [tree (:representation queue) - .let [highest_priority (tree.tag tree)]] + [tree (:representation queue)] + (tree.one (n.= (tree.tag tree)) + tree))) + + (def: .public (size queue) + (All (_ a) (-> (Queue a) Nat)) + (case (:representation queue) + #.None + 0 + + (#.Some tree) + (loop [node tree] + (case (tree.root node) + (0 #0 _) + 1 + + (0 #1 [left right]) + (n.+ (recur left) (recur right)))))) + + (def: .public (member? equivalence queue member) + (All (_ a) (-> (Equivalence a) (Queue a) a Bit)) + (case (:representation queue) + #.None + false + + (#.Some tree) (loop [node tree] (case (tree.root node) (0 #0 reference) - (if (n.= highest_priority (tree.tag node)) - #.None - (#.Some node)) - - (0 #1 left right) - (if (n.= highest_priority (tree.tag left)) - (case (recur left) - #.None - (#.Some right) - - (#.Some =left) - (#.Some (\ ..builder branch =left right))) - (case (recur right) - #.None - (#.Some left) - - (#.Some =right) - (#.Some (\ ..builder branch left =right))))))))) - - (def: .public (end priority value queue) - (All (_ a) (-> Priority a (Queue a) (Queue a))) - (let [addition (\ ..builder leaf priority value)] - (:abstraction - (case (:representation queue) - #.None - (#.Some addition) - - (#.Some tree) - (#.Some (\ ..builder branch tree addition)))))) + (\ equivalence = reference member) + + (0 #1 [left right]) + (or (recur left) + (recur right)))))) + + (def: .public (next queue) + (All (_ a) (-> (Queue a) (Queue a))) + (:abstraction + (do maybe.monad + [tree (:representation queue) + .let [highest_priority (tree.tag tree)]] + (loop [node tree] + (case (tree.root node) + (0 #0 reference) + (if (n.= highest_priority (tree.tag node)) + #.None + (#.Some node)) + + (0 #1 left right) + (if (n.= highest_priority (tree.tag left)) + (case (recur left) + #.None + (#.Some right) + + (#.Some =left) + (#.Some (\ ..builder branch =left right))) + (case (recur right) + #.None + (#.Some left) + + (#.Some =right) + (#.Some (\ ..builder branch left =right))))))))) + + (def: .public (end priority value queue) + (All (_ a) (-> Priority a (Queue a) (Queue a))) + (let [addition (\ ..builder leaf priority value)] + (:abstraction + (case (:representation queue) + #.None + (#.Some addition) + + (#.Some tree) + (#.Some (\ ..builder branch tree addition))))))] ) (def: .public empty? diff --git a/stdlib/source/library/lux/data/collection/set/multi.lux b/stdlib/source/library/lux/data/collection/set/multi.lux index f3df37d57..cd36648eb 100644 --- a/stdlib/source/library/lux/data/collection/set/multi.lux +++ b/stdlib/source/library/lux/data/collection/set/multi.lux @@ -19,122 +19,120 @@ ["[0]" dictionary {"+" [Dictionary]}]]]) (abstract: .public (Set a) - {} - (Dictionary a Nat) - (def: .public empty - (All (_ a) (-> (Hash a) (Set a))) - (|>> dictionary.empty :abstraction)) - - (def: .public size - (All (_ a) (-> (Set a) Nat)) - (|>> :representation dictionary.values (list\mix n.+ 0))) - - (def: .public (has multiplicity elem set) - (All (_ a) (-> Nat a (Set a) (Set a))) - (case multiplicity - 0 set - _ (|> set - :representation - (dictionary.revised' elem 0 (n.+ multiplicity)) - :abstraction))) - - (def: .public (lacks multiplicity elem set) - (All (_ a) (-> Nat a (Set a) (Set a))) - (case multiplicity - 0 set - _ (case (dictionary.value elem (:representation set)) - (#.Some current) - (:abstraction - (if (n.> multiplicity current) - (dictionary.revised elem (n.- multiplicity) (:representation set)) - (dictionary.lacks elem (:representation set)))) - - #.None - set))) - - (def: .public (multiplicity set elem) - (All (_ a) (-> (Set a) a Nat)) - (|> set :representation (dictionary.value elem) (maybe.else 0))) - - (def: .public list - (All (_ a) (-> (Set a) (List a))) - (|>> :representation + [(def: .public empty + (All (_ a) (-> (Hash a) (Set a))) + (|>> dictionary.empty :abstraction)) + + (def: .public size + (All (_ a) (-> (Set a) Nat)) + (|>> :representation dictionary.values (list\mix n.+ 0))) + + (def: .public (has multiplicity elem set) + (All (_ a) (-> Nat a (Set a) (Set a))) + (case multiplicity + 0 set + _ (|> set + :representation + (dictionary.revised' elem 0 (n.+ multiplicity)) + :abstraction))) + + (def: .public (lacks multiplicity elem set) + (All (_ a) (-> Nat a (Set a) (Set a))) + (case multiplicity + 0 set + _ (case (dictionary.value elem (:representation set)) + (#.Some current) + (:abstraction + (if (n.> multiplicity current) + (dictionary.revised elem (n.- multiplicity) (:representation set)) + (dictionary.lacks elem (:representation set)))) + + #.None + set))) + + (def: .public (multiplicity set elem) + (All (_ a) (-> (Set a) a Nat)) + (|> set :representation (dictionary.value elem) (maybe.else 0))) + + (def: .public list + (All (_ a) (-> (Set a) (List a))) + (|>> :representation + dictionary.entries + (list\mix (function (_ [elem multiplicity] output) + (list\composite (list.repeated multiplicity elem) output)) + #.End))) + + (template [<name> <composite>] + [(def: .public (<name> parameter subject) + (All (_ a) (-> (Set a) (Set a) (Set a))) + (:abstraction (dictionary.merged_with <composite> (:representation parameter) (:representation subject))))] + + [union n.max] + [sum n.+] + ) + + (def: .public (intersection parameter (^:representation subject)) + (All (_ a) (-> (Set a) (Set a) (Set a))) + (list\mix (function (_ [elem multiplicity] output) + (..has (n.min (..multiplicity parameter elem) + multiplicity) + elem + output)) + (..empty (dictionary.key_hash subject)) + (dictionary.entries subject))) + + (def: .public (difference parameter subject) + (All (_ a) (-> (Set a) (Set a) (Set a))) + (|> parameter + :representation dictionary.entries (list\mix (function (_ [elem multiplicity] output) - (list\composite (list.repeated multiplicity elem) output)) - #.End))) - - (template [<name> <composite>] - [(def: .public (<name> parameter subject) - (All (_ a) (-> (Set a) (Set a) (Set a))) - (:abstraction (dictionary.merged_with <composite> (:representation parameter) (:representation subject))))] - - [union n.max] - [sum n.+] - ) - - (def: .public (intersection parameter (^:representation subject)) - (All (_ a) (-> (Set a) (Set a) (Set a))) - (list\mix (function (_ [elem multiplicity] output) - (..has (n.min (..multiplicity parameter elem) - multiplicity) - elem - output)) - (..empty (dictionary.key_hash subject)) - (dictionary.entries subject))) - - (def: .public (difference parameter subject) - (All (_ a) (-> (Set a) (Set a) (Set a))) - (|> parameter - :representation - dictionary.entries - (list\mix (function (_ [elem multiplicity] output) - (..lacks multiplicity elem output)) - subject))) - - (def: .public (sub? reference subject) - (All (_ a) (-> (Set a) (Set a) Bit)) - (|> subject - :representation - dictionary.entries - (list.every? (function (_ [elem multiplicity]) - (|> elem - (..multiplicity reference) - (n.>= multiplicity)))))) - - (def: .public (support set) - (All (_ a) (-> (Set a) (//.Set a))) - (let [(^@ set [hash _]) (:representation set)] - (|> set - dictionary.keys - (//.of_list hash)))) - - (implementation: .public equivalence - (All (_ a) (Equivalence (Set a))) - - (def: (= (^:representation reference) sample) - (and (n.= (dictionary.size reference) - (dictionary.size (:representation sample))) - (|> reference - dictionary.entries - (list.every? (function (_ [elem multiplicity]) - (|> elem - (..multiplicity sample) - (n.= multiplicity)))))))) - - (implementation: .public hash - (All (_ a) (Hash (Set a))) - - (def: &equivalence ..equivalence) - - (def: (hash (^:representation set)) - (let [[hash _] set] - (list\mix (function (_ [elem multiplicity] acc) - (|> elem (\ hash hash) (n.* multiplicity) (n.+ acc))) - 0 - (dictionary.entries set))))) + (..lacks multiplicity elem output)) + subject))) + + (def: .public (sub? reference subject) + (All (_ a) (-> (Set a) (Set a) Bit)) + (|> subject + :representation + dictionary.entries + (list.every? (function (_ [elem multiplicity]) + (|> elem + (..multiplicity reference) + (n.>= multiplicity)))))) + + (def: .public (support set) + (All (_ a) (-> (Set a) (//.Set a))) + (let [(^@ set [hash _]) (:representation set)] + (|> set + dictionary.keys + (//.of_list hash)))) + + (implementation: .public equivalence + (All (_ a) (Equivalence (Set a))) + + (def: (= (^:representation reference) sample) + (and (n.= (dictionary.size reference) + (dictionary.size (:representation sample))) + (|> reference + dictionary.entries + (list.every? (function (_ [elem multiplicity]) + (|> elem + (..multiplicity sample) + (n.= multiplicity)))))))) + + (implementation: .public hash + (All (_ a) (Hash (Set a))) + + (def: &equivalence ..equivalence) + + (def: (hash (^:representation set)) + (let [[hash _] set] + (list\mix (function (_ [elem multiplicity] acc) + (|> elem (\ hash hash) (n.* multiplicity) (n.+ acc))) + 0 + (dictionary.entries set)))))] ) (def: .public (member? set elem) diff --git a/stdlib/source/library/lux/data/collection/set/ordered.lux b/stdlib/source/library/lux/data/collection/set/ordered.lux index 91edd4642..a3bd77830 100644 --- a/stdlib/source/library/lux/data/collection/set/ordered.lux +++ b/stdlib/source/library/lux/data/collection/set/ordered.lux @@ -13,67 +13,65 @@ abstract]]]) (abstract: .public (Set a) - {} - (/.Dictionary a a) - (def: .public empty - (All (_ a) (-> (Order a) (Set a))) - (|>> /.empty :abstraction)) - - (def: .public (member? set elem) - (All (_ a) (-> (Set a) a Bit)) - (/.key? (:representation set) elem)) - - (template [<type> <name> <alias>] - [(def: .public <name> - (All (_ a) (-> (Set a) <type>)) - (|>> :representation <alias>))] - - [(Maybe a) min /.min] - [(Maybe a) max /.max] - [Nat size /.size] - [Bit empty? /.empty?] - ) - - (def: .public (has elem set) - (All (_ a) (-> a (Set a) (Set a))) - (|> set :representation (/.has elem elem) :abstraction)) - - (def: .public (lacks elem set) - (All (_ a) (-> a (Set a) (Set a))) - (|> set :representation (/.lacks elem) :abstraction)) - - (def: .public list - (All (_ a) (-> (Set a) (List a))) - (|>> :representation /.keys)) - - (def: .public (of_list &order list) - (All (_ a) (-> (Order a) (List a) (Set a))) - (list\mix has (..empty &order) list)) - - (def: .public (union left right) - (All (_ a) (-> (Set a) (Set a) (Set a))) - (list\mix ..has right (..list left))) - - (def: .public (intersection left right) - (All (_ a) (-> (Set a) (Set a) (Set a))) - (|> (..list right) - (list.only (..member? left)) - (..of_list (value@ #/.&order (:representation right))))) - - (def: .public (difference param subject) - (All (_ a) (-> (Set a) (Set a) (Set a))) - (|> (..list subject) - (list.only (|>> (..member? param) not)) - (..of_list (value@ #/.&order (:representation subject))))) - - (implementation: .public equivalence - (All (_ a) (Equivalence (Set a))) - - (def: (= reference sample) - (\ (list.equivalence (\ (:representation reference) &equivalence)) - = (..list reference) (..list sample)))) + [(def: .public empty + (All (_ a) (-> (Order a) (Set a))) + (|>> /.empty :abstraction)) + + (def: .public (member? set elem) + (All (_ a) (-> (Set a) a Bit)) + (/.key? (:representation set) elem)) + + (template [<type> <name> <alias>] + [(def: .public <name> + (All (_ a) (-> (Set a) <type>)) + (|>> :representation <alias>))] + + [(Maybe a) min /.min] + [(Maybe a) max /.max] + [Nat size /.size] + [Bit empty? /.empty?] + ) + + (def: .public (has elem set) + (All (_ a) (-> a (Set a) (Set a))) + (|> set :representation (/.has elem elem) :abstraction)) + + (def: .public (lacks elem set) + (All (_ a) (-> a (Set a) (Set a))) + (|> set :representation (/.lacks elem) :abstraction)) + + (def: .public list + (All (_ a) (-> (Set a) (List a))) + (|>> :representation /.keys)) + + (def: .public (of_list &order list) + (All (_ a) (-> (Order a) (List a) (Set a))) + (list\mix has (..empty &order) list)) + + (def: .public (union left right) + (All (_ a) (-> (Set a) (Set a) (Set a))) + (list\mix ..has right (..list left))) + + (def: .public (intersection left right) + (All (_ a) (-> (Set a) (Set a) (Set a))) + (|> (..list right) + (list.only (..member? left)) + (..of_list (value@ #/.&order (:representation right))))) + + (def: .public (difference param subject) + (All (_ a) (-> (Set a) (Set a) (Set a))) + (|> (..list subject) + (list.only (|>> (..member? param) not)) + (..of_list (value@ #/.&order (:representation subject))))) + + (implementation: .public equivalence + (All (_ a) (Equivalence (Set a))) + + (def: (= reference sample) + (\ (list.equivalence (\ (:representation reference) &equivalence)) + = (..list reference) (..list sample))))] ) (def: .public (sub? super sub) diff --git a/stdlib/source/library/lux/data/collection/stack.lux b/stdlib/source/library/lux/data/collection/stack.lux index f8ed6aab6..feb2d2805 100644 --- a/stdlib/source/library/lux/data/collection/stack.lux +++ b/stdlib/source/library/lux/data/collection/stack.lux @@ -11,58 +11,56 @@ abstract]]]) (abstract: .public (Stack a) - {} - (List a) - (def: .public empty - Stack - (:abstraction (list))) + [(def: .public empty + Stack + (:abstraction (list))) - (def: .public size - (All (_ a) (-> (Stack a) Nat)) - (|>> :representation //.size)) + (def: .public size + (All (_ a) (-> (Stack a) Nat)) + (|>> :representation //.size)) - (def: .public empty? - (All (_ a) (-> (Stack a) Bit)) - (|>> :representation //.empty?)) + (def: .public empty? + (All (_ a) (-> (Stack a) Bit)) + (|>> :representation //.empty?)) - (def: .public (value stack) - (All (_ a) (-> (Stack a) (Maybe a))) - (case (:representation stack) - #.End - #.None - - (#.Item value _) - (#.Some value))) + (def: .public (value stack) + (All (_ a) (-> (Stack a) (Maybe a))) + (case (:representation stack) + #.End + #.None + + (#.Item value _) + (#.Some value))) - (def: .public (next stack) - (All (_ a) (-> (Stack a) (Maybe [a (Stack a)]))) - (case (:representation stack) - #.End - #.None - - (#.Item top stack') - (#.Some [top (:abstraction stack')]))) + (def: .public (next stack) + (All (_ a) (-> (Stack a) (Maybe [a (Stack a)]))) + (case (:representation stack) + #.End + #.None + + (#.Item top stack') + (#.Some [top (:abstraction stack')]))) - (def: .public (top value stack) - (All (_ a) (-> a (Stack a) (Stack a))) - (:abstraction (#.Item value (:representation stack)))) + (def: .public (top value stack) + (All (_ a) (-> a (Stack a) (Stack a))) + (:abstraction (#.Item value (:representation stack)))) - (implementation: .public (equivalence super) - (All (_ a) - (-> (Equivalence a) - (Equivalence (Stack a)))) + (implementation: .public (equivalence super) + (All (_ a) + (-> (Equivalence a) + (Equivalence (Stack a)))) - (def: (= reference subject) - (\ (//.equivalence super) = (:representation reference) (:representation subject)))) + (def: (= reference subject) + (\ (//.equivalence super) = (:representation reference) (:representation subject)))) - (implementation: .public functor - (Functor Stack) - - (def: (each f value) - (|> value - :representation - (\ //.functor each f) - :abstraction))) + (implementation: .public functor + (Functor Stack) + + (def: (each f value) + (|> value + :representation + (\ //.functor each f) + :abstraction)))] ) diff --git a/stdlib/source/library/lux/data/collection/tree/finger.lux b/stdlib/source/library/lux/data/collection/tree/finger.lux index 998ccde41..b4e042069 100644 --- a/stdlib/source/library/lux/data/collection/tree/finger.lux +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -12,95 +12,93 @@ ... https://en.wikipedia.org/wiki/Finger_tree (abstract: .public (Tree @ t v) - {} - (Record [#monoid (Monoid t) #tag t #root (Or v [(Tree @ t v) (Tree @ t v)])]) - (type: .public (Builder @ t) - (Interface - (: (All (_ v) - (-> t v (Tree @ t v))) - leaf) - (: (All (_ v) - (-> (Tree @ t v) - (Tree @ t v) - (Tree @ t v))) - branch))) - - (template [<name> <tag> <output>] - [(def: .public <name> - (All (_ @ t v) (-> (Tree @ t v) <output>)) - (|>> :representation (value@ <tag>)))] - - [tag #tag t] - [root #root (Either v [(Tree @ t v) (Tree @ t v)])] - ) - - (implementation: .public (builder monoid) - (All (_ t) (Ex (_ @) (-> (Monoid t) (Builder @ t)))) - - (def: (leaf tag value) - (:abstraction - [#monoid monoid - #tag tag - #root (0 #0 value)])) - - (def: (branch left right) - (:abstraction - [#monoid monoid - #tag (\ monoid composite (..tag left) (..tag right)) - #root (0 #1 [left right])]))) - - (def: .public (value tree) - (All (_ @ t v) (-> (Tree @ t v) v)) - (case (value@ #root (:representation tree)) - (0 #0 value) - value - - (0 #1 [left right]) - (value left))) - - (def: .public (tags tree) - (All (_ @ t v) (-> (Tree @ t v) (List t))) - (case (value@ #root (:representation tree)) - (0 #0 value) - (list (value@ #tag (:representation tree))) - - (0 #1 [left right]) - (list\composite (tags left) - (tags right)))) - - (def: .public (values tree) - (All (_ @ t v) (-> (Tree @ t v) (List v))) - (case (value@ #root (:representation tree)) - (0 #0 value) - (list value) - - (0 #1 [left right]) - (list\composite (values left) - (values right)))) - - (def: .public (one predicate tree) - (All (_ @ t v) (-> (Predicate t) (Tree @ t v) (Maybe v))) - (let [[monoid tag root] (:representation tree)] - (if (predicate tag) - (let [(^open "tag//[0]") monoid] - (loop [_tag tag//identity - _node root] - (case _node - (0 #0 value) - (#.Some value) - - (0 #1 [left right]) - (let [shifted_tag (tag//composite _tag (..tag left))] - (if (predicate shifted_tag) - (recur _tag (value@ #root (:representation left))) - (recur shifted_tag (value@ #root (:representation right)))))))) - #.None))) + [(type: .public (Builder @ t) + (Interface + (: (All (_ v) + (-> t v (Tree @ t v))) + leaf) + (: (All (_ v) + (-> (Tree @ t v) + (Tree @ t v) + (Tree @ t v))) + branch))) + + (template [<name> <tag> <output>] + [(def: .public <name> + (All (_ @ t v) (-> (Tree @ t v) <output>)) + (|>> :representation (value@ <tag>)))] + + [tag #tag t] + [root #root (Either v [(Tree @ t v) (Tree @ t v)])] + ) + + (implementation: .public (builder monoid) + (All (_ t) (Ex (_ @) (-> (Monoid t) (Builder @ t)))) + + (def: (leaf tag value) + (:abstraction + [#monoid monoid + #tag tag + #root (0 #0 value)])) + + (def: (branch left right) + (:abstraction + [#monoid monoid + #tag (\ monoid composite (..tag left) (..tag right)) + #root (0 #1 [left right])]))) + + (def: .public (value tree) + (All (_ @ t v) (-> (Tree @ t v) v)) + (case (value@ #root (:representation tree)) + (0 #0 value) + value + + (0 #1 [left right]) + (value left))) + + (def: .public (tags tree) + (All (_ @ t v) (-> (Tree @ t v) (List t))) + (case (value@ #root (:representation tree)) + (0 #0 value) + (list (value@ #tag (:representation tree))) + + (0 #1 [left right]) + (list\composite (tags left) + (tags right)))) + + (def: .public (values tree) + (All (_ @ t v) (-> (Tree @ t v) (List v))) + (case (value@ #root (:representation tree)) + (0 #0 value) + (list value) + + (0 #1 [left right]) + (list\composite (values left) + (values right)))) + + (def: .public (one predicate tree) + (All (_ @ t v) (-> (Predicate t) (Tree @ t v) (Maybe v))) + (let [[monoid tag root] (:representation tree)] + (if (predicate tag) + (let [(^open "tag//[0]") monoid] + (loop [_tag tag//identity + _node root] + (case _node + (0 #0 value) + (#.Some value) + + (0 #1 [left right]) + (let [shifted_tag (tag//composite _tag (..tag left))] + (if (predicate shifted_tag) + (recur _tag (value@ #root (:representation left))) + (recur shifted_tag (value@ #root (:representation right)))))))) + #.None)))] ) (def: .public (exists? predicate tree) diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index 82a44b4cb..f396b712a 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -55,88 +55,86 @@ [Frac Frac Frac]) (abstract: .public Color - {} - RGB - (def: .public (of_rgb [red green blue]) - (-> RGB Color) - (:abstraction [#red (n.% ..rgb_limit red) - #green (n.% ..rgb_limit green) - #blue (n.% ..rgb_limit blue)])) - - (def: .public rgb - (-> Color RGB) - (|>> :representation)) - - (implementation: .public equivalence - (Equivalence Color) - - (def: (= reference sample) - (let [[rR gR bR] (:representation reference) - [rS gS bS] (:representation sample)] - (and (n.= rR rS) - (n.= gR gS) - (n.= bR bS))))) - - (implementation: .public hash - (Hash Color) - - (def: &equivalence ..equivalence) - - (def: (hash value) - (let [[r g b] (:representation value)] - ($_ i64.or - (i64.left_shifted 16 r) - (i64.left_shifted 8 g) - b)))) - - (def: .public black - Color - (..of_rgb [#red 0 - #green 0 - #blue 0])) - - (def: .public white - Color - (..of_rgb [#red ..top - #green ..top - #blue ..top])) - - (implementation: .public addition - (Monoid Color) - - (def: identity ..black) - - (def: (composite left right) - (let [[lR lG lB] (:representation left) - [rR rG rB] (:representation right)] - (:abstraction [#red (n.max lR rR) - #green (n.max lG rG) - #blue (n.max lB rB)])))) - - (def: (opposite_intensity value) - (-> Nat Nat) - (|> ..top (n.- value))) - - (def: .public (complement color) - (-> Color Color) - (let [[red green blue] (:representation color)] - (:abstraction [#red (opposite_intensity red) - #green (opposite_intensity green) - #blue (opposite_intensity blue)]))) - - (implementation: .public subtraction - (Monoid Color) - - (def: identity ..white) - - (def: (composite left right) - (let [[lR lG lB] (:representation (..complement left)) - [rR rG rB] (:representation right)] - (:abstraction [#red (n.min lR rR) - #green (n.min lG rG) - #blue (n.min lB rB)])))) + [(def: .public (of_rgb [red green blue]) + (-> RGB Color) + (:abstraction [#red (n.% ..rgb_limit red) + #green (n.% ..rgb_limit green) + #blue (n.% ..rgb_limit blue)])) + + (def: .public rgb + (-> Color RGB) + (|>> :representation)) + + (implementation: .public equivalence + (Equivalence Color) + + (def: (= reference sample) + (let [[rR gR bR] (:representation reference) + [rS gS bS] (:representation sample)] + (and (n.= rR rS) + (n.= gR gS) + (n.= bR bS))))) + + (implementation: .public hash + (Hash Color) + + (def: &equivalence ..equivalence) + + (def: (hash value) + (let [[r g b] (:representation value)] + ($_ i64.or + (i64.left_shifted 16 r) + (i64.left_shifted 8 g) + b)))) + + (def: .public black + Color + (..of_rgb [#red 0 + #green 0 + #blue 0])) + + (def: .public white + Color + (..of_rgb [#red ..top + #green ..top + #blue ..top])) + + (implementation: .public addition + (Monoid Color) + + (def: identity ..black) + + (def: (composite left right) + (let [[lR lG lB] (:representation left) + [rR rG rB] (:representation right)] + (:abstraction [#red (n.max lR rR) + #green (n.max lG rG) + #blue (n.max lB rB)])))) + + (def: (opposite_intensity value) + (-> Nat Nat) + (|> ..top (n.- value))) + + (def: .public (complement color) + (-> Color Color) + (let [[red green blue] (:representation color)] + (:abstraction [#red (opposite_intensity red) + #green (opposite_intensity green) + #blue (opposite_intensity blue)]))) + + (implementation: .public subtraction + (Monoid Color) + + (def: identity ..white) + + (def: (composite left right) + (let [[lR lG lB] (:representation (..complement left)) + [rR rG rB] (:representation right)] + (:abstraction [#red (n.min lR rR) + #green (n.min lG rG) + #blue (n.min lB rB)]))))] ) (def: .public (hsl color) diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/data/format/css.lux index 8f0cc2f06..a0d849ccf 100644 --- a/stdlib/source/library/lux/data/format/css.lux +++ b/stdlib/source/library/lux/data/format/css.lux @@ -22,114 +22,112 @@ ["[1][0]" style {"+" [Style]}] ["[1][0]" query {"+" [Query]}]]) -(abstract: .public Common {} Any) -(abstract: .public Special {} Any) +(abstract: .public Common Any []) +(abstract: .public Special Any []) (abstract: .public (CSS brand) - {} - Text - (def: .public css - (-> (CSS Any) Text) - (|>> :representation)) - - (def: .public empty - (CSS Common) - (:abstraction "")) + [(def: .public css + (-> (CSS Any) Text) + (|>> :representation)) + + (def: .public empty + (CSS Common) + (:abstraction "")) + + (def: .public (rule selector style) + (-> (Selector Any) Style (CSS Common)) + (:abstraction (format (/selector.selector selector) "{" (/style.inline style) "}"))) + + (def: .public char_set + (-> Encoding (CSS Special)) + (|>> encoding.name + %.text + (text.enclosed ["@charset " ";"]) + :abstraction)) + + (def: .public (font font) + (-> Font (CSS Special)) + (let [with_unicode (case (value@ #/font.unicode_range font) + (#.Some unicode_range) + (let [unicode_range' (format "U+" (\ nat.hex encoded (value@ #/font.start unicode_range)) + "-" (\ nat.hex encoded (value@ #/font.end unicode_range)))] + (list ["unicode-range" unicode_range'])) + + #.None + (list))] + (|> (list& ["font-family" (value@ #/font.family font)] + ["src" (format "url(" (value@ #/font.source font) ")")] + ["font-stretch" (|> font (value@ #/font.stretch) (maybe.else /value.normal_stretch) /value.value)] + ["font-style" (|> font (value@ #/font.style) (maybe.else /value.normal_style) /value.value)] + ["font-weight" (|> font (value@ #/font.weight) (maybe.else /value.normal_weight) /value.value)] + with_unicode) + (list\each (function (_ [property value]) + (format property ": " value ";"))) + (text.interposed /style.separator) + (text.enclosed ["{" "}"]) + (format "@font-face") + :abstraction))) + + (def: .public (import url query) + (-> URL (Maybe Query) (CSS Special)) + (:abstraction (format (format "@import url(" (%.text url) ")") + (case query + (#.Some query) + (format " " (/query.query query)) + + #.None + "") + ";"))) + + (def: css_separator + text.new_line) + + (type: .public Frame + (Record + [#when Percentage + #what Style])) + + (def: .public (key_frames animation frames) + (-> (Value Animation) (List Frame) (CSS Special)) + (:abstraction (format "@keyframes " (/value.value animation) " {" + (|> frames + (list\each (function (_ frame) + (format (/value.percentage (value@ #when frame)) " {" + (/style.inline (value@ #what frame)) + "}"))) + (text.interposed ..css_separator)) + "}"))) + + (template: (!composite <pre> <post>) + (:abstraction (format (:representation <pre>) ..css_separator + (:representation <post>)))) + + (def: .public (and pre post) + (-> (CSS Any) (CSS Any) (CSS Any)) + (!composite pre post)) + + (def: .public (alter combinator selector css) + (-> Combinator (Selector Any) (CSS Common) (CSS Common)) + (|> css + :representation + (text.all_split_by ..css_separator) + (list\each (|>> (format (/selector.selector (|> selector (combinator (/selector.tag ""))))))) + (text.interposed ..css_separator) + :abstraction)) - (def: .public (rule selector style) - (-> (Selector Any) Style (CSS Common)) - (:abstraction (format (/selector.selector selector) "{" (/style.inline style) "}"))) + (def: .public (dependent combinator selector style inner) + (-> Combinator (Selector Any) Style (CSS Common) (CSS Common)) + (!composite (..rule selector style) + (..alter combinator selector inner))) - (def: .public char_set - (-> Encoding (CSS Special)) - (|>> encoding.name - %.text - (text.enclosed ["@charset " ";"]) - :abstraction)) + (template [<name> <combinator>] + [(def: .public <name> + (-> (Selector Any) Style (CSS Common) (CSS Common)) + (..dependent <combinator>))] - (def: .public (font font) - (-> Font (CSS Special)) - (let [with_unicode (case (value@ #/font.unicode_range font) - (#.Some unicode_range) - (let [unicode_range' (format "U+" (\ nat.hex encoded (value@ #/font.start unicode_range)) - "-" (\ nat.hex encoded (value@ #/font.end unicode_range)))] - (list ["unicode-range" unicode_range'])) - - #.None - (list))] - (|> (list& ["font-family" (value@ #/font.family font)] - ["src" (format "url(" (value@ #/font.source font) ")")] - ["font-stretch" (|> font (value@ #/font.stretch) (maybe.else /value.normal_stretch) /value.value)] - ["font-style" (|> font (value@ #/font.style) (maybe.else /value.normal_style) /value.value)] - ["font-weight" (|> font (value@ #/font.weight) (maybe.else /value.normal_weight) /value.value)] - with_unicode) - (list\each (function (_ [property value]) - (format property ": " value ";"))) - (text.interposed /style.separator) - (text.enclosed ["{" "}"]) - (format "@font-face") - :abstraction))) - - (def: .public (import url query) - (-> URL (Maybe Query) (CSS Special)) - (:abstraction (format (format "@import url(" (%.text url) ")") - (case query - (#.Some query) - (format " " (/query.query query)) - - #.None - "") - ";"))) - - (def: css_separator - text.new_line) - - (type: .public Frame - (Record - [#when Percentage - #what Style])) - - (def: .public (key_frames animation frames) - (-> (Value Animation) (List Frame) (CSS Special)) - (:abstraction (format "@keyframes " (/value.value animation) " {" - (|> frames - (list\each (function (_ frame) - (format (/value.percentage (value@ #when frame)) " {" - (/style.inline (value@ #what frame)) - "}"))) - (text.interposed ..css_separator)) - "}"))) - - (template: (!composite <pre> <post>) - (:abstraction (format (:representation <pre>) ..css_separator - (:representation <post>)))) - - (def: .public (and pre post) - (-> (CSS Any) (CSS Any) (CSS Any)) - (!composite pre post)) - - (def: .public (alter combinator selector css) - (-> Combinator (Selector Any) (CSS Common) (CSS Common)) - (|> css - :representation - (text.all_split_by ..css_separator) - (list\each (|>> (format (/selector.selector (|> selector (combinator (/selector.tag ""))))))) - (text.interposed ..css_separator) - :abstraction)) - - (def: .public (dependent combinator selector style inner) - (-> Combinator (Selector Any) Style (CSS Common) (CSS Common)) - (!composite (..rule selector style) - (..alter combinator selector inner))) - - (template [<name> <combinator>] - [(def: .public <name> - (-> (Selector Any) Style (CSS Common) (CSS Common)) - (..dependent <combinator>))] - - [with_descendants /selector.in] - [with_children /selector.sub] - ) + [with_descendants /selector.in] + [with_children /selector.sub] + )] ) diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux index 19b11209c..27c5a880c 100644 --- a/stdlib/source/library/lux/data/format/css/property.lux +++ b/stdlib/source/library/lux/data/format/css/property.lux @@ -56,450 +56,448 @@ (in (list (code.local_identifier (text.replaced "-" "_" identifier))))) (abstract: .public (Property brand) - {} - Text - (def: .public name - (-> (Property Any) Text) - (|>> :representation)) - - (template [<brand> <alias>+ <property>+] - [(`` (template [<alias> <property>] - [(def: .public <alias> - (Property <brand>) - (:abstraction <property>))] - - (~~ (template.spliced <alias>+)))) - - (with_expansions [<rows> (template.spliced <property>+)] - (template [<property>] - [(`` (def: .public (~~ (text_identifier <property>)) - (Property <brand>) - (:abstraction <property>)))] - - <rows>))] - - [All - [] - [["all"]]] - - [Length - [] - [["border-image-outset"] - ["border-image-width"] - ["bottom"] - ["column-gap"] - ["column-width"] - ["flex-basis"] - ["grid-column-gap"] - ["grid-gap"] - ["grid-row-gap"] - ["height"] - ["left"] - ["letter-spacing"] - ["line-height"] - ["margin"] - ["margin-bottom"] - ["margin-left"] - ["margin-right"] - ["margin-top"] - ["max-height"] - ["max-width"] - ["min-height"] - ["min-width"] - ["outline-offset"] - ["padding"] - ["padding-bottom"] - ["padding-left"] - ["padding-right"] - ["padding-top"] - ["perspective"] - ["right"] - ["text-indent"] - ["top"] - ["width"] - ["word-spacing"]]] - - [Time - [] - [["animation-delay"] - ["animation-duration"] - ["transition-delay"] - ["transition-duration"]]] - - [Slice - [] - [["border-image-slice"]]] - - [Color - [[text_color "color"]] - [["background-color"] - ["border-color"] - ["border-bottom-color"] - ["border-left-color"] - ["border-right-color"] - ["border-top-color"] - ["caret-color"] - ["column-rule-color"] - ["outline-color"] - ["text-decoration-color"]]] - - [Alignment - [] - [["align-content"] - ["align-items"] - ["align-self"] - ["justify-content"]]] - - [Animation - [] - [["animation-name"]]] - - [Animation_Direction - [] - [["animation-direction"]]] - - [Animation_Fill - [] - [["animation-fill-mode"]]] - - [Column_Fill - [] - [["column-fill"]]] - - [Column_Span - [] - [["column-span"]]] - - [Iteration - [] - [["animation-iteration-count"]]] - - [Count - [] - [["column-count"] - ["flex-grow"] - ["flex-shrink"] - ["order"] - ["tab-size"]]] - - [Play - [] - [["animation-play-state"]]] - - [Timing - [] - [["animation-timing-function"] - ["transition-timing-function"]]] - - [Visibility - [] - [["backface-visibility"] - ["visibility"]]] - - [Attachment - [] - [["background-attachment"]]] - - [Blend - [] - [["background-blend-mode"] - ["mix-blend-mode"]]] - - [Image - [] - [["background-image"] - ["border-image-source"] - ["list-style-image"]]] - - [Span - [] - [["background-clip"] - ["background-origin"] - ["box-sizing"]]] - - [Location - [] - [["background-position"] - ["object-position"] - ["perspective-origin"]]] - - [Repeat - [] - [["background-repeat"] - ["border-image-repeat"]]] - - [Fit - [] - [["background-size"] - ["border-radius"] - ["border-bottom-left-radius"] - ["border-bottom-right-radius"] - ["border-top-left-radius"] - ["border-top-right-radius"] - ["border-spacing"] - ["object-fit"]]] - - [Border - [] - [["border-style"] - ["border-bottom-style"] - ["border-left-style"] - ["border-right-style"] - ["border-top-style"] - ["column-rule-style"] - ["outline-style"]]] - - [Thickness - [] - [["border-width"] - ["border-bottom-width"] - ["border-left-width"] - ["border-right-width"] - ["border-top-width"] - ["column-rule-width"] - ["outline-width"]]] - - [Collapse - [] - [["border-collapse"]]] - - [Box_Decoration_Break - [] - [["box-decoration-break"]]] - - [Caption - [] - [["caption-side"]]] - - [Clear - [] - [["clear"]]] - - [Shadow - [] - [["box-shadow"] - ["text-shadow"]]] - - [Clip - [] - [["clip"]]] - - [Content - [] - [["counter-reset"] - ["counter-increment"]]] - - [Cursor - [] - [["cursor"]]] - - [Text_Direction - [[text_direction "direction"]] - []] - - [Display - [] - [["display"]]] - - [Empty - [] - [["empty-cells"]]] - - [Filter - [] - [["filter"]]] - - [Flex_Direction - [] - [["flex-direction"]]] - - [Flex_Wrap - [] - [["flex-wrap"]]] - - [Float - [] - [["float"]]] - - [Font - [] - [["font-family"]]] - - [Font_Kerning - [] - [["font-kerning"]]] - - [Font_Size - [] - [["font-size"]]] - - [Number - [] - [["font-size-adjust"] - ["opacity"]]] - - [Font_Variant - [] - [["font-variant"]]] - - [Grid - [] - [["grid-area"]]] - - [Grid_Content - [] - [["grid-auto-columns"] - ["grid-auto-rows"] - ["grid-template-columns"] - ["grid-template-rows"]]] - - [Grid_Flow - [] - [["grid-auto-flow"]]] - - [Grid_Span - [] - [["grid-column-end"] - ["grid-column-start"] - ["grid-row-end"] - ["grid-row-start"]]] - - [Grid_Template - [] - [["grid-template-areas"]]] - - [Hanging_Punctuation - [] - [["hanging-punctuation"]]] - - [Hyphens - [] - [["hyphens"]]] - - [Isolation - [] - [["isolation"]]] - - [List_Style_Position - [] - [["list-style-position"]]] - - [List_Style_Type - [] - [["list-style-type"]]] - - [Overflow - [] - [["overflow"] - ["overflow-x"] - ["overflow-y"]]] - - [Page_Break - [] - [["page-break-after"] - ["page-break-before"] - ["page-break-inside"]]] - - [Pointer_Events - [] - [["pointer-events"]]] - - [Position - [] - [["position"]]] - - [Quotes - [] - [["quotes"]]] - - [Resize - [] - [["resize"]]] - - [Scroll_Behavior - [] - [["scroll-behavior"]]] - - [Table_Layout - [] - [["table-layout"]]] - - [Text_Align - [] - [["text-align"]]] - - [Text_Align_Last - [] - [["text-align-last"]]] - - [Text_Decoration_Line - [] - [["text-decoration-line"]]] - - [Text_Decoration_Style - [] - [["text-decoration-style"]]] - - [Text_Justification - [] - [["text-justify"]]] - - [Text_Overflow - [] - [["text-overflow"]]] - - [Text_Transform - [] - [["text-transform"]]] - - [Transform - [] - [["transform"]]] - - [Transform_Origin - [] - [["transform-origin"]]] - - [Transform_Style - [] - [["transform-style"]]] - - [Transition - [] - [["transition-property"]]] - - [Bidi - [] - [["unicode-bidi"]]] - - [User_Select - [] - [["user-select"]]] - - [Vertical_Align - [] - [["vertical-align"]]] - - [White_Space - [] - [["white-space"]]] - - [Word_Break - [] - [["word-break"]]] - - [Word_Wrap - [] - [["word-wrap"]]] - - [Writing_Mode - [] - [["writing-mode"]]] - - [Z_Index - [] - [["z-index"]]] - ) + [(def: .public name + (-> (Property Any) Text) + (|>> :representation)) + + (template [<brand> <alias>+ <property>+] + [(`` (template [<alias> <property>] + [(def: .public <alias> + (Property <brand>) + (:abstraction <property>))] + + (~~ (template.spliced <alias>+)))) + + (with_expansions [<rows> (template.spliced <property>+)] + (template [<property>] + [(`` (def: .public (~~ (text_identifier <property>)) + (Property <brand>) + (:abstraction <property>)))] + + <rows>))] + + [All + [] + [["all"]]] + + [Length + [] + [["border-image-outset"] + ["border-image-width"] + ["bottom"] + ["column-gap"] + ["column-width"] + ["flex-basis"] + ["grid-column-gap"] + ["grid-gap"] + ["grid-row-gap"] + ["height"] + ["left"] + ["letter-spacing"] + ["line-height"] + ["margin"] + ["margin-bottom"] + ["margin-left"] + ["margin-right"] + ["margin-top"] + ["max-height"] + ["max-width"] + ["min-height"] + ["min-width"] + ["outline-offset"] + ["padding"] + ["padding-bottom"] + ["padding-left"] + ["padding-right"] + ["padding-top"] + ["perspective"] + ["right"] + ["text-indent"] + ["top"] + ["width"] + ["word-spacing"]]] + + [Time + [] + [["animation-delay"] + ["animation-duration"] + ["transition-delay"] + ["transition-duration"]]] + + [Slice + [] + [["border-image-slice"]]] + + [Color + [[text_color "color"]] + [["background-color"] + ["border-color"] + ["border-bottom-color"] + ["border-left-color"] + ["border-right-color"] + ["border-top-color"] + ["caret-color"] + ["column-rule-color"] + ["outline-color"] + ["text-decoration-color"]]] + + [Alignment + [] + [["align-content"] + ["align-items"] + ["align-self"] + ["justify-content"]]] + + [Animation + [] + [["animation-name"]]] + + [Animation_Direction + [] + [["animation-direction"]]] + + [Animation_Fill + [] + [["animation-fill-mode"]]] + + [Column_Fill + [] + [["column-fill"]]] + + [Column_Span + [] + [["column-span"]]] + + [Iteration + [] + [["animation-iteration-count"]]] + + [Count + [] + [["column-count"] + ["flex-grow"] + ["flex-shrink"] + ["order"] + ["tab-size"]]] + + [Play + [] + [["animation-play-state"]]] + + [Timing + [] + [["animation-timing-function"] + ["transition-timing-function"]]] + + [Visibility + [] + [["backface-visibility"] + ["visibility"]]] + + [Attachment + [] + [["background-attachment"]]] + + [Blend + [] + [["background-blend-mode"] + ["mix-blend-mode"]]] + + [Image + [] + [["background-image"] + ["border-image-source"] + ["list-style-image"]]] + + [Span + [] + [["background-clip"] + ["background-origin"] + ["box-sizing"]]] + + [Location + [] + [["background-position"] + ["object-position"] + ["perspective-origin"]]] + + [Repeat + [] + [["background-repeat"] + ["border-image-repeat"]]] + + [Fit + [] + [["background-size"] + ["border-radius"] + ["border-bottom-left-radius"] + ["border-bottom-right-radius"] + ["border-top-left-radius"] + ["border-top-right-radius"] + ["border-spacing"] + ["object-fit"]]] + + [Border + [] + [["border-style"] + ["border-bottom-style"] + ["border-left-style"] + ["border-right-style"] + ["border-top-style"] + ["column-rule-style"] + ["outline-style"]]] + + [Thickness + [] + [["border-width"] + ["border-bottom-width"] + ["border-left-width"] + ["border-right-width"] + ["border-top-width"] + ["column-rule-width"] + ["outline-width"]]] + + [Collapse + [] + [["border-collapse"]]] + + [Box_Decoration_Break + [] + [["box-decoration-break"]]] + + [Caption + [] + [["caption-side"]]] + + [Clear + [] + [["clear"]]] + + [Shadow + [] + [["box-shadow"] + ["text-shadow"]]] + + [Clip + [] + [["clip"]]] + + [Content + [] + [["counter-reset"] + ["counter-increment"]]] + + [Cursor + [] + [["cursor"]]] + + [Text_Direction + [[text_direction "direction"]] + []] + + [Display + [] + [["display"]]] + + [Empty + [] + [["empty-cells"]]] + + [Filter + [] + [["filter"]]] + + [Flex_Direction + [] + [["flex-direction"]]] + + [Flex_Wrap + [] + [["flex-wrap"]]] + + [Float + [] + [["float"]]] + + [Font + [] + [["font-family"]]] + + [Font_Kerning + [] + [["font-kerning"]]] + + [Font_Size + [] + [["font-size"]]] + + [Number + [] + [["font-size-adjust"] + ["opacity"]]] + + [Font_Variant + [] + [["font-variant"]]] + + [Grid + [] + [["grid-area"]]] + + [Grid_Content + [] + [["grid-auto-columns"] + ["grid-auto-rows"] + ["grid-template-columns"] + ["grid-template-rows"]]] + + [Grid_Flow + [] + [["grid-auto-flow"]]] + + [Grid_Span + [] + [["grid-column-end"] + ["grid-column-start"] + ["grid-row-end"] + ["grid-row-start"]]] + + [Grid_Template + [] + [["grid-template-areas"]]] + + [Hanging_Punctuation + [] + [["hanging-punctuation"]]] + + [Hyphens + [] + [["hyphens"]]] + + [Isolation + [] + [["isolation"]]] + + [List_Style_Position + [] + [["list-style-position"]]] + + [List_Style_Type + [] + [["list-style-type"]]] + + [Overflow + [] + [["overflow"] + ["overflow-x"] + ["overflow-y"]]] + + [Page_Break + [] + [["page-break-after"] + ["page-break-before"] + ["page-break-inside"]]] + + [Pointer_Events + [] + [["pointer-events"]]] + + [Position + [] + [["position"]]] + + [Quotes + [] + [["quotes"]]] + + [Resize + [] + [["resize"]]] + + [Scroll_Behavior + [] + [["scroll-behavior"]]] + + [Table_Layout + [] + [["table-layout"]]] + + [Text_Align + [] + [["text-align"]]] + + [Text_Align_Last + [] + [["text-align-last"]]] + + [Text_Decoration_Line + [] + [["text-decoration-line"]]] + + [Text_Decoration_Style + [] + [["text-decoration-style"]]] + + [Text_Justification + [] + [["text-justify"]]] + + [Text_Overflow + [] + [["text-overflow"]]] + + [Text_Transform + [] + [["text-transform"]]] + + [Transform + [] + [["transform"]]] + + [Transform_Origin + [] + [["transform-origin"]]] + + [Transform_Style + [] + [["transform-style"]]] + + [Transition + [] + [["transition-property"]]] + + [Bidi + [] + [["unicode-bidi"]]] + + [User_Select + [] + [["user-select"]]] + + [Vertical_Align + [] + [["vertical-align"]]] + + [White_Space + [] + [["white-space"]]] + + [Word_Break + [] + [["word-break"]]] + + [Word_Wrap + [] + [["word-wrap"]]] + + [Writing_Mode + [] + [["writing-mode"]]] + + [Z_Index + [] + [["z-index"]]] + )] ) diff --git a/stdlib/source/library/lux/data/format/css/query.lux b/stdlib/source/library/lux/data/format/css/query.lux index adaed39ab..fe4c8f7d4 100644 --- a/stdlib/source/library/lux/data/format/css/query.lux +++ b/stdlib/source/library/lux/data/format/css/query.lux @@ -25,117 +25,111 @@ (in (list (code.local_identifier (text.replaced "-" "_" identifier))))) (abstract: .public Media - {} - Text - (def: .public media - (-> Media Text) - (|>> :representation)) + [(def: .public media + (-> Media Text) + (|>> :representation)) - (template [<media>] - [(`` (def: .public (~~ (text_identifier <media>)) - Media - (:abstraction <media>)))] + (template [<media>] + [(`` (def: .public (~~ (text_identifier <media>)) + Media + (:abstraction <media>)))] - ["all"] - ["print"] - ["screen"] - ["speech"] - )) + ["all"] + ["print"] + ["screen"] + ["speech"] + )]) (abstract: .public Feature - {} - Text - (def: .public feature - (-> Feature Text) - (|>> :representation)) - - (template [<feature> <brand>] - [(`` (def: .public ((~~ (text_identifier <feature>)) input) - (-> (Value <brand>) Feature) - (:abstraction (format "(" <feature> ": " (//value.value input) ")"))))] - - ["min-color" Count] - ["color" Count] - ["max-color" Count] - - ["min-color-index" Count] - ["color-index" Count] - ["max-color-index" Count] - - ["min-monochrome" Count] - ["monochrome" Count] - ["max-monochrome" Count] - - ["min-height" Length] - ["height" Length] - ["max-height" Length] - - ["min-width" Length] - ["width" Length] - ["max-width" Length] - - ["min-resolution" Resolution] - ["resolution" Resolution] - ["max-resolution" Resolution] - - ["aspect-ratio" Ratio] - ["max-aspect-ratio" Ratio] - ["min-aspect-ratio" Ratio] - - ["display-mode" Display_Mode] - ["color-gamut" Color_Gamut] - ["grid" Boolean] - ["orientation" Orientation] - ["overflow-block" Block_Overflow] - ["overflow-inline" Inline_Overflow] - ["scan" Scan] - ["update" Update] - ["inverted-colors" Inverted_Colors] - ["pointer" Pointer] - ["any-pointer" Pointer] - ["hover" Hover] - ["any-hover" Hover] - ["light-level" Light] - ["scripting" Scripting] - ["prefers-reduced-motion" Motion] - ["prefers-color-scheme" Color_Scheme] - ) + [(def: .public feature + (-> Feature Text) + (|>> :representation)) + + (template [<feature> <brand>] + [(`` (def: .public ((~~ (text_identifier <feature>)) input) + (-> (Value <brand>) Feature) + (:abstraction (format "(" <feature> ": " (//value.value input) ")"))))] + + ["min-color" Count] + ["color" Count] + ["max-color" Count] + + ["min-color-index" Count] + ["color-index" Count] + ["max-color-index" Count] + + ["min-monochrome" Count] + ["monochrome" Count] + ["max-monochrome" Count] + + ["min-height" Length] + ["height" Length] + ["max-height" Length] + + ["min-width" Length] + ["width" Length] + ["max-width" Length] + + ["min-resolution" Resolution] + ["resolution" Resolution] + ["max-resolution" Resolution] + + ["aspect-ratio" Ratio] + ["max-aspect-ratio" Ratio] + ["min-aspect-ratio" Ratio] + + ["display-mode" Display_Mode] + ["color-gamut" Color_Gamut] + ["grid" Boolean] + ["orientation" Orientation] + ["overflow-block" Block_Overflow] + ["overflow-inline" Inline_Overflow] + ["scan" Scan] + ["update" Update] + ["inverted-colors" Inverted_Colors] + ["pointer" Pointer] + ["any-pointer" Pointer] + ["hover" Hover] + ["any-hover" Hover] + ["light-level" Light] + ["scripting" Scripting] + ["prefers-reduced-motion" Motion] + ["prefers-color-scheme" Color_Scheme] + )] ) (abstract: .public Query - {} - Text - (def: .public query - (-> Query Text) - (|>> :representation)) - - (template [<name> <operator>] - [(def: .public <name> - (-> Media Query) - (|>> ..media (format <operator>) :abstraction))] - - [except "not "] - [only "only "] - ) - - (def: .public not - (-> Feature Query) - (|>> ..feature (format "not ") :abstraction)) - - (template [<name> <operator>] - [(def: .public (<name> left right) - (-> Query Query Query) - (:abstraction (format (:representation left) - <operator> - (:representation right))))] - - [and " and "] - [or " or "] - ) + [(def: .public query + (-> Query Text) + (|>> :representation)) + + (template [<name> <operator>] + [(def: .public <name> + (-> Media Query) + (|>> ..media (format <operator>) :abstraction))] + + [except "not "] + [only "only "] + ) + + (def: .public not + (-> Feature Query) + (|>> ..feature (format "not ") :abstraction)) + + (template [<name> <operator>] + [(def: .public (<name> left right) + (-> Query Query Query) + (:abstraction (format (:representation left) + <operator> + (:representation right))))] + + [and " and "] + [or " or "] + )] ) diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/data/format/css/selector.lux index c2742f93a..38eda4881 100644 --- a/stdlib/source/library/lux/data/format/css/selector.lux +++ b/stdlib/source/library/lux/data/format/css/selector.lux @@ -19,192 +19,188 @@ (type: .public Class Label) (type: .public Attribute Label) -(abstract: .public (Generic brand) {} Any) +(abstract: .public (Generic brand) Any []) (template [<generic> <brand>] - [(abstract: <brand> {} Any) + [(abstract: <brand> Any []) (type: .public <generic> (Generic <brand>))] [Can_Chain Can_Chain'] [Cannot_Chain Cannot_Chain'] ) -(abstract: .public Unique {} Any) -(abstract: .public Specific {} Any) -(abstract: .public Composite {} Any) +(abstract: .public Unique Any []) +(abstract: .public Specific Any []) +(abstract: .public Composite Any []) (abstract: .public (Selector kind) - {} - Text - (def: .public selector - (-> (Selector Any) Text) - (|>> :representation)) - - (def: .public any - (Selector Cannot_Chain) - (:abstraction "*")) - - (def: .public tag - (-> Tag (Selector Cannot_Chain)) - (|>> :abstraction)) - - (template [<name> <type> <prefix> <kind>] - [(def: .public <name> - (-> <type> (Selector <kind>)) - (|>> (format <prefix>) :abstraction))] - - [id ID "#" Unique] - [class Class "." Can_Chain] - ) - - (template [<right> <left> <combo> <combinator>+] - [(`` (template [<combinator> <name>] - [(def: .public (<name> right left) - (-> (Selector <right>) (Selector <left>) (Selector <combo>)) - (:abstraction (format (:representation left) - <combinator> - (:representation right))))] - - (~~ (template.spliced <combinator>+))))] - - [Can_Chain (Generic Any) Can_Chain - [["" and]]] - [Unique (Generic Any) Composite - [["" for]]] - [Specific (Generic Any) Composite - [["" at]]] - [Any Any Composite - [["," or] - [" " in] - [">" sub] - ["+" next] - ["~" later]]] - ) - - (type: .public Combinator - (-> (Selector Any) (Selector Any) (Selector Composite))) - - (def: .public (with? attribute) - (-> Attribute (Selector Can_Chain)) - (:abstraction (format "[" attribute "]"))) - - (template [<check> <name>] - [(def: .public (<name> attribute value) - (-> Attribute Text (Selector Can_Chain)) - (:abstraction (format "[" attribute <check> value "]")))] - - ["=" same?] - ["~=" has?] - ["|=" has_start?] - ["^=" starts?] - ["$=" ends?] - ["*=" contains?] - ) - - (template [<kind> <pseudo>+] - [(`` (template [<name> <pseudo>] - [(def: .public <name> - (Selector Can_Chain) - (:abstraction <pseudo>))] - - (~~ (template.spliced <pseudo>+))))] - - [Can_Chain - [[active ":active"] - [checked ":checked"] - [default ":default"] - [disabled ":disabled"] - [empty ":empty"] - [enabled ":enabled"] - [first_child ":first-child"] - [first_of_type ":first-of-type"] - [focused ":focus"] - [hovered ":hover"] - [in_range ":in-range"] - [indeterminate ":indeterminate"] - [invalid ":invalid"] - [last_child ":last-child"] - [last_of_type ":last-of-type"] - [link ":link"] - [only_of_type ":only-of-type"] - [only_child ":only-child"] - [optional ":optional"] - [out_of_range ":out-of-range"] - [read_only ":read-only"] - [read_write ":read-write"] - [required ":required"] - [root ":root"] - [target ":target"] - [valid ":valid"] - [visited ":visited"]]] - - [Specific - [[after "::after"] - [before "::before"] - [first_letter "::first-letter"] - [first_line "::first-line"] - [placeholder "::placeholder"] - [selection "::selection"]]] - ) - - (def: .public (language locale) - (-> Locale (Selector Can_Chain)) - (|> locale - locale.code - (text.enclosed ["(" ")"]) - (format ":lang") - :abstraction)) - - (def: .public not - (-> (Selector Any) (Selector Can_Chain)) - (|>> :representation + [(def: .public selector + (-> (Selector Any) Text) + (|>> :representation)) + + (def: .public any + (Selector Cannot_Chain) + (:abstraction "*")) + + (def: .public tag + (-> Tag (Selector Cannot_Chain)) + (|>> :abstraction)) + + (template [<name> <type> <prefix> <kind>] + [(def: .public <name> + (-> <type> (Selector <kind>)) + (|>> (format <prefix>) :abstraction))] + + [id ID "#" Unique] + [class Class "." Can_Chain] + ) + + (template [<right> <left> <combo> <combinator>+] + [(`` (template [<combinator> <name>] + [(def: .public (<name> right left) + (-> (Selector <right>) (Selector <left>) (Selector <combo>)) + (:abstraction (format (:representation left) + <combinator> + (:representation right))))] + + (~~ (template.spliced <combinator>+))))] + + [Can_Chain (Generic Any) Can_Chain + [["" and]]] + [Unique (Generic Any) Composite + [["" for]]] + [Specific (Generic Any) Composite + [["" at]]] + [Any Any Composite + [["," or] + [" " in] + [">" sub] + ["+" next] + ["~" later]]] + ) + + (type: .public Combinator + (-> (Selector Any) (Selector Any) (Selector Composite))) + + (def: .public (with? attribute) + (-> Attribute (Selector Can_Chain)) + (:abstraction (format "[" attribute "]"))) + + (template [<check> <name>] + [(def: .public (<name> attribute value) + (-> Attribute Text (Selector Can_Chain)) + (:abstraction (format "[" attribute <check> value "]")))] + + ["=" same?] + ["~=" has?] + ["|=" has_start?] + ["^=" starts?] + ["$=" ends?] + ["*=" contains?] + ) + + (template [<kind> <pseudo>+] + [(`` (template [<name> <pseudo>] + [(def: .public <name> + (Selector Can_Chain) + (:abstraction <pseudo>))] + + (~~ (template.spliced <pseudo>+))))] + + [Can_Chain + [[active ":active"] + [checked ":checked"] + [default ":default"] + [disabled ":disabled"] + [empty ":empty"] + [enabled ":enabled"] + [first_child ":first-child"] + [first_of_type ":first-of-type"] + [focused ":focus"] + [hovered ":hover"] + [in_range ":in-range"] + [indeterminate ":indeterminate"] + [invalid ":invalid"] + [last_child ":last-child"] + [last_of_type ":last-of-type"] + [link ":link"] + [only_of_type ":only-of-type"] + [only_child ":only-child"] + [optional ":optional"] + [out_of_range ":out-of-range"] + [read_only ":read-only"] + [read_write ":read-write"] + [required ":required"] + [root ":root"] + [target ":target"] + [valid ":valid"] + [visited ":visited"]]] + + [Specific + [[after "::after"] + [before "::before"] + [first_letter "::first-letter"] + [first_line "::first-line"] + [placeholder "::placeholder"] + [selection "::selection"]]] + ) + + (def: .public (language locale) + (-> Locale (Selector Can_Chain)) + (|> locale + locale.code (text.enclosed ["(" ")"]) - (format ":not") + (format ":lang") :abstraction)) - (abstract: .public Index - {} - - Text - - (def: .public index - (-> Nat Index) - (|>> %.nat :abstraction)) - - (template [<name> <index>] - [(def: .public <name> Index (:abstraction <index>))] + (def: .public not + (-> (Selector Any) (Selector Can_Chain)) + (|>> :representation + (text.enclosed ["(" ")"]) + (format ":not") + :abstraction)) + + (abstract: .public Index + Text + + [(def: .public index + (-> Nat Index) + (|>> %.nat :abstraction)) + + (template [<name> <index>] + [(def: .public <name> Index (:abstraction <index>))] + + [odd "odd"] + [even "even"] + ) + + (type: .public Formula + (Record + [#constant Int + #variable Int])) + + (def: .public (formula input) + (-> Formula Index) + (let [(^slots [#constant #variable]) input] + (:abstraction (format (if (i.< +0 variable) + (%.int variable) + (%.nat (.nat variable))) + (%.int constant))))) - [odd "odd"] - [even "even"] - ) - - (type: .public Formula - (Record - [#constant Int - #variable Int])) - - (def: .public (formula input) - (-> Formula Index) - (let [(^slots [#constant #variable]) input] - (:abstraction (format (if (i.< +0 variable) - (%.int variable) - (%.nat (.nat variable))) - (%.int constant))))) - - (template [<name> <pseudo>] - [(def: .public (<name> index) - (-> Index (Selector Can_Chain)) - (|> (:representation index) - (text.enclosed ["(" ")"]) - (format <pseudo>) - (:abstraction Selector)))] - - [nth_child ":nth-child"] - [nth_last_child ":nth-last-child"] - [nth_last_of_type ":nth-last-of-type"] - [nth_of_type ":nth-of-type"] - ) - ) + (template [<name> <pseudo>] + [(def: .public (<name> index) + (-> Index (Selector Can_Chain)) + (|> (:representation index) + (text.enclosed ["(" ")"]) + (format <pseudo>) + (:abstraction Selector)))] + + [nth_child ":nth-child"] + [nth_last_child ":nth-last-child"] + [nth_last_of_type ":nth-last-of-type"] + [nth_of_type ":nth-of-type"] + )] + )] ) diff --git a/stdlib/source/library/lux/data/format/css/style.lux b/stdlib/source/library/lux/data/format/css/style.lux index 8fe761893..37b80b4ce 100644 --- a/stdlib/source/library/lux/data/format/css/style.lux +++ b/stdlib/source/library/lux/data/format/css/style.lux @@ -11,26 +11,24 @@ ["[1][0]" property {"+" [Property]}]]) (abstract: .public Style - {#.doc "The style associated with a CSS selector."} - Text - (def: .public empty - Style - (:abstraction "")) + [(def: .public empty + Style + (:abstraction "")) - (def: .public separator - " ") + (def: .public separator + " ") - (def: .public (with [property value]) - (All (_ brand) - (-> [(Property brand) (Value brand)] - (-> Style Style))) - (|>> :representation - (format (//property.name property) ": " (//value.value value) ";" ..separator) - :abstraction)) + (def: .public (with [property value]) + (All (_ brand) + (-> [(Property brand) (Value brand)] + (-> Style Style))) + (|>> :representation + (format (//property.name property) ": " (//value.value value) ";" ..separator) + :abstraction)) - (def: .public inline - (-> Style Text) - (|>> :representation)) + (def: .public inline + (-> Style Text) + (|>> :representation))] ) diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux index 9569c445b..ae4393448 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -33,21 +33,19 @@ (template: (enumeration: <abstraction> <representation> <out> <sample>+ <definition>+) (abstract: .public <abstraction> - {} - <representation> - (def: .public <out> - (-> <abstraction> <representation>) - (|>> :representation)) + [(def: .public <out> + (-> <abstraction> <representation>) + (|>> :representation)) - (`` (template [<name> <value>] - [(def: .public <name> <abstraction> (:abstraction <value>))] + (`` (template [<name> <value>] + [(def: .public <name> <abstraction> (:abstraction <value>))] - (~~ (template.spliced <sample>+)) - )) + (~~ (template.spliced <sample>+)) + )) - (template.spliced <definition>+))) + (template.spliced <definition>+)])) (template: (multi: <multi> <type> <separator>) (def: .public (<multi> pre post) @@ -64,1281 +62,1271 @@ (|> raw (text.split_at 1) maybe.trusted product.right)))) (abstract: .public (Value brand) - {} - Text - (def: .public value - (-> (Value Any) Text) - (|>> :representation)) - - (template [<name> <value>] - [(def: .public <name> Value (:abstraction <value>))] - - [initial "initial"] - [inherit "inherit"] - [unset "unset"] - ) - - (template [<brand> <alias>+ <value>+] - [(abstract: .public <brand> {} Any) - - (`` (template [<name> <value>] - [(def: .public <name> - (Value <brand>) - (:abstraction <value>))] - - (~~ (template.spliced <alias>+)))) - - (with_expansions [<rows> (template.spliced <value>+)] - (template [<value>] - [(`` (def: .public (~~ (..text_identifier <value>)) - (Value <brand>) - (:abstraction <value>)))] - - <rows>))] - - [All - [] - []] - - [Number - [] - []] - - [Length - [] - []] - - [Time - [] - []] - - [Thickness - [] - [["medium"] - ["thin"] - ["thick"]]] - - [Slice - [[full_slice "fill"]] - []] - - [Alignment - [[auto_alignment "auto"]] - [["stretch"] - ["center"] - ["flex-start"] - ["flex-end"] - ["baseline"] - ["space-between"] - ["space-around"]]] - - [Animation - [] - []] - - [Animation_Direction - [[normal_direction "normal"]] - [["reverse"] - ["alternate"] - ["alternate-reverse"]]] - - [Animation_Fill - [[fill_forwards "forwards"] - [fill_backwards "backwards"] - [fill_both "both"]] - []] - - [Column_Fill - [] - [["balance"] - ["auto"]]] - - [Column_Span - [] - [["all"]]] - - [Iteration - [] - [["infinite"]]] - - [Count - [] - []] - - [Play - [] - [["paused"] - ["running"]]] - - [Timing - [] - [["linear"] - ["ease"] - ["ease-in"] - ["ease-out"] - ["ease-in-out"] - ["step-start"] - ["step-end"]]] - - [Visibility - [[invisible "hidden"] - [collapse_visibility "collapse"]] - [["visible"]]] - - [Attachment - [[scroll_attachment "scroll"] - [fixed_attachment "fixed"] - [local_attachment "local"]] - []] - - [Blend - [[normal_blend "normal"]] - [["multiply"] - ["screen"] - ["overlay"] - ["darken"] - ["lighten"] - ["color-dodge"] - ["color-burn"] - ["difference"] - ["exclusion"] - ["hue"] - ["saturation"] - ["color"] - ["luminosity"]]] - - [Span - [] - [["border-box"] - ["padding-box"] - ["content-box"]]] - - [Image - [[no_image "none"]] - []] - - [Repeat - [[stretch_repeat "stretch"]] - [["repeat"] - ["repeat-x"] - ["repeat-y"] - ["no-repeat"] - ["space"] - ["round"]]] - - [Location - [[left_top "left top"] - [left_center "left center"] - [left_bottom "left bottom"] - [right_top "right top"] - [right_center "right center"] - [right_bottom "right bottom"] - [center_top "center top"] - [center_center "center center"] - [center_bottom "center bottom"]] - []] - - [Fit - [[no_fit "none"]] - [["fill"] - ["cover"] - ["contain"] - ["scale-down"]]] - - [Border - [] - [["hidden"] - ["dotted"] - ["dashed"] - ["solid"] - ["double"] - ["groove"] - ["ridge"] - ["inset"] - ["outset"]]] - - [Collapse - [] - [["separate"] - ["collapse"]]] - - [Box_Decoration_Break - [] - [["slice"] - ["clone"]]] - - [Caption - [] - [["top"] - ["bottom"]]] - - [Float - [[float_left "left"] - [float_right "right"]] - []] - - [Clear - [[clear_left "left"] - [clear_right "right"] - [clear_both "both"]] - []] - - [Counter - [] - []] - - [Content - [] - [["open-quote"] - ["close-quote"] - ["no-open-quote"] - ["no-close-quote"]]] - - [Cursor - [[horizontal_text "text"] - [no_cursor "none"]] - [["alias"] - ["all-scroll"] - ["cell"] - ["context-menu"] - ["col-resize"] - ["copy"] - ["crosshair"] - ["default"] - ["e-resize"] - ["ew-resize"] - ["grab"] - ["grabbing"] - ["help"] - ["move"] - ["n-resize"] - ["ne-resize"] - ["nesw-resize"] - ["ns-resize"] - ["nw-resize"] - ["nwse-resize"] - ["no-drop"] - ["not-allowed"] - ["pointer"] - ["progress"] - ["row-resize"] - ["s-resize"] - ["se-resize"] - ["sw-resize"] - ["vertical-text"] - ["w-resize"] - ["wait"] - ["zoom-in"] - ["zoom-out"]]] - - [Shadow - [] - []] - - [Clip - [] - []] - - [Text_Direction - [[left_to_right "ltr"] - [right_to_left "rtl"]] - []] - - [Display - [[grid_display "grid"] - [no_display "none"]] - [["inline"] - ["block"] - ["contents"] - ["flex"] - ["inline-block"] - ["inline-flex"] - ["inline-grid"] - ["inline-table"] - ["list-item"] - ["run-in"] - ["table"] - ["table-caption"] - ["table-column-group"] - ["table-header-group"] - ["table-footer-group"] - ["table-row-group"] - ["table-cell"] - ["table-column"] - ["table-row"]]] - - [Empty - [] - [["show"] - ["hide"]]] - - [Filter - [] - []] - - [Flex_Direction - [] - [["row"] - ["row-reverse"] - ["column"] - ["column-reverse"]]] - - [Flex_Wrap - [[no_wrap "nowrap"]] - [["wrap"] - ["wrap_reverse"]]] - - [Font_Kerning - [[auto_kerning "auto"] - [normal_kerning "normal"] - [no_kerning "none"]] - []] - - [Font_Size - [[medium_size "medium"] - [xx_small_size "xx-small"] - [x_small_size "x-small"] - [small_size "small"] - [large_size "large"] - [x_large_size "x-large"] - [xx_large_size "xx-large"] - [smaller_size "smaller"] - [larger_size "larger"]] - []] - - [Font_Stretch - [[normal_stretch "normal"]] - [["condensed"] - ["ultra-condensed"] - ["extra-condensed"] - ["semi-condensed"] - ["expanded"] - ["semi-expanded"] - ["extra-expanded"] - ["ultra-expanded"]]] - - [Font_Style - [[normal_style "normal"]] - [["italic"] - ["oblique"]]] - - [Font_Weight - [[normal_weight "normal"] - [weight_100 "100"] - [weight_200 "200"] - [weight_300 "300"] - [weight_400 "400"] - [weight_500 "500"] - [weight_600 "600"] - [weight_700 "700"] - [weight_800 "800"] - [weight_900 "900"]] - [["bold"]]] - - [Font_Variant - [[normal_font "normal"]] - [["small-caps"]]] - - [Grid - [] - []] - - [Grid_Content - [[auto_content "auto"]] - [["max-content"] - ["min-content"]]] - - [Grid_Flow - [[row_flow "row"] - [column_flow "column"] - [dense_flow "dense"] - [row_dense_flow "row dense"] - [column_dense_flow "column dense"]] - []] - - [Grid_Span - [[auto_span "auto"]] - []] - - [Grid_Template - [] - []] - - [Hanging_Punctuation - [[no_hanging_punctuation "none"]] - [["first"] - ["last"] - ["allow-end"] - ["force-end"]]] - - [Hyphens - [[no_hyphens "none"] - [manual_hyphens "manual"] - [auto_hyphens "auto"]] - []] - - [Orientation - [] - [["portrait"] - ["landscape"]]] - - [Resolution - [] - []] - - [Scan - [] - [["interlace"] - ["progressive"]]] - - [Boolean - [[false "0"] - [true "1"]] - []] - - [Update - [[no_update "none"] - [slow_update "slow"] - [fast_update "fast"]] - []] - - [Block_Overflow - [[no_block_overflow "none"] - [scroll_block_overflow "scroll"] - [optional_paged_block_overflow "optional-paged"] - [paged_block_overflow "paged"]] - []] - - [Inline_Overflow - [[no_inline_overflow "none"] - [scroll_inline_overflow "scroll"]] - []] - - [Display_Mode - [] - [["fullscreen"] - ["standalone"] - ["minimal-ui"] - ["browser"]]] - - [Color_Gamut - [] - [["srgb"] - ["p3"] - ["rec2020"]]] - - [Inverted_Colors - [[no_inverted_colors "none"] - [inverted_colors "inverted"]] - []] - - [Pointer - [[no_pointer "none"] - [coarse_pointer "coarse"] - [fine_pointer "fine"]] - []] - - [Hover - [[no_hover "none"]] - [["hover"]]] - - [Light - [[dim_light "dim"] - [normal_light "normal"] - [washed_light "washed"]] - []] - - [Ratio - [] - []] - - [Scripting - [[no_scripting "none"] - [initial_scripting_only "initial-only"] - [scripting_enabled "enabled"]] - []] - - [Motion - [[no_motion_preference "no-preference"] - [reduced_motion "reduce"]] - []] - - [Color_Scheme - [[no_color_scheme_preference "no-preference"] - [light_color_scheme "light"] - [dark_color_scheme "dark"]] - []] - - [Isolation - [[auto_isolation "auto"]] - [["isolate"]]] - - [List_Style_Position - [] - [["inside"] - ["outside"]]] - - [List_Style_Type - [[no_list_style "none"]] - [["disc"] - ["armenian"] - ["circle"] - ["cjk-ideographic"] - ["decimal"] - ["decimal-leading-zero"] - ["georgian"] - ["hebrew"] - ["hiragana"] - ["hiragana-iroha"] - ["katakana"] - ["katakana-iroha"] - ["lower-alpha"] - ["lower-greek"] - ["lower-latin"] - ["lower-roman"] - ["square"] - ["upper-alpha"] - ["upper-greek"] - ["upper-latin"] - ["upper-roman"]]] - - [Color - [] - []] - - [Overflow - [[visible_overflow "visible"] - [hidden_overflow "hidden"] - [scroll_overflow "scroll"] - [auto_overflow "auto"]] - []] - - [Page_Break - [[auto_page_break "auto"] - [always_page_break "always"] - [avoid_page_break "avoid"] - [left_page_break "left"] - [right_page_break "right"]] - []] - - [Pointer_Events - [[auto_pointer_events "auto"] - [no_pointer_events "none"]] - []] - - [Position - [] - [["static"] - ["absolute"] - ["fixed"] - ["relative"] - ["sticky"]]] - - [Quotes - [[no_quotes "none"]] - []] - - [Resize - [[resize_none "none"] - [resize_both "both"] - [resize_horizontal "horizontal"] - [resize_vertical "vertical"]] - []] - - [Scroll_Behavior - [[auto_scroll_behavior "auto"] - [smooth_scroll_behavior "smooth"]] - []] - - [Table_Layout - [[auto_table_layout "auto"] - [fixed_table_layout "fixed"]] - []] - - [Text_Align - [[left_text_align "left"] - [right_text_align "right"] - [center_text_align "center"] - [justify_text_align "justify"]] - []] - - [Text_Align_Last - [[auto_text_align_last "auto"] - [left_text_align_last "left"] - [right_text_align_last "right"] - [center_text_align_last "center"] - [justify_text_align_last "justify"] - [start_text_align_last "start"] - [end_text_align_last "end"]] - []] - - [Text_Decoration_Line - [[no_text_decoration_line "none"] - [underline_text_decoration_line "underline"] - [overline_text_decoration_line "overline"] - [line_through_text_decoration_line "line-through"]] - []] - - [Text_Decoration_Style - [[solid_text_decoration_style "solid"] - [double_text_decoration_style "double"] - [dotted_text_decoration_style "dotted"] - [dashed_text_decoration_style "dashed"] - [wavy_text_decoration_style "wavy"]] - []] - - [Text_Justification - [[auto_text_justification "auto"] - [inter_word_text_justification "inter-word"] - [inter_character_text_justification "inter-character"] - [no_text_justification "none"]] - []] - - [Text_Overflow - [[clip_text_overflow "clip"] - [ellipsis_text_overflow "ellipsis"]] - []] - - [Text_Transform - [[no_text_transform "none"]] - [["capitalize"] - ["uppercase"] - ["lowercase"]]] - - [Transform - [[no_transform "none"]] - []] - - [Transform_Origin - [] - []] - - [Transform_Style - [] - [["flat"] - ["preserve_3d"]]] - - [Transition - [[transition_none "none"] - [transition_all "all"]] - []] - - [Bidi - [[bidi_normal "normal"] - [bidi_embed "embed"] - [bidi_isolate "isolate"] - [bidi_isolate_override "isolate-override"] - [bidi_plaintext "plaintext"]] - [["bidi-override"]]] - - [User_Select - [[user_select_auto "auto"] - [user_select_none "none"] - [user_select_text "text"] - [user_select_all "all"]] - []] - - [Vertical_Align - [[vertical_align_baseline "baseline"] - [vertical_align_sub "sub"] - [vertical_align_super "super"] - [vertical_align_top "top"] - [vertical_align_text_top "text-top"] - [vertical_align_middle "middle"] - [vertical_align_bottom "bottom"] - [vertical_align_text_bottom "text-bottom"]] - []] - - [White_Space - [[normal_white_space "normal"] - [no_wrap_white_space "nowrap"] - [pre_white_space "pre"] - [pre_line_white_space "pre-line"] - [pre_wrap_white_space "pre-wrap"]] - []] - - [Word_Break - [[normal_word_break "normal"]] - [["break-all"] - ["keep-all"] - ["break-word"]]] - - [Word_Wrap - [[normal_word_wrap "normal"] - [break_word_word_wrap "break-word"]] - []] - - [Writing_Mode - [[top_to_bottom_writing_mode "horizontal-tb"] - [left_to_right_writing_mode "vertical-rl"] - [right_to_left_writing_mode "vertical-lr"]] - []] - - [Z_Index - [] - []] - ) - - (def: value_separator ",") - - (def: (apply name inputs) - (-> Text (List Text) Value) - (|> inputs - (text.interposed ..value_separator) - (text.enclosed ["(" ")"]) - (format name) - :abstraction)) - - (enumeration: Step Text - step - [[start "start"] - [end "end"]] - []) - - (def: .public (steps intervals step) - (-> Nat Step (Value Timing)) - (..apply "steps" (list (%.nat intervals) (..step step)))) - - (def: .public (cubic_bezier p0 p1 p2 p3) - (-> Frac Frac Frac Frac (Value Timing)) - (|> (list p0 p1 p2 p3) - (list\each %number) - (..apply "cubic-bezier"))) - - (template [<name> <brand>] - [(def: .public <name> - (-> Nat (Value <brand>)) - (|>> %.nat :abstraction))] - - [iteration Iteration] - [count Count] - [slice_number/1 Slice] - [span_line Grid_Span] - ) - - (def: .public animation - (-> Label (Value Animation)) - (|>> :abstraction)) - - (def: .public (rgb color) - (-> color.Color (Value Color)) - (let [[red green blue] (color.rgb color)] - (..apply "rgb" (list (%.nat red) - (%.nat green) - (%.nat blue))))) - - (def: .public (rgba pigment) - (-> color.Pigment (Value Color)) - (let [(^slots [#color.color #color.alpha]) pigment - [red green blue] (color.rgb color)] - (..apply "rgba" (list (%.nat red) - (%.nat green) - (%.nat blue) - (if (r.= (\ r.interval top) alpha) - "1.0" - (format "0" (%.rev alpha))))))) - - (template [<name> <suffix>] - [(def: .public (<name> value) - (-> Frac (Value Length)) - (:abstraction (format (%number value) <suffix>)))] - - [em "em"] - [ex "ex"] - [rem "rem"] - [ch "ch"] - [vw "vw"] - [vh "vh"] - [vmin "vmin"] - [vmax "vmax"] - [% "%"] - [cm "cm"] - [mm "mm"] - [in "in"] - [px "px"] - [pt "pt"] - [pc "pc"] - [fr "fr"] - ) - - (def: (%int value) - (Format Int) - (if (i.< +0 value) - (%.int value) - (%.nat (.nat value)))) - - (template [<name> <suffix>] - [(def: .public (<name> value) - (-> Int (Value Time)) - (:abstraction (format (if (i.< +0 value) - (%.int value) - (%.nat (.nat value))) - <suffix>)))] - - - [seconds "s"] - [milli_seconds "ms"] - ) - - (def: .public thickness - (-> (Value Length) (Value Thickness)) - (|>> :transmutation)) - - (def: slice_separator " ") - - (def: .public (slice_number/2 horizontal vertical) - (-> Nat Nat (Value Slice)) - (:abstraction (format (%.nat horizontal) ..slice_separator - (%.nat vertical)))) - - (abstract: .public Stop - {} - - Text - - (def: .public stop - (-> (Value Color) Stop) - (|>> (:representation Value) (:abstraction Stop))) - - (def: stop_separator " ") - - (def: .public (single_stop length color) - (-> (Value Length) (Value Color) Stop) - (:abstraction (format (:representation Value color) ..stop_separator - (:representation Value length)))) - - (def: .public (double_stop start end color) - (-> (Value Length) (Value Length) (Value Color) Stop) - (:abstraction (format (:representation Value color) ..stop_separator - (:representation Value start) ..stop_separator - (:representation Value end)))) - - (abstract: .public Hint - {} - - Text - - (def: .public hint - (-> (Value Length) Hint) - (|>> (:representation Value) (:abstraction Hint))) - - (def: (with_hint [hint stop]) - (-> [(Maybe Hint) Stop] Text) - (case hint - #.None - (:representation Stop stop) + [(def: .public value + (-> (Value Any) Text) + (|>> :representation)) + + (template [<name> <value>] + [(def: .public <name> Value (:abstraction <value>))] + + [initial "initial"] + [inherit "inherit"] + [unset "unset"] + ) + + (template [<brand> <alias>+ <value>+] + [(abstract: .public <brand> Any []) + + (`` (template [<name> <value>] + [(def: .public <name> + (Value <brand>) + (:abstraction <value>))] + + (~~ (template.spliced <alias>+)))) + + (with_expansions [<rows> (template.spliced <value>+)] + (template [<value>] + [(`` (def: .public (~~ (..text_identifier <value>)) + (Value <brand>) + (:abstraction <value>)))] - (#.Some hint) - (format (:representation Hint hint) ..value_separator (:representation Stop stop)))))) - - (type: .public (List/1 a) - [a (List a)]) - - (abstract: .public Angle - {} - - Text - - (def: .public angle - (-> Angle Text) - (|>> :representation)) - - (def: .public (turn value) - (-> Rev Angle) - (:abstraction (format (%.rev value) "turn"))) - - (def: degree_limit Nat 360) - - (def: .public (degree value) - (-> Nat Angle) - (:abstraction (format (%.nat (n.% ..degree_limit value)) "deg"))) - - (template [<degree> <name>] - [(def: .public <name> - Angle - (..degree <degree>))] + <rows>))] + + [All + [] + []] + + [Number + [] + []] + + [Length + [] + []] + + [Time + [] + []] + + [Thickness + [] + [["medium"] + ["thin"] + ["thick"]]] + + [Slice + [[full_slice "fill"]] + []] + + [Alignment + [[auto_alignment "auto"]] + [["stretch"] + ["center"] + ["flex-start"] + ["flex-end"] + ["baseline"] + ["space-between"] + ["space-around"]]] + + [Animation + [] + []] + + [Animation_Direction + [[normal_direction "normal"]] + [["reverse"] + ["alternate"] + ["alternate-reverse"]]] + + [Animation_Fill + [[fill_forwards "forwards"] + [fill_backwards "backwards"] + [fill_both "both"]] + []] + + [Column_Fill + [] + [["balance"] + ["auto"]]] + + [Column_Span + [] + [["all"]]] + + [Iteration + [] + [["infinite"]]] + + [Count + [] + []] + + [Play + [] + [["paused"] + ["running"]]] + + [Timing + [] + [["linear"] + ["ease"] + ["ease-in"] + ["ease-out"] + ["ease-in-out"] + ["step-start"] + ["step-end"]]] + + [Visibility + [[invisible "hidden"] + [collapse_visibility "collapse"]] + [["visible"]]] + + [Attachment + [[scroll_attachment "scroll"] + [fixed_attachment "fixed"] + [local_attachment "local"]] + []] + + [Blend + [[normal_blend "normal"]] + [["multiply"] + ["screen"] + ["overlay"] + ["darken"] + ["lighten"] + ["color-dodge"] + ["color-burn"] + ["difference"] + ["exclusion"] + ["hue"] + ["saturation"] + ["color"] + ["luminosity"]]] + + [Span + [] + [["border-box"] + ["padding-box"] + ["content-box"]]] + + [Image + [[no_image "none"]] + []] + + [Repeat + [[stretch_repeat "stretch"]] + [["repeat"] + ["repeat-x"] + ["repeat-y"] + ["no-repeat"] + ["space"] + ["round"]]] + + [Location + [[left_top "left top"] + [left_center "left center"] + [left_bottom "left bottom"] + [right_top "right top"] + [right_center "right center"] + [right_bottom "right bottom"] + [center_top "center top"] + [center_center "center center"] + [center_bottom "center bottom"]] + []] + + [Fit + [[no_fit "none"]] + [["fill"] + ["cover"] + ["contain"] + ["scale-down"]]] + + [Border + [] + [["hidden"] + ["dotted"] + ["dashed"] + ["solid"] + ["double"] + ["groove"] + ["ridge"] + ["inset"] + ["outset"]]] + + [Collapse + [] + [["separate"] + ["collapse"]]] + + [Box_Decoration_Break + [] + [["slice"] + ["clone"]]] + + [Caption + [] + [["top"] + ["bottom"]]] + + [Float + [[float_left "left"] + [float_right "right"]] + []] + + [Clear + [[clear_left "left"] + [clear_right "right"] + [clear_both "both"]] + []] + + [Counter + [] + []] + + [Content + [] + [["open-quote"] + ["close-quote"] + ["no-open-quote"] + ["no-close-quote"]]] + + [Cursor + [[horizontal_text "text"] + [no_cursor "none"]] + [["alias"] + ["all-scroll"] + ["cell"] + ["context-menu"] + ["col-resize"] + ["copy"] + ["crosshair"] + ["default"] + ["e-resize"] + ["ew-resize"] + ["grab"] + ["grabbing"] + ["help"] + ["move"] + ["n-resize"] + ["ne-resize"] + ["nesw-resize"] + ["ns-resize"] + ["nw-resize"] + ["nwse-resize"] + ["no-drop"] + ["not-allowed"] + ["pointer"] + ["progress"] + ["row-resize"] + ["s-resize"] + ["se-resize"] + ["sw-resize"] + ["vertical-text"] + ["w-resize"] + ["wait"] + ["zoom-in"] + ["zoom-out"]]] + + [Shadow + [] + []] + + [Clip + [] + []] + + [Text_Direction + [[left_to_right "ltr"] + [right_to_left "rtl"]] + []] + + [Display + [[grid_display "grid"] + [no_display "none"]] + [["inline"] + ["block"] + ["contents"] + ["flex"] + ["inline-block"] + ["inline-flex"] + ["inline-grid"] + ["inline-table"] + ["list-item"] + ["run-in"] + ["table"] + ["table-caption"] + ["table-column-group"] + ["table-header-group"] + ["table-footer-group"] + ["table-row-group"] + ["table-cell"] + ["table-column"] + ["table-row"]]] + + [Empty + [] + [["show"] + ["hide"]]] + + [Filter + [] + []] + + [Flex_Direction + [] + [["row"] + ["row-reverse"] + ["column"] + ["column-reverse"]]] + + [Flex_Wrap + [[no_wrap "nowrap"]] + [["wrap"] + ["wrap_reverse"]]] + + [Font_Kerning + [[auto_kerning "auto"] + [normal_kerning "normal"] + [no_kerning "none"]] + []] + + [Font_Size + [[medium_size "medium"] + [xx_small_size "xx-small"] + [x_small_size "x-small"] + [small_size "small"] + [large_size "large"] + [x_large_size "x-large"] + [xx_large_size "xx-large"] + [smaller_size "smaller"] + [larger_size "larger"]] + []] + + [Font_Stretch + [[normal_stretch "normal"]] + [["condensed"] + ["ultra-condensed"] + ["extra-condensed"] + ["semi-condensed"] + ["expanded"] + ["semi-expanded"] + ["extra-expanded"] + ["ultra-expanded"]]] + + [Font_Style + [[normal_style "normal"]] + [["italic"] + ["oblique"]]] + + [Font_Weight + [[normal_weight "normal"] + [weight_100 "100"] + [weight_200 "200"] + [weight_300 "300"] + [weight_400 "400"] + [weight_500 "500"] + [weight_600 "600"] + [weight_700 "700"] + [weight_800 "800"] + [weight_900 "900"]] + [["bold"]]] + + [Font_Variant + [[normal_font "normal"]] + [["small-caps"]]] + + [Grid + [] + []] + + [Grid_Content + [[auto_content "auto"]] + [["max-content"] + ["min-content"]]] + + [Grid_Flow + [[row_flow "row"] + [column_flow "column"] + [dense_flow "dense"] + [row_dense_flow "row dense"] + [column_dense_flow "column dense"]] + []] + + [Grid_Span + [[auto_span "auto"]] + []] + + [Grid_Template + [] + []] + + [Hanging_Punctuation + [[no_hanging_punctuation "none"]] + [["first"] + ["last"] + ["allow-end"] + ["force-end"]]] + + [Hyphens + [[no_hyphens "none"] + [manual_hyphens "manual"] + [auto_hyphens "auto"]] + []] + + [Orientation + [] + [["portrait"] + ["landscape"]]] + + [Resolution + [] + []] + + [Scan + [] + [["interlace"] + ["progressive"]]] + + [Boolean + [[false "0"] + [true "1"]] + []] + + [Update + [[no_update "none"] + [slow_update "slow"] + [fast_update "fast"]] + []] + + [Block_Overflow + [[no_block_overflow "none"] + [scroll_block_overflow "scroll"] + [optional_paged_block_overflow "optional-paged"] + [paged_block_overflow "paged"]] + []] + + [Inline_Overflow + [[no_inline_overflow "none"] + [scroll_inline_overflow "scroll"]] + []] + + [Display_Mode + [] + [["fullscreen"] + ["standalone"] + ["minimal-ui"] + ["browser"]]] + + [Color_Gamut + [] + [["srgb"] + ["p3"] + ["rec2020"]]] + + [Inverted_Colors + [[no_inverted_colors "none"] + [inverted_colors "inverted"]] + []] + + [Pointer + [[no_pointer "none"] + [coarse_pointer "coarse"] + [fine_pointer "fine"]] + []] + + [Hover + [[no_hover "none"]] + [["hover"]]] + + [Light + [[dim_light "dim"] + [normal_light "normal"] + [washed_light "washed"]] + []] + + [Ratio + [] + []] + + [Scripting + [[no_scripting "none"] + [initial_scripting_only "initial-only"] + [scripting_enabled "enabled"]] + []] + + [Motion + [[no_motion_preference "no-preference"] + [reduced_motion "reduce"]] + []] + + [Color_Scheme + [[no_color_scheme_preference "no-preference"] + [light_color_scheme "light"] + [dark_color_scheme "dark"]] + []] + + [Isolation + [[auto_isolation "auto"]] + [["isolate"]]] + + [List_Style_Position + [] + [["inside"] + ["outside"]]] + + [List_Style_Type + [[no_list_style "none"]] + [["disc"] + ["armenian"] + ["circle"] + ["cjk-ideographic"] + ["decimal"] + ["decimal-leading-zero"] + ["georgian"] + ["hebrew"] + ["hiragana"] + ["hiragana-iroha"] + ["katakana"] + ["katakana-iroha"] + ["lower-alpha"] + ["lower-greek"] + ["lower-latin"] + ["lower-roman"] + ["square"] + ["upper-alpha"] + ["upper-greek"] + ["upper-latin"] + ["upper-roman"]]] + + [Color + [] + []] + + [Overflow + [[visible_overflow "visible"] + [hidden_overflow "hidden"] + [scroll_overflow "scroll"] + [auto_overflow "auto"]] + []] + + [Page_Break + [[auto_page_break "auto"] + [always_page_break "always"] + [avoid_page_break "avoid"] + [left_page_break "left"] + [right_page_break "right"]] + []] + + [Pointer_Events + [[auto_pointer_events "auto"] + [no_pointer_events "none"]] + []] + + [Position + [] + [["static"] + ["absolute"] + ["fixed"] + ["relative"] + ["sticky"]]] + + [Quotes + [[no_quotes "none"]] + []] + + [Resize + [[resize_none "none"] + [resize_both "both"] + [resize_horizontal "horizontal"] + [resize_vertical "vertical"]] + []] + + [Scroll_Behavior + [[auto_scroll_behavior "auto"] + [smooth_scroll_behavior "smooth"]] + []] + + [Table_Layout + [[auto_table_layout "auto"] + [fixed_table_layout "fixed"]] + []] + + [Text_Align + [[left_text_align "left"] + [right_text_align "right"] + [center_text_align "center"] + [justify_text_align "justify"]] + []] + + [Text_Align_Last + [[auto_text_align_last "auto"] + [left_text_align_last "left"] + [right_text_align_last "right"] + [center_text_align_last "center"] + [justify_text_align_last "justify"] + [start_text_align_last "start"] + [end_text_align_last "end"]] + []] + + [Text_Decoration_Line + [[no_text_decoration_line "none"] + [underline_text_decoration_line "underline"] + [overline_text_decoration_line "overline"] + [line_through_text_decoration_line "line-through"]] + []] + + [Text_Decoration_Style + [[solid_text_decoration_style "solid"] + [double_text_decoration_style "double"] + [dotted_text_decoration_style "dotted"] + [dashed_text_decoration_style "dashed"] + [wavy_text_decoration_style "wavy"]] + []] + + [Text_Justification + [[auto_text_justification "auto"] + [inter_word_text_justification "inter-word"] + [inter_character_text_justification "inter-character"] + [no_text_justification "none"]] + []] + + [Text_Overflow + [[clip_text_overflow "clip"] + [ellipsis_text_overflow "ellipsis"]] + []] + + [Text_Transform + [[no_text_transform "none"]] + [["capitalize"] + ["uppercase"] + ["lowercase"]]] + + [Transform + [[no_transform "none"]] + []] + + [Transform_Origin + [] + []] + + [Transform_Style + [] + [["flat"] + ["preserve_3d"]]] + + [Transition + [[transition_none "none"] + [transition_all "all"]] + []] + + [Bidi + [[bidi_normal "normal"] + [bidi_embed "embed"] + [bidi_isolate "isolate"] + [bidi_isolate_override "isolate-override"] + [bidi_plaintext "plaintext"]] + [["bidi-override"]]] + + [User_Select + [[user_select_auto "auto"] + [user_select_none "none"] + [user_select_text "text"] + [user_select_all "all"]] + []] + + [Vertical_Align + [[vertical_align_baseline "baseline"] + [vertical_align_sub "sub"] + [vertical_align_super "super"] + [vertical_align_top "top"] + [vertical_align_text_top "text-top"] + [vertical_align_middle "middle"] + [vertical_align_bottom "bottom"] + [vertical_align_text_bottom "text-bottom"]] + []] + + [White_Space + [[normal_white_space "normal"] + [no_wrap_white_space "nowrap"] + [pre_white_space "pre"] + [pre_line_white_space "pre-line"] + [pre_wrap_white_space "pre-wrap"]] + []] + + [Word_Break + [[normal_word_break "normal"]] + [["break-all"] + ["keep-all"] + ["break-word"]]] + + [Word_Wrap + [[normal_word_wrap "normal"] + [break_word_word_wrap "break-word"]] + []] + + [Writing_Mode + [[top_to_bottom_writing_mode "horizontal-tb"] + [left_to_right_writing_mode "vertical-rl"] + [right_to_left_writing_mode "vertical-lr"]] + []] + + [Z_Index + [] + []] + ) + + (def: value_separator ",") + + (def: (apply name inputs) + (-> Text (List Text) Value) + (|> inputs + (text.interposed ..value_separator) + (text.enclosed ["(" ")"]) + (format name) + :abstraction)) + + (enumeration: Step Text + step + [[start "start"] + [end "end"]] + []) + + (def: .public (steps intervals step) + (-> Nat Step (Value Timing)) + (..apply "steps" (list (%.nat intervals) (..step step)))) + + (def: .public (cubic_bezier p0 p1 p2 p3) + (-> Frac Frac Frac Frac (Value Timing)) + (|> (list p0 p1 p2 p3) + (list\each %number) + (..apply "cubic-bezier"))) + + (template [<name> <brand>] + [(def: .public <name> + (-> Nat (Value <brand>)) + (|>> %.nat :abstraction))] + + [iteration Iteration] + [count Count] + [slice_number/1 Slice] + [span_line Grid_Span] + ) + + (def: .public animation + (-> Label (Value Animation)) + (|>> :abstraction)) + + (def: .public (rgb color) + (-> color.Color (Value Color)) + (let [[red green blue] (color.rgb color)] + (..apply "rgb" (list (%.nat red) + (%.nat green) + (%.nat blue))))) + + (def: .public (rgba pigment) + (-> color.Pigment (Value Color)) + (let [(^slots [#color.color #color.alpha]) pigment + [red green blue] (color.rgb color)] + (..apply "rgba" (list (%.nat red) + (%.nat green) + (%.nat blue) + (if (r.= (\ r.interval top) alpha) + "1.0" + (format "0" (%.rev alpha))))))) + + (template [<name> <suffix>] + [(def: .public (<name> value) + (-> Frac (Value Length)) + (:abstraction (format (%number value) <suffix>)))] + + [em "em"] + [ex "ex"] + [rem "rem"] + [ch "ch"] + [vw "vw"] + [vh "vh"] + [vmin "vmin"] + [vmax "vmax"] + [% "%"] + [cm "cm"] + [mm "mm"] + [in "in"] + [px "px"] + [pt "pt"] + [pc "pc"] + [fr "fr"] + ) + + (def: (%int value) + (Format Int) + (if (i.< +0 value) + (%.int value) + (%.nat (.nat value)))) + + (template [<name> <suffix>] + [(def: .public (<name> value) + (-> Int (Value Time)) + (:abstraction (format (if (i.< +0 value) + (%.int value) + (%.nat (.nat value))) + <suffix>)))] + + + [seconds "s"] + [milli_seconds "ms"] + ) + + (def: .public thickness + (-> (Value Length) (Value Thickness)) + (|>> :transmutation)) + + (def: slice_separator " ") + + (def: .public (slice_number/2 horizontal vertical) + (-> Nat Nat (Value Slice)) + (:abstraction (format (%.nat horizontal) ..slice_separator + (%.nat vertical)))) + + (abstract: .public Stop + Text + + [(def: .public stop + (-> (Value Color) Stop) + (|>> (:representation Value) (:abstraction Stop))) + + (def: stop_separator " ") + + (def: .public (single_stop length color) + (-> (Value Length) (Value Color) Stop) + (:abstraction (format (:representation Value color) ..stop_separator + (:representation Value length)))) + + (def: .public (double_stop start end color) + (-> (Value Length) (Value Length) (Value Color) Stop) + (:abstraction (format (:representation Value color) ..stop_separator + (:representation Value start) ..stop_separator + (:representation Value end)))) + + (abstract: .public Hint + Text + + [(def: .public hint + (-> (Value Length) Hint) + (|>> (:representation Value) (:abstraction Hint))) + + (def: (with_hint [hint stop]) + (-> [(Maybe Hint) Stop] Text) + (case hint + #.None + (:representation Stop stop) + + (#.Some hint) + (format (:representation Hint hint) ..value_separator (:representation Stop stop))))])]) + + (type: .public (List/1 a) + [a (List a)]) + + (abstract: .public Angle + Text + + [(def: .public angle + (-> Angle Text) + (|>> :representation)) + + (def: .public (turn value) + (-> Rev Angle) + (:abstraction (format (%.rev value) "turn"))) + + (def: degree_limit Nat 360) - [000 to_top] - [090 to_right] - [180 to_bottom] - [270 to_left] - ) - - (template [<name> <function>] - [(def: .public (<name> angle start next) - (-> Angle Stop (List/1 [(Maybe Hint) Stop]) (Value Image)) - (let [[now after] next] - (..apply <function> (list& (:representation Angle angle) - (with_hint now) - (list\each with_hint after)))))] - - [linear_gradient "linear-gradient"] - [repeating_linear_gradient "repeating-linear-gradient"] - ) - ) - - (abstract: .public Percentage - {} - - Text - - (def: .public percentage - (-> Percentage Text) - (|>> :representation)) - - (def: percentage_limit Nat (.++ 100)) - - (def: .public (%% value) - (-> Nat Percentage) - (:abstraction (format (%.nat (n.% percentage_limit value)) "%"))) - - (def: .public slice_percent/1 - (-> Percentage (Value Slice)) - (|>> :representation (:abstraction Value))) - - (def: .public (slice_percent/2 horizontal vertical) - (-> Percentage Percentage (Value Slice)) - (:abstraction Value (format (:representation horizontal) ..slice_separator - (:representation vertical)))) - - (template [<input> <pre> <function>+] - [(`` (template [<name> <function>] - [(def: .public <name> - (-> <input> (Value Filter)) - (|>> <pre> (list) (..apply <function>)))] - - (~~ (template.spliced <function>+))))] - - [Nat (<| (:representation Value) ..px n.frac) - [[blur "blur"]]] - [Nat (<| ..angle ..degree) - [[hue_rotate "hue-rotate"]]] - [Percentage (:representation Percentage) - [[brightness "brightness"] - [contrast "contrast"] - [grayscale "grayscale"] - [invert "invert"] - [opacity "opacity"] - [saturate "saturate"] - [sepia "sepia"]]] - ) - ) - - (def: .public svg_filter - (-> URL (Value Filter)) - (|>> (list) (..apply "url"))) - - (def: default_shadow_length (px +0.0)) - - (def: .public (drop_shadow horizontal vertical blur spread color) - (-> (Value Length) (Value Length) - (Maybe (Value Length)) (Maybe (Value Length)) - (Value Color) - (Value Filter)) - (|> (list (:representation horizontal) - (:representation vertical) - (|> blur (maybe.else ..default_shadow_length) :representation) - (|> spread (maybe.else ..default_shadow_length) :representation) - (:representation color)) - (text.interposed " ") - (list) - (..apply "drop-shadow"))) - - (def: length_separator " ") - - (template [<name> <type>] - [(def: .public (<name> horizontal vertical) - (-> (Value Length) (Value Length) (Value <type>)) - (:abstraction (format (:representation horizontal) - ..length_separator - (:representation vertical))))] - - [location Location] - [fit Fit] - ) - - (def: .public (fit/1 length) - (-> (Value Length) (Value Fit)) - (..fit length length)) - - (def: .public image - (-> URL (Value Image)) - (|>> %.text + (def: .public (degree value) + (-> Nat Angle) + (:abstraction (format (%.nat (n.% ..degree_limit value)) "deg"))) + + (template [<degree> <name>] + [(def: .public <name> + Angle + (..degree <degree>))] + + [000 to_top] + [090 to_right] + [180 to_bottom] + [270 to_left] + ) + + (template [<name> <function>] + [(def: .public (<name> angle start next) + (-> Angle Stop (List/1 [(Maybe Hint) Stop]) (Value Image)) + (let [[now after] next] + (..apply <function> (list& (:representation Angle angle) + (with_hint now) + (list\each with_hint after)))))] + + [linear_gradient "linear-gradient"] + [repeating_linear_gradient "repeating-linear-gradient"] + )] + ) + + (abstract: .public Percentage + Text + + [(def: .public percentage + (-> Percentage Text) + (|>> :representation)) + + (def: percentage_limit Nat (.++ 100)) + + (def: .public (%% value) + (-> Nat Percentage) + (:abstraction (format (%.nat (n.% percentage_limit value)) "%"))) + + (def: .public slice_percent/1 + (-> Percentage (Value Slice)) + (|>> :representation (:abstraction Value))) + + (def: .public (slice_percent/2 horizontal vertical) + (-> Percentage Percentage (Value Slice)) + (:abstraction Value (format (:representation horizontal) ..slice_separator + (:representation vertical)))) + + (template [<input> <pre> <function>+] + [(`` (template [<name> <function>] + [(def: .public <name> + (-> <input> (Value Filter)) + (|>> <pre> (list) (..apply <function>)))] + + (~~ (template.spliced <function>+))))] + + [Nat (<| (:representation Value) ..px n.frac) + [[blur "blur"]]] + [Nat (<| ..angle ..degree) + [[hue_rotate "hue-rotate"]]] + [Percentage (:representation Percentage) + [[brightness "brightness"] + [contrast "contrast"] + [grayscale "grayscale"] + [invert "invert"] + [opacity "opacity"] + [saturate "saturate"] + [sepia "sepia"]]] + )] + ) + + (def: .public svg_filter + (-> URL (Value Filter)) + (|>> (list) (..apply "url"))) + + (def: default_shadow_length (px +0.0)) + + (def: .public (drop_shadow horizontal vertical blur spread color) + (-> (Value Length) (Value Length) + (Maybe (Value Length)) (Maybe (Value Length)) + (Value Color) + (Value Filter)) + (|> (list (:representation horizontal) + (:representation vertical) + (|> blur (maybe.else ..default_shadow_length) :representation) + (|> spread (maybe.else ..default_shadow_length) :representation) + (:representation color)) + (text.interposed " ") (list) - (..apply "url"))) - - (enumeration: Shape Text - shape - [[ellipse_shape "ellipse"] - [circle_shape "circle"]] - []) - - (enumeration: Extent Text - extent - [[closest_side "closest-side"] - [closest_corner "closest-corner"] - [farthest_side "farthest-side"] - [farthest_corner "farthest-corner"]] - []) - - (template [<name> <function>] - [(def: .public (<name> shape extent location start next) - (-> Shape (Maybe Extent) (Value Location) - Stop (List/1 [(Maybe Hint) Stop]) - (Value Image)) - (let [after_extent (format "at " (:representation location)) - with_extent (case extent - (#.Some extent) - (format (..extent extent) " " after_extent) - - #.None - after_extent) - where (format (..shape shape) " " with_extent) - [now after] next] - (..apply <function> (list& (..shape shape) - (with_hint now) - (list\each with_hint after)))))] - - [radial_gradient "radial-gradient"] - [repeating_radial_gradient "repeating-radial-gradient"] - ) - - (def: .public (shadow horizontal vertical blur spread color inset?) - (-> (Value Length) (Value Length) - (Maybe (Value Length)) (Maybe (Value Length)) - (Value Color) Bit - (Value Shadow)) - (let [with_inset (if inset? - (list "inset") - (list))] - (|> (list& (:representation horizontal) - (:representation vertical) - (|> blur (maybe.else ..default_shadow_length) :representation) - (|> spread (maybe.else ..default_shadow_length) :representation) - (:representation color) - with_inset) - (text.interposed " ") - :abstraction))) - - (type: .public Rectangle - (Record - [#top (Value Length) - #right (Value Length) - #bottom (Value Length) - #left (Value Length)])) - - (def: .public (clip rectangle) - (-> Rectangle (Value Clip)) - (`` (..apply "rect" (list (~~ (template [<side>] - [(:representation (value@ <side> rectangle))] - - [#top] [#right] [#bottom] [#left])))))) - - (def: .public counter - (-> Label (Value Counter)) - (|>> :abstraction)) - - (def: .public current_count - (-> (Value Counter) (Value Content)) - (|>> :representation (list) (..apply "counter"))) - - (def: .public text - (-> Text (Value Content)) - (|>> %.text :abstraction)) - - (def: .public attribute - (-> Label (Value Content)) - (|>> (list) (..apply "attr"))) - - (def: .public media - (-> URL (Value Content)) - (|>> (list) (..apply "url"))) - - (enumeration: Font Text - font_name - [[serif "serif"] - [sans_serif "sans-serif"] - [cursive "cursive"] - [fantasy "fantasy"] - [monospace "monospace"]] - [(def: .public font - (-> Text Font) - (|>> %.text :abstraction)) - - (def: .public (font_family options) - (-> (List Font) (Value Font)) - (case options - (#.Item _) - (|> options - (list\each ..font_name) - (text.interposed ",") - (:abstraction Value)) - - #.End - ..initial))]) - - (def: .public font_size - (-> (Value Length) (Value Font_Size)) - (|>> :transmutation)) - - (def: .public number - (-> Frac (Value Number)) - (|>> %number :abstraction)) - - (def: .public grid - (-> Label (Value Grid)) - (|>> :abstraction)) - - (def: .public fit_content - (-> (Value Length) (Value Grid_Content)) - (|>> :representation (list) (..apply "fit-content"))) - - (def: .public (min_max min max) - (-> (Value Grid_Content) (Value Grid_Content) (Value Grid_Content)) - (..apply "minmax" (list (:representation min) - (:representation max)))) - - (def: .public grid_span - (-> Nat (Value Grid_Span)) - (|>> %.nat (format "span ") :abstraction)) - - (def: grid_column_separator " ") - (def: grid_row_separator " ") - - (def: .public grid_template - (-> (List (List (Maybe (Value Grid)))) (Value Grid_Template)) - (let [empty (: (Value Grid) - (:abstraction "."))] - (|>> (list\each (|>> (list\each (|>> (maybe.else empty) - :representation)) - (text.interposed ..grid_column_separator) - (text.enclosed ["'" "'"]))) - (text.interposed ..grid_row_separator) + (..apply "drop-shadow"))) + + (def: length_separator " ") + + (template [<name> <type>] + [(def: .public (<name> horizontal vertical) + (-> (Value Length) (Value Length) (Value <type>)) + (:abstraction (format (:representation horizontal) + ..length_separator + (:representation vertical))))] + + [location Location] + [fit Fit] + ) + + (def: .public (fit/1 length) + (-> (Value Length) (Value Fit)) + (..fit length length)) + + (def: .public image + (-> URL (Value Image)) + (|>> %.text + (list) + (..apply "url"))) + + (enumeration: Shape Text + shape + [[ellipse_shape "ellipse"] + [circle_shape "circle"]] + []) + + (enumeration: Extent Text + extent + [[closest_side "closest-side"] + [closest_corner "closest-corner"] + [farthest_side "farthest-side"] + [farthest_corner "farthest-corner"]] + []) + + (template [<name> <function>] + [(def: .public (<name> shape extent location start next) + (-> Shape (Maybe Extent) (Value Location) + Stop (List/1 [(Maybe Hint) Stop]) + (Value Image)) + (let [after_extent (format "at " (:representation location)) + with_extent (case extent + (#.Some extent) + (format (..extent extent) " " after_extent) + + #.None + after_extent) + where (format (..shape shape) " " with_extent) + [now after] next] + (..apply <function> (list& (..shape shape) + (with_hint now) + (list\each with_hint after)))))] + + [radial_gradient "radial-gradient"] + [repeating_radial_gradient "repeating-radial-gradient"] + ) + + (def: .public (shadow horizontal vertical blur spread color inset?) + (-> (Value Length) (Value Length) + (Maybe (Value Length)) (Maybe (Value Length)) + (Value Color) Bit + (Value Shadow)) + (let [with_inset (if inset? + (list "inset") + (list))] + (|> (list& (:representation horizontal) + (:representation vertical) + (|> blur (maybe.else ..default_shadow_length) :representation) + (|> spread (maybe.else ..default_shadow_length) :representation) + (:representation color) + with_inset) + (text.interposed " ") :abstraction))) - (def: .public (resolution dpi) - (-> Nat (Value Resolution)) - (:abstraction (format (%.nat dpi) "dpi"))) - - (def: .public (ratio numerator denominator) - (-> Nat Nat (Value Ratio)) - (:abstraction (format (%.nat numerator) "/" (%.nat denominator)))) - - (enumeration: Quote Text - quote_text - [[double_quote "\0022"] - [single_quote "\0027"] - [single_left_angle_quote "\2039"] - [single_right_angle_quote "\203A"] - [double_left_angle_quote "\00AB"] - [double_right_angle_quote "\00BB"] - [single_left_quote "\2018"] - [single_right_quote "\2019"] - [double_left_quote "\201C"] - [double_right_quote "\201D"] - [low_double_quote "\201E"]] - [(def: .public quote - (-> Text Quote) - (|>> :abstraction))]) - - (def: quote_separator " ") - - (def: .public (quotes [left0 right0] [left1 right1]) - (-> [Quote Quote] [Quote Quote] (Value Quotes)) - (|> (list left0 right0 left1 right1) - (list\each (|>> ..quote_text %.text)) - (text.interposed ..quote_separator) - :abstraction)) - - (def: .public (matrix_2d [a b] [c d] [tx ty]) - (-> [Frac Frac] - [Frac Frac] - [Frac Frac] - (Value Transform)) - (|> (list a b c d tx ty) - (list\each %number) - (..apply "matrix"))) - - (def: .public (matrix_3d [a0 b0 c0 d0] [a1 b1 c1 d1] [a2 b2 c2 d2] [a3 b3 c3 d3]) - (-> [Frac Frac Frac Frac] - [Frac Frac Frac Frac] - [Frac Frac Frac Frac] - [Frac Frac Frac Frac] - (Value Transform)) - (|> (list a0 b0 c0 d0 a1 b1 c1 d1 a2 b2 c2 d2 a3 b3 c3 d3) - (list\each %number) - (..apply "matrix3d"))) - - (template [<name> <function> <input_types> <input_values>] - [(`` (def: .public (<name> [(~~ (template.spliced <input_values>))]) - (-> [(~~ (template.spliced <input_types>))] (Value Transform)) - (|> (list (~~ (template.spliced <input_values>))) - (list\each %number) - (..apply <function>))))] - - [translate_2d "translate" [Frac Frac] [x y]] - [translate_3d "translate3d" [Frac Frac Frac] [x y z]] - [translate_x "translateX" [Frac] [value]] - [translate_y "translateY" [Frac] [value]] - [translate_z "translateZ" [Frac] [value]] - - [scale_2d "scale" [Frac Frac] [x y]] - [scale_3d "scale3d" [Frac Frac Frac] [x y z]] - [scale_x "scaleX" [Frac] [value]] - [scale_y "scaleY" [Frac] [value]] - [scale_z "scaleZ" [Frac] [value]] - - [perspective "perspective" [Frac] [value]] - ) - - (template [<name> <function> <input_types> <input_values>] - [(`` (def: .public (<name> [(~~ (template.spliced <input_values>))]) - (-> [(~~ (template.spliced <input_types>))] (Value Transform)) - (|> (list (~~ (template.spliced <input_values>))) - (list\each ..angle) - (..apply <function>))))] - - [rotate_2d "rotate" [Angle] [angle]] - [rotate_x "rotateX" [Angle] [angle]] - [rotate_y "rotateY" [Angle] [angle]] - [rotate_z "rotateZ" [Angle] [angle]] - - [skew "skew" [Angle Angle] [x_angle y_angle]] - [skew_x "skewX" [Angle] [angle]] - [skew_y "skewY" [Angle] [angle]] - ) - - (def: .public (rotate_3d [x y z angle]) - (-> [Frac Frac Frac Angle] (Value Transform)) - (..apply "rotate3d" - (list (%number x) (%number y) (%number z) (..angle angle)))) - - (def: origin_separator " ") - - (def: .public (origin_2d x y) - (-> (Value Length) (Value Length) (Value Transform_Origin)) - (:abstraction (format (:representation x) ..origin_separator - (:representation y)))) - - (def: .public (origin_3d x y z) - (-> (Value Length) (Value Length) (Value Length) (Value Transform_Origin)) - (:abstraction (format (:representation x) ..origin_separator - (:representation y) ..origin_separator - (:representation z)))) - - (def: .public vertical_align - (-> (Value Length) (Value Vertical_Align)) - (|>> :transmutation)) - - (def: .public (z_index index) - (-> Int (Value Z_Index)) - (:abstraction (if (i.< +0 index) - (%.int index) - (%.nat (.nat index))))) - - (multi: multi_image Image ",") - (multi: multi_shadow Shadow ",") - (multi: multi_content Content " ") + (type: .public Rectangle + (Record + [#top (Value Length) + #right (Value Length) + #bottom (Value Length) + #left (Value Length)])) + + (def: .public (clip rectangle) + (-> Rectangle (Value Clip)) + (`` (..apply "rect" (list (~~ (template [<side>] + [(:representation (value@ <side> rectangle))] + + [#top] [#right] [#bottom] [#left])))))) + + (def: .public counter + (-> Label (Value Counter)) + (|>> :abstraction)) + + (def: .public current_count + (-> (Value Counter) (Value Content)) + (|>> :representation (list) (..apply "counter"))) + + (def: .public text + (-> Text (Value Content)) + (|>> %.text :abstraction)) + + (def: .public attribute + (-> Label (Value Content)) + (|>> (list) (..apply "attr"))) + + (def: .public media + (-> URL (Value Content)) + (|>> (list) (..apply "url"))) + + (enumeration: Font Text + font_name + [[serif "serif"] + [sans_serif "sans-serif"] + [cursive "cursive"] + [fantasy "fantasy"] + [monospace "monospace"]] + [(def: .public font + (-> Text Font) + (|>> %.text :abstraction)) + + (def: .public (font_family options) + (-> (List Font) (Value Font)) + (case options + (#.Item _) + (|> options + (list\each ..font_name) + (text.interposed ",") + (:abstraction Value)) + + #.End + ..initial))]) + + (def: .public font_size + (-> (Value Length) (Value Font_Size)) + (|>> :transmutation)) + + (def: .public number + (-> Frac (Value Number)) + (|>> %number :abstraction)) + + (def: .public grid + (-> Label (Value Grid)) + (|>> :abstraction)) + + (def: .public fit_content + (-> (Value Length) (Value Grid_Content)) + (|>> :representation (list) (..apply "fit-content"))) + + (def: .public (min_max min max) + (-> (Value Grid_Content) (Value Grid_Content) (Value Grid_Content)) + (..apply "minmax" (list (:representation min) + (:representation max)))) + + (def: .public grid_span + (-> Nat (Value Grid_Span)) + (|>> %.nat (format "span ") :abstraction)) + + (def: grid_column_separator " ") + (def: grid_row_separator " ") + + (def: .public grid_template + (-> (List (List (Maybe (Value Grid)))) (Value Grid_Template)) + (let [empty (: (Value Grid) + (:abstraction "."))] + (|>> (list\each (|>> (list\each (|>> (maybe.else empty) + :representation)) + (text.interposed ..grid_column_separator) + (text.enclosed ["'" "'"]))) + (text.interposed ..grid_row_separator) + :abstraction))) + + (def: .public (resolution dpi) + (-> Nat (Value Resolution)) + (:abstraction (format (%.nat dpi) "dpi"))) + + (def: .public (ratio numerator denominator) + (-> Nat Nat (Value Ratio)) + (:abstraction (format (%.nat numerator) "/" (%.nat denominator)))) + + (enumeration: Quote Text + quote_text + [[double_quote "\0022"] + [single_quote "\0027"] + [single_left_angle_quote "\2039"] + [single_right_angle_quote "\203A"] + [double_left_angle_quote "\00AB"] + [double_right_angle_quote "\00BB"] + [single_left_quote "\2018"] + [single_right_quote "\2019"] + [double_left_quote "\201C"] + [double_right_quote "\201D"] + [low_double_quote "\201E"]] + [(def: .public quote + (-> Text Quote) + (|>> :abstraction))]) + + (def: quote_separator " ") + + (def: .public (quotes [left0 right0] [left1 right1]) + (-> [Quote Quote] [Quote Quote] (Value Quotes)) + (|> (list left0 right0 left1 right1) + (list\each (|>> ..quote_text %.text)) + (text.interposed ..quote_separator) + :abstraction)) + + (def: .public (matrix_2d [a b] [c d] [tx ty]) + (-> [Frac Frac] + [Frac Frac] + [Frac Frac] + (Value Transform)) + (|> (list a b c d tx ty) + (list\each %number) + (..apply "matrix"))) + + (def: .public (matrix_3d [a0 b0 c0 d0] [a1 b1 c1 d1] [a2 b2 c2 d2] [a3 b3 c3 d3]) + (-> [Frac Frac Frac Frac] + [Frac Frac Frac Frac] + [Frac Frac Frac Frac] + [Frac Frac Frac Frac] + (Value Transform)) + (|> (list a0 b0 c0 d0 a1 b1 c1 d1 a2 b2 c2 d2 a3 b3 c3 d3) + (list\each %number) + (..apply "matrix3d"))) + + (template [<name> <function> <input_types> <input_values>] + [(`` (def: .public (<name> [(~~ (template.spliced <input_values>))]) + (-> [(~~ (template.spliced <input_types>))] (Value Transform)) + (|> (list (~~ (template.spliced <input_values>))) + (list\each %number) + (..apply <function>))))] + + [translate_2d "translate" [Frac Frac] [x y]] + [translate_3d "translate3d" [Frac Frac Frac] [x y z]] + [translate_x "translateX" [Frac] [value]] + [translate_y "translateY" [Frac] [value]] + [translate_z "translateZ" [Frac] [value]] + + [scale_2d "scale" [Frac Frac] [x y]] + [scale_3d "scale3d" [Frac Frac Frac] [x y z]] + [scale_x "scaleX" [Frac] [value]] + [scale_y "scaleY" [Frac] [value]] + [scale_z "scaleZ" [Frac] [value]] + + [perspective "perspective" [Frac] [value]] + ) + + (template [<name> <function> <input_types> <input_values>] + [(`` (def: .public (<name> [(~~ (template.spliced <input_values>))]) + (-> [(~~ (template.spliced <input_types>))] (Value Transform)) + (|> (list (~~ (template.spliced <input_values>))) + (list\each ..angle) + (..apply <function>))))] + + [rotate_2d "rotate" [Angle] [angle]] + [rotate_x "rotateX" [Angle] [angle]] + [rotate_y "rotateY" [Angle] [angle]] + [rotate_z "rotateZ" [Angle] [angle]] + + [skew "skew" [Angle Angle] [x_angle y_angle]] + [skew_x "skewX" [Angle] [angle]] + [skew_y "skewY" [Angle] [angle]] + ) + + (def: .public (rotate_3d [x y z angle]) + (-> [Frac Frac Frac Angle] (Value Transform)) + (..apply "rotate3d" + (list (%number x) (%number y) (%number z) (..angle angle)))) + + (def: origin_separator " ") + + (def: .public (origin_2d x y) + (-> (Value Length) (Value Length) (Value Transform_Origin)) + (:abstraction (format (:representation x) ..origin_separator + (:representation y)))) + + (def: .public (origin_3d x y z) + (-> (Value Length) (Value Length) (Value Length) (Value Transform_Origin)) + (:abstraction (format (:representation x) ..origin_separator + (:representation y) ..origin_separator + (:representation z)))) + + (def: .public vertical_align + (-> (Value Length) (Value Vertical_Align)) + (|>> :transmutation)) + + (def: .public (z_index index) + (-> Int (Value Z_Index)) + (:abstraction (if (i.< +0 index) + (%.int index) + (%.nat (.nat index))))) + + (multi: multi_image Image ",") + (multi: multi_shadow Shadow ",") + (multi: multi_content Content " ")] ) diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index 6b662a38d..5dfe95fce 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -80,496 +80,494 @@ (text.enclosed ["</" ">"])) (abstract: .public (HTML brand) - {} - Text - (template [<name> <brand>] - [(abstract: .public <brand> {} Any) - (type: .public <name> (HTML <brand>))] - - [Meta Meta'] - [Head Head'] - [Item Item'] - [Option Option'] - [Input Input'] - [Cell Cell'] - [Header Header'] - [Row Row'] - [Column Column'] - [Parameter Parameter'] - [Body Body'] - [Document Document'] - ) - - (template [<super> <super_raw> <sub>+] - [(abstract: .public (<super_raw> brand) {} Any) - (type: .public <super> (HTML (<super_raw> Any))) - - (`` (template [<sub> <sub_raw>] - [(abstract: .public <sub_raw> {} Any) - (type: .public <sub> (HTML (<super_raw> <sub_raw>)))] - - (~~ (template.spliced <sub>+))))] - - [Element Element' - [[Content Content'] - [Image Image']]] - - [Media Media' - [[Source Source'] - [Track Track']]] - ) - - (def: .public html - (-> Document Text) - (|>> :representation)) - - (def: .public (and pre post) - (All (_ brand) (-> (HTML brand) (HTML brand) (HTML brand))) - (:abstraction (format (:representation pre) (:representation post)))) - - (def: .public (comment content node) - (All (_ brand) (-> Text (HTML brand) (HTML brand))) - (:abstraction - (format (text.enclosed ["<!--" "-->"] content) - (:representation node)))) - - (def: (empty name attributes) - (-> Tag Attributes HTML) - (:abstraction - (format (..open name attributes) - (..close name)))) - - (def: (simple tag attributes) - (-> Tag Attributes HTML) - (|> attributes - (..open tag) - :abstraction)) - - (def: (tag name attributes content) - (-> Tag Attributes (HTML Any) HTML) - (:abstraction - (format (..open name attributes) - (:representation content) - (..close name)))) - - (def: (raw tag attributes content) - (-> Text Attributes Text HTML) - (:abstraction - (format (..open tag attributes) - content - (..close tag)))) - - (template [<name> <tag> <brand>] - [(def: .public <name> - (-> Attributes <brand>) - (..simple <tag>))] - - [link "link" Meta] - [meta "meta" Meta] - [input "input" Input] - [embedded "embed" Element] - [column "col" Column] - [parameter "param" Parameter] - ) - - (def: .public (base href target) - (-> URL (Maybe Target) Meta) - (let [partial (list ["href" href]) - full (case target - (#.Some target) - (list& ["target" (..target target)] partial) - - #.None - partial)] - (..simple "base" full))) - - (def: .public style - (-> Style Meta) - (|>> style.inline (..raw "style" (list)))) - - (def: .public (script attributes inline) - (-> Attributes (Maybe Script) Meta) - (|> inline - (maybe\each js.code) - (maybe.else "") - (..raw "script" attributes))) - - (def: .public text - (-> Text Content) - (|>> ..safe + [(template [<name> <brand>] + [(abstract: .public <brand> Any []) + (type: .public <name> (HTML <brand>))] + + [Meta Meta'] + [Head Head'] + [Item Item'] + [Option Option'] + [Input Input'] + [Cell Cell'] + [Header Header'] + [Row Row'] + [Column Column'] + [Parameter Parameter'] + [Body Body'] + [Document Document'] + ) + + (template [<super> <super_raw> <sub>+] + [(abstract: .public (<super_raw> brand) Any []) + (type: .public <super> (HTML (<super_raw> Any))) + + (`` (template [<sub> <sub_raw>] + [(abstract: .public <sub_raw> Any []) + (type: .public <sub> (HTML (<super_raw> <sub_raw>)))] + + (~~ (template.spliced <sub>+))))] + + [Element Element' + [[Content Content'] + [Image Image']]] + + [Media Media' + [[Source Source'] + [Track Track']]] + ) + + (def: .public html + (-> Document Text) + (|>> :representation)) + + (def: .public (and pre post) + (All (_ brand) (-> (HTML brand) (HTML brand) (HTML brand))) + (:abstraction (format (:representation pre) (:representation post)))) + + (def: .public (comment content node) + (All (_ brand) (-> Text (HTML brand) (HTML brand))) + (:abstraction + (format (text.enclosed ["<!--" "-->"] content) + (:representation node)))) + + (def: (empty name attributes) + (-> Tag Attributes HTML) + (:abstraction + (format (..open name attributes) + (..close name)))) + + (def: (simple tag attributes) + (-> Tag Attributes HTML) + (|> attributes + (..open tag) :abstraction)) - (template [<tag> <alias> <name>] - [(def: .public <name> - Element - (..simple <tag> (list))) - - (def: .public <alias> <name>)] - ["br" br line_break] - ["wbr" wbr word_break] - ["hr" hr separator] - ) - - (def: .public (image source attributes) - (-> URL Attributes Image) - (|> attributes - (#.Item ["src" source]) - (..simple "img"))) - - (def: .public (svg attributes content) - (-> Attributes XML Element) - (|> content - (\ xml.codec encoded) - (..raw "svg" attributes))) - - (type: .public Coord - (Record - [#horizontal Nat - #vertical Nat])) - - (def: metric_separator ",") - (def: coord_separator ",") - - (def: (%coord [horizontal vertical]) - (Format Coord) - (format (%.nat horizontal) ..metric_separator (%.nat vertical))) - - (type: .public Rectangle - (Record - [#start Coord - #end Coord])) - - (type: .public Circle - (Record - [#center Coord - #radius Nat])) - - (type: .public Polygon - (Record - [#first Coord - #second Coord - #third Coord - #extra (List Coord)])) - - (def: (%rectangle [start end]) - (Format Rectangle) - (format (%coord start) ..coord_separator (%coord end))) - - (def: (%circle [center radius]) - (Format Circle) - (format (%coord center) ..metric_separator (%.nat radius))) - - (def: (%polygon [first second third extra]) - (Format Polygon) - (|> (list& first second third extra) - (list\each %coord) - (text.interposed ..coord_separator))) - - (type: .public Shape - (Variant - (#Rectangle Rectangle) - (#Circle Circle) - (#Polygon Polygon))) - - (template [<name> <shape> <type> <format>] - [(def: (<name> attributes shape) - (-> Attributes <type> (HTML Any)) - (..simple "area" (list& ["shape" <shape>] - ["coords" (<format> shape)] - attributes)))] - - [rectangle "rect" Rectangle ..%rectangle] - [circle "circle" Circle ..%circle] - [polygon "poly" Polygon ..%polygon] - ) - - (def: (area attributes shape) - (-> Attributes Shape (HTML Any)) - (case shape - (#Rectangle rectangle) - (..rectangle attributes rectangle) - - (#Circle circle) - (..circle attributes circle) - - (#Polygon polygon) - (..polygon attributes polygon))) - - (def: .public (each attributes areas for) - (-> Attributes (List [Attributes Shape]) Image Image) - ($_ ..and - for - (case (list\each (product.uncurried ..area) areas) - #.End - (..empty "map" attributes) - - (#.Item head tail) - (..tag "map" attributes - (list\mix (function.flipped ..and) head tail))))) - - (template [<name> <tag> <type>] - [(def: .public <name> - (-> Attributes <type>) - (..empty <tag>))] - - [canvas "canvas" Element] - [progress "progress" Element] - [output "output" Input] - [source "source" Source] - [track "track" Track] - ) - - (template [<name> <tag>] - [(def: .public (<name> attributes media on_unsupported) - (-> Attributes Media (Maybe Content) Element) - (..tag <tag> attributes - (|> on_unsupported - (maybe.else (..text "")) - (..and media))))] - - [audio "audio"] - [video "video"] - ) - - (def: .public (picture attributes sources image) - (-> Attributes Source Image Element) - (..tag "picture" attributes (..and sources image))) - - (def: .public (anchor href attributes content) - (-> URL Attributes Element Element) - (..tag "a" (list& ["href" href] attributes) content)) - - (def: .public label - (-> ID Input) - (|>> ["for"] list (..empty "label"))) - - (template [<name> <container_tag> <description_tag> <type>] - [(def: .public (<name> description attributes content) - (-> (Maybe Content) Attributes <type> <type>) - (..tag <container_tag> attributes - (case description - (#.Some description) - ($_ ..and - (..tag <description_tag> (list) description) - content) - - #.None - content)))] - - [details "details" "summary" Element] - [field_set "fieldset" "legend" Input] - [figure "figure" "figcaption" Element] - ) - - (template [<name> <tag> <type>] - [(def: .public (<name> attributes content) - (-> Attributes (Maybe Content) <type>) - (|> content - (maybe.else (..text "")) - (..tag <tag> attributes)))] - - [text_area "textarea" Input] - [iframe "iframe" Element] - ) - - (type: .public Phrase - (-> Attributes Content Element)) - - (template [<name> <tag>] - [(def: .public <name> - Phrase - (..tag <tag>))] - - [abbrebiation "abbr"] - [block_quote "blockquote"] - [bold "b"] - [cite "cite"] - [code "code"] - [definition "dfn"] - [deleted "del"] - [emphasized "em"] - [h1 "h1"] - [h2 "h2"] - [h3 "h3"] - [h4 "h4"] - [h5 "h5"] - [h6 "h6"] - [inserted "ins"] - [italic "i"] - [keyboard "kbd"] - [marked "mark"] - [meter "meter"] - [pre "pre"] - [quote "q"] - [sample "samp"] - [struck "s"] - [small "small"] - [sub "sub"] - [super "sup"] - [strong "strong"] - [time "time"] - [underlined "u"] - [variable "var"] - ) - - (def: .public incorrect ..struck) - - (def: (ruby_pronunciation pronunciation) - (-> Content (HTML Any)) - (..tag "rt" (list) - ($_ ..and - (..tag "rp" (list) (..text "(")) - pronunciation - (..tag "rp" (list) (..text ")"))))) - - (def: .public (ruby attributes content pronunciation) - (-> Attributes Content Content Element) - (..tag "ruby" attributes - ($_ ..and - content - (ruby_pronunciation pronunciation)))) - - (type: .public Composite - (-> Attributes Element Element)) - - (template [<name> <tag>] - [(def: .public <name> - Composite - (..tag <tag>))] - - [article "article"] - [aside "aside"] - [dialog "dialog"] - [div "div"] - [footer "footer"] - [header "header"] - [main "main"] - [navigation "nav"] - [paragraph "p"] - [section "section"] - [span "span"] - ) - - (template [<tag> <name> <input>] - [(def: <name> - (-> <input> (HTML Any)) - (..tag <tag> (list)))] - - ["dt" term Content] - ["dd" description Element] - ) - - (def: .public (description_list attributes descriptions) - (-> Attributes (List [Content Element]) Element) - (case (list\each (function (_ [term description]) - ($_ ..and - (..term term) - (..description description))) - descriptions) - #.End - (..empty "dl" attributes) - - (#.Item head tail) - (..tag "dl" attributes - (list\mix (function.flipped ..and) head tail)))) - - (def: .public p ..paragraph) - - (template [<name> <tag> <input> <output>] - [(def: .public <name> - (-> Attributes <input> <output>) - (..tag <tag>))] - - [button "button" Element Input] - [item "li" Element Item] - [ordered_list "ol" Item Element] - [unordered_list "ul" Item Element] - [option "option" Content Option] - [option_group "optgroup" Option Option] - [data_list "datalist" Option Element] - [select "select" Option Input] - [address "address" Element Element] - [form "form" Input Element] - [data "data" Element Element] - [object "object" Parameter Element] - ) - - (template [<name> <tag> <input> <output>] - [(def: .public <name> - (-> <input> <output>) - (..tag <tag> (list)))] - - [title "title" Content Meta] - [no_script "noscript" Content Meta] - [template "template" (HTML Any) (HTML Nothing)] - [table_header "th" Element Header] - [table_cell "td" Element Cell] - [head "head" Meta Head] - [body "body" Element Body] - ) - - (template [<name> <tag> <input> <output>] - [(def: <name> - (-> <input> <output>) - (..tag <tag> (list)))] - - [table_row "tr" (HTML Any) Row] - [table_head "thead" Row HTML] - [table_body "tbody" Row HTML] - [table_foot "tfoot" Row HTML] - [columns_group "colgroup" Column HTML] - ) - - (def: .public (table attributes caption columns headers rows footer) - (-> Attributes (Maybe Content) (Maybe Column) Header (List Cell) (Maybe Cell) Element) - (let [head (..table_head (..table_row headers)) - content (case (list\each table_row rows) - #.End - head - - (#.Item first rest) - (..and head - (..table_body - (list\mix (function.flipped ..and) first rest)))) - content (case footer - #.None - content - - (#.Some footer) - (..and content - (..table_foot (..table_row footer)))) - content (case columns - #.None - content - - (#.Some columns) - (..and (..columns_group columns) - content)) - content (case caption - #.None - content - - (#.Some caption) - (..and (:as HTML caption) - content))] - (..tag "table" attributes - content))) - - (template [<name> <doc_type>] - [(def: .public <name> - (-> Head Body Document) - (let [doc_type <doc_type>] - (function (_ head body) - (|> (..tag "html" (list) (..and head body)) - :representation - (format doc_type) - :abstraction))))] - - [html/5 "<!DOCTYPE html>"] - [html/4_01 (format "<!DOCTYPE HTML PUBLIC " text.double_quote "-//W3C//DTD HTML 4.01//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/html4/strict.dtd" text.double_quote ">")] - [xhtml/1_0 (format "<!DOCTYPE html PUBLIC " text.double_quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double_quote ">")] - [xhtml/1_1 (format "<!DOCTYPE html PUBLIC " text.double_quote "-//W3C//DTD XHTML 1.1//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double_quote ">")] - ) + (def: (tag name attributes content) + (-> Tag Attributes (HTML Any) HTML) + (:abstraction + (format (..open name attributes) + (:representation content) + (..close name)))) + + (def: (raw tag attributes content) + (-> Text Attributes Text HTML) + (:abstraction + (format (..open tag attributes) + content + (..close tag)))) + + (template [<name> <tag> <brand>] + [(def: .public <name> + (-> Attributes <brand>) + (..simple <tag>))] + + [link "link" Meta] + [meta "meta" Meta] + [input "input" Input] + [embedded "embed" Element] + [column "col" Column] + [parameter "param" Parameter] + ) + + (def: .public (base href target) + (-> URL (Maybe Target) Meta) + (let [partial (list ["href" href]) + full (case target + (#.Some target) + (list& ["target" (..target target)] partial) + + #.None + partial)] + (..simple "base" full))) + + (def: .public style + (-> Style Meta) + (|>> style.inline (..raw "style" (list)))) + + (def: .public (script attributes inline) + (-> Attributes (Maybe Script) Meta) + (|> inline + (maybe\each js.code) + (maybe.else "") + (..raw "script" attributes))) + + (def: .public text + (-> Text Content) + (|>> ..safe + :abstraction)) + + (template [<tag> <alias> <name>] + [(def: .public <name> + Element + (..simple <tag> (list))) + + (def: .public <alias> <name>)] + ["br" br line_break] + ["wbr" wbr word_break] + ["hr" hr separator] + ) + + (def: .public (image source attributes) + (-> URL Attributes Image) + (|> attributes + (#.Item ["src" source]) + (..simple "img"))) + + (def: .public (svg attributes content) + (-> Attributes XML Element) + (|> content + (\ xml.codec encoded) + (..raw "svg" attributes))) + + (type: .public Coord + (Record + [#horizontal Nat + #vertical Nat])) + + (def: metric_separator ",") + (def: coord_separator ",") + + (def: (%coord [horizontal vertical]) + (Format Coord) + (format (%.nat horizontal) ..metric_separator (%.nat vertical))) + + (type: .public Rectangle + (Record + [#start Coord + #end Coord])) + + (type: .public Circle + (Record + [#center Coord + #radius Nat])) + + (type: .public Polygon + (Record + [#first Coord + #second Coord + #third Coord + #extra (List Coord)])) + + (def: (%rectangle [start end]) + (Format Rectangle) + (format (%coord start) ..coord_separator (%coord end))) + + (def: (%circle [center radius]) + (Format Circle) + (format (%coord center) ..metric_separator (%.nat radius))) + + (def: (%polygon [first second third extra]) + (Format Polygon) + (|> (list& first second third extra) + (list\each %coord) + (text.interposed ..coord_separator))) + + (type: .public Shape + (Variant + (#Rectangle Rectangle) + (#Circle Circle) + (#Polygon Polygon))) + + (template [<name> <shape> <type> <format>] + [(def: (<name> attributes shape) + (-> Attributes <type> (HTML Any)) + (..simple "area" (list& ["shape" <shape>] + ["coords" (<format> shape)] + attributes)))] + + [rectangle "rect" Rectangle ..%rectangle] + [circle "circle" Circle ..%circle] + [polygon "poly" Polygon ..%polygon] + ) + + (def: (area attributes shape) + (-> Attributes Shape (HTML Any)) + (case shape + (#Rectangle rectangle) + (..rectangle attributes rectangle) + + (#Circle circle) + (..circle attributes circle) + + (#Polygon polygon) + (..polygon attributes polygon))) + + (def: .public (each attributes areas for) + (-> Attributes (List [Attributes Shape]) Image Image) + ($_ ..and + for + (case (list\each (product.uncurried ..area) areas) + #.End + (..empty "map" attributes) + + (#.Item head tail) + (..tag "map" attributes + (list\mix (function.flipped ..and) head tail))))) + + (template [<name> <tag> <type>] + [(def: .public <name> + (-> Attributes <type>) + (..empty <tag>))] + + [canvas "canvas" Element] + [progress "progress" Element] + [output "output" Input] + [source "source" Source] + [track "track" Track] + ) + + (template [<name> <tag>] + [(def: .public (<name> attributes media on_unsupported) + (-> Attributes Media (Maybe Content) Element) + (..tag <tag> attributes + (|> on_unsupported + (maybe.else (..text "")) + (..and media))))] + + [audio "audio"] + [video "video"] + ) + + (def: .public (picture attributes sources image) + (-> Attributes Source Image Element) + (..tag "picture" attributes (..and sources image))) + + (def: .public (anchor href attributes content) + (-> URL Attributes Element Element) + (..tag "a" (list& ["href" href] attributes) content)) + + (def: .public label + (-> ID Input) + (|>> ["for"] list (..empty "label"))) + + (template [<name> <container_tag> <description_tag> <type>] + [(def: .public (<name> description attributes content) + (-> (Maybe Content) Attributes <type> <type>) + (..tag <container_tag> attributes + (case description + (#.Some description) + ($_ ..and + (..tag <description_tag> (list) description) + content) + + #.None + content)))] + + [details "details" "summary" Element] + [field_set "fieldset" "legend" Input] + [figure "figure" "figcaption" Element] + ) + + (template [<name> <tag> <type>] + [(def: .public (<name> attributes content) + (-> Attributes (Maybe Content) <type>) + (|> content + (maybe.else (..text "")) + (..tag <tag> attributes)))] + + [text_area "textarea" Input] + [iframe "iframe" Element] + ) + + (type: .public Phrase + (-> Attributes Content Element)) + + (template [<name> <tag>] + [(def: .public <name> + Phrase + (..tag <tag>))] + + [abbrebiation "abbr"] + [block_quote "blockquote"] + [bold "b"] + [cite "cite"] + [code "code"] + [definition "dfn"] + [deleted "del"] + [emphasized "em"] + [h1 "h1"] + [h2 "h2"] + [h3 "h3"] + [h4 "h4"] + [h5 "h5"] + [h6 "h6"] + [inserted "ins"] + [italic "i"] + [keyboard "kbd"] + [marked "mark"] + [meter "meter"] + [pre "pre"] + [quote "q"] + [sample "samp"] + [struck "s"] + [small "small"] + [sub "sub"] + [super "sup"] + [strong "strong"] + [time "time"] + [underlined "u"] + [variable "var"] + ) + + (def: .public incorrect ..struck) + + (def: (ruby_pronunciation pronunciation) + (-> Content (HTML Any)) + (..tag "rt" (list) + ($_ ..and + (..tag "rp" (list) (..text "(")) + pronunciation + (..tag "rp" (list) (..text ")"))))) + + (def: .public (ruby attributes content pronunciation) + (-> Attributes Content Content Element) + (..tag "ruby" attributes + ($_ ..and + content + (ruby_pronunciation pronunciation)))) + + (type: .public Composite + (-> Attributes Element Element)) + + (template [<name> <tag>] + [(def: .public <name> + Composite + (..tag <tag>))] + + [article "article"] + [aside "aside"] + [dialog "dialog"] + [div "div"] + [footer "footer"] + [header "header"] + [main "main"] + [navigation "nav"] + [paragraph "p"] + [section "section"] + [span "span"] + ) + + (template [<tag> <name> <input>] + [(def: <name> + (-> <input> (HTML Any)) + (..tag <tag> (list)))] + + ["dt" term Content] + ["dd" description Element] + ) + + (def: .public (description_list attributes descriptions) + (-> Attributes (List [Content Element]) Element) + (case (list\each (function (_ [term description]) + ($_ ..and + (..term term) + (..description description))) + descriptions) + #.End + (..empty "dl" attributes) + + (#.Item head tail) + (..tag "dl" attributes + (list\mix (function.flipped ..and) head tail)))) + + (def: .public p ..paragraph) + + (template [<name> <tag> <input> <output>] + [(def: .public <name> + (-> Attributes <input> <output>) + (..tag <tag>))] + + [button "button" Element Input] + [item "li" Element Item] + [ordered_list "ol" Item Element] + [unordered_list "ul" Item Element] + [option "option" Content Option] + [option_group "optgroup" Option Option] + [data_list "datalist" Option Element] + [select "select" Option Input] + [address "address" Element Element] + [form "form" Input Element] + [data "data" Element Element] + [object "object" Parameter Element] + ) + + (template [<name> <tag> <input> <output>] + [(def: .public <name> + (-> <input> <output>) + (..tag <tag> (list)))] + + [title "title" Content Meta] + [no_script "noscript" Content Meta] + [template "template" (HTML Any) (HTML Nothing)] + [table_header "th" Element Header] + [table_cell "td" Element Cell] + [head "head" Meta Head] + [body "body" Element Body] + ) + + (template [<name> <tag> <input> <output>] + [(def: <name> + (-> <input> <output>) + (..tag <tag> (list)))] + + [table_row "tr" (HTML Any) Row] + [table_head "thead" Row HTML] + [table_body "tbody" Row HTML] + [table_foot "tfoot" Row HTML] + [columns_group "colgroup" Column HTML] + ) + + (def: .public (table attributes caption columns headers rows footer) + (-> Attributes (Maybe Content) (Maybe Column) Header (List Cell) (Maybe Cell) Element) + (let [head (..table_head (..table_row headers)) + content (case (list\each table_row rows) + #.End + head + + (#.Item first rest) + (..and head + (..table_body + (list\mix (function.flipped ..and) first rest)))) + content (case footer + #.None + content + + (#.Some footer) + (..and content + (..table_foot (..table_row footer)))) + content (case columns + #.None + content + + (#.Some columns) + (..and (..columns_group columns) + content)) + content (case caption + #.None + content + + (#.Some caption) + (..and (:as HTML caption) + content))] + (..tag "table" attributes + content))) + + (template [<name> <doc_type>] + [(def: .public <name> + (-> Head Body Document) + (let [doc_type <doc_type>] + (function (_ head body) + (|> (..tag "html" (list) (..and head body)) + :representation + (format doc_type) + :abstraction))))] + + [html/5 "<!DOCTYPE html>"] + [html/4_01 (format "<!DOCTYPE HTML PUBLIC " text.double_quote "-//W3C//DTD HTML 4.01//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/html4/strict.dtd" text.double_quote ">")] + [xhtml/1_0 (format "<!DOCTYPE html PUBLIC " text.double_quote "-//W3C//DTD XHTML 1.0 Strict//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd" text.double_quote ">")] + [xhtml/1_1 (format "<!DOCTYPE html PUBLIC " text.double_quote "-//W3C//DTD XHTML 1.1//EN" text.double_quote " " text.double_quote "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd" text.double_quote ">")] + )] ) diff --git a/stdlib/source/library/lux/data/format/markdown.lux b/stdlib/source/library/lux/data/format/markdown.lux index da6a5d7c6..93ec06334 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -31,172 +31,170 @@ (text.replaced "." "\.") (text.replaced "!" "\!"))) -(abstract: .public Span {} Any) -(abstract: .public Block {} Any) +(abstract: .public Span Any []) +(abstract: .public Block Any []) (abstract: .public (Markdown brand) - {} - Text - (def: .public empty - Markdown - (:abstraction "")) - - (def: .public text - (-> Text (Markdown Span)) - (|>> ..safe :abstraction)) - - (def: blank_line - (format text.new_line text.new_line)) - - (template [<name> <prefix>] - [(def: .public (<name> content) - (-> Text (Markdown Block)) - (:abstraction (format <prefix> " " (..safe content) ..blank_line)))] - - [heading/1 "#"] - [heading/2 "##"] - [heading/3 "###"] - [heading/4 "####"] - [heading/5 "#####"] - [heading/6 "######"] - ) - - (def: (block content) - (-> Text (Markdown Block)) - (:abstraction (format content ..blank_line))) - - (def: .public paragraph - (-> (Markdown Span) (Markdown Block)) - (|>> :representation ..block)) - - (def: .public break - (Markdown Span) - (:abstraction (format " " text.new_line))) - - (template [<name> <wrapper>] - [(def: .public <name> - (-> (Markdown Span) (Markdown Span)) - (|>> :representation - (text.enclosed [<wrapper> <wrapper>]) - :abstraction))] - - [bold "**"] - [italic "_"] - ) - - (def: (prefix with) - (-> Text (-> Text Text)) - (|>> (text.all_split_by text.new_line) - (list\each (function (_ line) - (if (text.empty? line) - line - (format with line)))) - (text.interposed text.new_line))) - - (def: indent - (-> Text Text) - (..prefix text.tab)) - - (def: .public quote - (-> (Markdown Block) (Markdown Block)) - (|>> :representation - (..prefix "> ") - :abstraction)) - - (def: .public numbered_list - (-> (List [(Markdown Span) (Maybe (Markdown Block))]) - (Markdown Block)) - (|>> list.enumeration - (list\each (function (_ [idx [summary detail]]) - (format "1. " (:representation summary) - (case detail - (#.Some detail) - (|> detail - :representation - ..indent - (text.enclosed [text.new_line text.new_line]) - (format text.new_line)) - - #.None - "")))) - (text.interposed text.new_line) - ..block)) - - (def: .public bullet_list - (-> (List [(Markdown Span) (Maybe (Markdown Block))]) - (Markdown Block)) - (|>> (list\each (function (_ [summary detail]) - (format "* " (:representation summary) - (case detail - (#.Some detail) - (|> detail - :representation - ..indent - (text.enclosed [text.new_line text.new_line]) - (format text.new_line)) - - #.None - "")))) - (text.interposed text.new_line) - ..block)) - - (def: .public snippet - {#.doc "A snippet of code."} - (-> Text (Markdown Span)) - (|>> (text.enclosed ["`` " " ``"]) :abstraction)) - - (def: .public generic_code - {#.doc "A (generic) block of code."} - (-> Text (Markdown Block)) - (let [open (format "```" text.new_line) - close (format text.new_line "```")] - (|>> (text.enclosed [open close]) ..block))) - - (def: .public (code language block) - {#.doc "A block of code of a specific language."} - (-> Text Text (Markdown Block)) - (let [open (format "```" language text.new_line) - close (format text.new_line "```")] - (|> block - (text.enclosed [open close]) - ..block))) - - (def: .public (image description url) - (-> Text URL (Markdown Span)) - (:abstraction (format "![" (..safe description) "](" url ")"))) - - (def: .public horizontal_rule - (Markdown Block) - (..block "___")) - - (def: .public (link description url) - (-> (Markdown Span) URL (Markdown Span)) - (:abstraction (format "[" (:representation description) "](" url ")"))) - - (type: .public Email - Text) - - (template [<name> <type>] - [(def: .public <name> - (-> <type> (Markdown Span)) - (|>> (text.enclosed ["<" ">"]) :abstraction))] - - [url URL] - [email Email] - ) - - (template [<name> <brand> <infix>] - [(def: .public (<name> pre post) - (-> (Markdown <brand>) (Markdown <brand>) (Markdown <brand>)) - (:abstraction (format (:representation pre) <infix> (:representation post))))] - - [and Span " "] - [then Block ""] - ) - - (def: .public markdown - (All (_ a) (-> (Markdown a) Text)) - (|>> :representation)) + [(def: .public empty + Markdown + (:abstraction "")) + + (def: .public text + (-> Text (Markdown Span)) + (|>> ..safe :abstraction)) + + (def: blank_line + (format text.new_line text.new_line)) + + (template [<name> <prefix>] + [(def: .public (<name> content) + (-> Text (Markdown Block)) + (:abstraction (format <prefix> " " (..safe content) ..blank_line)))] + + [heading/1 "#"] + [heading/2 "##"] + [heading/3 "###"] + [heading/4 "####"] + [heading/5 "#####"] + [heading/6 "######"] + ) + + (def: (block content) + (-> Text (Markdown Block)) + (:abstraction (format content ..blank_line))) + + (def: .public paragraph + (-> (Markdown Span) (Markdown Block)) + (|>> :representation ..block)) + + (def: .public break + (Markdown Span) + (:abstraction (format " " text.new_line))) + + (template [<name> <wrapper>] + [(def: .public <name> + (-> (Markdown Span) (Markdown Span)) + (|>> :representation + (text.enclosed [<wrapper> <wrapper>]) + :abstraction))] + + [bold "**"] + [italic "_"] + ) + + (def: (prefix with) + (-> Text (-> Text Text)) + (|>> (text.all_split_by text.new_line) + (list\each (function (_ line) + (if (text.empty? line) + line + (format with line)))) + (text.interposed text.new_line))) + + (def: indent + (-> Text Text) + (..prefix text.tab)) + + (def: .public quote + (-> (Markdown Block) (Markdown Block)) + (|>> :representation + (..prefix "> ") + :abstraction)) + + (def: .public numbered_list + (-> (List [(Markdown Span) (Maybe (Markdown Block))]) + (Markdown Block)) + (|>> list.enumeration + (list\each (function (_ [idx [summary detail]]) + (format "1. " (:representation summary) + (case detail + (#.Some detail) + (|> detail + :representation + ..indent + (text.enclosed [text.new_line text.new_line]) + (format text.new_line)) + + #.None + "")))) + (text.interposed text.new_line) + ..block)) + + (def: .public bullet_list + (-> (List [(Markdown Span) (Maybe (Markdown Block))]) + (Markdown Block)) + (|>> (list\each (function (_ [summary detail]) + (format "* " (:representation summary) + (case detail + (#.Some detail) + (|> detail + :representation + ..indent + (text.enclosed [text.new_line text.new_line]) + (format text.new_line)) + + #.None + "")))) + (text.interposed text.new_line) + ..block)) + + (def: .public snippet + {#.doc "A snippet of code."} + (-> Text (Markdown Span)) + (|>> (text.enclosed ["`` " " ``"]) :abstraction)) + + (def: .public generic_code + {#.doc "A (generic) block of code."} + (-> Text (Markdown Block)) + (let [open (format "```" text.new_line) + close (format text.new_line "```")] + (|>> (text.enclosed [open close]) ..block))) + + (def: .public (code language block) + {#.doc "A block of code of a specific language."} + (-> Text Text (Markdown Block)) + (let [open (format "```" language text.new_line) + close (format text.new_line "```")] + (|> block + (text.enclosed [open close]) + ..block))) + + (def: .public (image description url) + (-> Text URL (Markdown Span)) + (:abstraction (format "![" (..safe description) "](" url ")"))) + + (def: .public horizontal_rule + (Markdown Block) + (..block "___")) + + (def: .public (link description url) + (-> (Markdown Span) URL (Markdown Span)) + (:abstraction (format "[" (:representation description) "](" url ")"))) + + (type: .public Email + Text) + + (template [<name> <type>] + [(def: .public <name> + (-> <type> (Markdown Span)) + (|>> (text.enclosed ["<" ">"]) :abstraction))] + + [url URL] + [email Email] + ) + + (template [<name> <brand> <infix>] + [(def: .public (<name> pre post) + (-> (Markdown <brand>) (Markdown <brand>) (Markdown <brand>)) + (:abstraction (format (:representation pre) <infix> (:representation post))))] + + [and Span " "] + [then Block ""] + ) + + (def: .public markdown + (All (_ a) (-> (Markdown a) Text)) + (|>> :representation))] ) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index bb8228146..7a5d8106b 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -71,35 +71,33 @@ ["Maximum" (%.nat (-- <limit>))])) (abstract: .public <type> - {} - Nat - (def: .public (<in> value) - (-> Nat (Try <type>)) - (if (n.< <limit> value) - (#try.Success (:abstraction value)) - (exception.except <exception> [value]))) - - (def: .public <out> - (-> <type> Nat) - (|>> :representation)) - - (def: <writer> - (Writer <type>) - (let [suffix <suffix> - padded_size (n.+ (text.size suffix) <size>)] - (|>> :representation - (\ n.octal encoded) - (..octal_padding <size>) - (text.suffix suffix) - (\ utf8.codec encoded) - (format.segment padded_size)))) - - (def: <coercion> - (-> Nat <type>) - (|>> (n.% <limit>) - :abstraction)) + [(def: .public (<in> value) + (-> Nat (Try <type>)) + (if (n.< <limit> value) + (#try.Success (:abstraction value)) + (exception.except <exception> [value]))) + + (def: .public <out> + (-> <type> Nat) + (|>> :representation)) + + (def: <writer> + (Writer <type>) + (let [suffix <suffix> + padded_size (n.+ (text.size suffix) <size>)] + (|>> :representation + (\ n.octal encoded) + (..octal_padding <size>) + (text.suffix suffix) + (\ utf8.codec encoded) + (format.segment padded_size)))) + + (def: <coercion> + (-> Nat <type>) + (|>> (n.% <limit>) + :abstraction))] )] [not_a_small_number small_limit ..small_size @@ -156,59 +154,57 @@ (..big value))))) (abstract: Checksum - {} - Text - (def: from_checksum - (-> Checksum Text) - (|>> :representation)) - - (def: dummy_checksum - Checksum - (:abstraction " ")) - - (def: checksum_suffix - (format ..blank ..null)) - - (def: checksum - (-> Binary Nat) - (binary.aggregate n.+ 0)) - - (def: checksum_checksum - (|> ..dummy_checksum - :representation - (\ utf8.codec encoded) - ..checksum)) - - (def: checksum_code - (-> Binary Checksum) - (|>> ..checksum - ..as_small - ..from_small - (\ n.octal encoded) - (..octal_padding ..small_size) - (text.suffix ..checksum_suffix) - :abstraction)) - - (def: checksum_writer - (Writer Checksum) - (let [padded_size (n.+ (text.size ..checksum_suffix) - ..small_size)] - (|>> :representation - (\ utf8.codec encoded) - (format.segment padded_size)))) - - (def: checksum_parser - (Parser [Nat Checksum]) - (do <>.monad - [ascii (<binary>.segment ..small_size) - digits (<>.lifted (\ utf8.codec decoded ascii)) - _ ..small_suffix - value (<>.lifted - (\ n.octal decoded digits))] - (in [value - (:abstraction (format digits ..checksum_suffix))]))) + [(def: from_checksum + (-> Checksum Text) + (|>> :representation)) + + (def: dummy_checksum + Checksum + (:abstraction " ")) + + (def: checksum_suffix + (format ..blank ..null)) + + (def: checksum + (-> Binary Nat) + (binary.aggregate n.+ 0)) + + (def: checksum_checksum + (|> ..dummy_checksum + :representation + (\ utf8.codec encoded) + ..checksum)) + + (def: checksum_code + (-> Binary Checksum) + (|>> ..checksum + ..as_small + ..from_small + (\ n.octal encoded) + (..octal_padding ..small_size) + (text.suffix ..checksum_suffix) + :abstraction)) + + (def: checksum_writer + (Writer Checksum) + (let [padded_size (n.+ (text.size ..checksum_suffix) + ..small_size)] + (|>> :representation + (\ utf8.codec encoded) + (format.segment padded_size)))) + + (def: checksum_parser + (Parser [Nat Checksum]) + (do <>.monad + [ascii (<binary>.segment ..small_size) + digits (<>.lifted (\ utf8.codec decoded ascii)) + _ ..small_suffix + value (<>.lifted + (\ n.octal decoded digits))] + (in [value + (:abstraction (format digits ..checksum_suffix))])))] ) (def: last_ascii @@ -248,57 +244,55 @@ (template [<type> <representation> <size> <exception> <in> <out> <writer> <parser> <none>] [(abstract: .public <type> - {} - <representation> - (exception: .public (<exception> {value Text}) - (exception.report - ["Value" (%.text value)] - ["Size" (%.nat (text.size value))] - ["Maximum" (%.nat <size>)])) - - (def: .public (<in> value) - (-> <representation> (Try <type>)) - (if (..ascii? value) - (if (|> value - (\ utf8.codec encoded) - binary.size - (n.> <size>)) - (exception.except <exception> [value]) - (#try.Success (:abstraction value))) - (exception.except ..not_ascii [value]))) - - (def: .public <out> - (-> <type> <representation>) - (|>> :representation)) - - (def: <writer> - (Writer <type>) - (let [suffix ..null - padded_size (n.+ (text.size suffix) <size>)] - (|>> :representation - (text.suffix suffix) - (\ utf8.codec encoded) - (format.segment padded_size)))) - - (def: <parser> - (Parser <type>) - (do <>.monad - [string (<binary>.segment <size>) - end <binary>.bits/8 - .let [expected (`` (char (~~ (static ..null))))] - _ (<>.assertion (exception.error ..wrong_character [expected end]) - (n.= expected end))] - (<>.lifted - (do [! try.monad] - [ascii (..un_padded string) - text (\ utf8.codec decoded ascii)] - (<in> text))))) - - (def: .public <none> - <type> - (try.trusted (<in> ""))) + [(exception: .public (<exception> {value Text}) + (exception.report + ["Value" (%.text value)] + ["Size" (%.nat (text.size value))] + ["Maximum" (%.nat <size>)])) + + (def: .public (<in> value) + (-> <representation> (Try <type>)) + (if (..ascii? value) + (if (|> value + (\ utf8.codec encoded) + binary.size + (n.> <size>)) + (exception.except <exception> [value]) + (#try.Success (:abstraction value))) + (exception.except ..not_ascii [value]))) + + (def: .public <out> + (-> <type> <representation>) + (|>> :representation)) + + (def: <writer> + (Writer <type>) + (let [suffix ..null + padded_size (n.+ (text.size suffix) <size>)] + (|>> :representation + (text.suffix suffix) + (\ utf8.codec encoded) + (format.segment padded_size)))) + + (def: <parser> + (Parser <type>) + (do <>.monad + [string (<binary>.segment <size>) + end <binary>.bits/8 + .let [expected (`` (char (~~ (static ..null))))] + _ (<>.assertion (exception.error ..wrong_character [expected end]) + (n.= expected end))] + (<>.lifted + (do [! try.monad] + [ascii (..un_padded string) + text (\ utf8.codec decoded ascii)] + (<in> text))))) + + (def: .public <none> + <type> + (try.trusted (<in> "")))] )] [Name Text ..name_size name_is_too_long name from_name name_writer name_parser anonymous] @@ -308,35 +302,33 @@ (def: magic_size Size 7) (abstract: Magic - {} - Text - (def: ustar (:abstraction "ustar ")) - - (def: from_magic - (-> Magic Text) - (|>> :representation)) - - (def: magic_writer - (Writer Magic) - (let [padded_size (n.+ (text.size ..null) - ..magic_size)] - (|>> :representation - (\ utf8.codec encoded) - (format.segment padded_size)))) - - (def: magic_parser - (Parser Magic) - (do <>.monad - [string (<binary>.segment ..magic_size) - end <binary>.bits/8 - .let [expected (`` (char (~~ (static ..null))))] - _ (<>.assertion (exception.error ..wrong_character [expected end]) - (n.= expected end))] - (<>.lifted - (\ try.monad each (|>> :abstraction) - (\ utf8.codec decoded string))))) + [(def: ustar (:abstraction "ustar ")) + + (def: from_magic + (-> Magic Text) + (|>> :representation)) + + (def: magic_writer + (Writer Magic) + (let [padded_size (n.+ (text.size ..null) + ..magic_size)] + (|>> :representation + (\ utf8.codec encoded) + (format.segment padded_size)))) + + (def: magic_parser + (Parser Magic) + (do <>.monad + [string (<binary>.segment ..magic_size) + end <binary>.bits/8 + .let [expected (`` (char (~~ (static ..null))))] + _ (<>.assertion (exception.error ..wrong_character [expected end]) + (n.= expected end))] + (<>.lifted + (\ try.monad each (|>> :abstraction) + (\ utf8.codec decoded string)))))] ) (def: block_size Size 512) @@ -396,137 +388,133 @@ (..small_number ..device_size))) (abstract: Link_Flag - {} - Char - (def: link_flag - (-> Link_Flag Char) - (|>> :representation)) - - (def: link_flag_writer - (Writer Link_Flag) - (|>> :representation - format.bits/8)) - - (with_expansions [<options> (as_is [0 old_normal] - [(char "0") normal] - [(char "1") link] - [(char "2") symbolic_link] - [(char "3") character] - [(char "4") block] - [(char "5") directory] - [(char "6") fifo] - [(char "7") contiguous])] - (template [<flag> <name>] - [(def: <name> - Link_Flag - (:abstraction <flag>))] - - <options> - ) - - (exception: .public (invalid_link_flag {value Nat}) - (exception.report - ["Value" (%.nat value)])) - - (def: link_flag_parser - (Parser Link_Flag) - (do <>.monad - [linkflag <binary>.bits/8] - (case (.nat linkflag) - (^template [<value> <link_flag>] - [(^ <value>) - (in <link_flag>)]) - (<options>) - - _ - (<>.lifted - (exception.except ..invalid_link_flag [(.nat linkflag)])))))) + [(def: link_flag + (-> Link_Flag Char) + (|>> :representation)) + + (def: link_flag_writer + (Writer Link_Flag) + (|>> :representation + format.bits/8)) + + (with_expansions [<options> (as_is [0 old_normal] + [(char "0") normal] + [(char "1") link] + [(char "2") symbolic_link] + [(char "3") character] + [(char "4") block] + [(char "5") directory] + [(char "6") fifo] + [(char "7") contiguous])] + (template [<flag> <name>] + [(def: <name> + Link_Flag + (:abstraction <flag>))] + + <options> + ) + + (exception: .public (invalid_link_flag {value Nat}) + (exception.report + ["Value" (%.nat value)])) + + (def: link_flag_parser + (Parser Link_Flag) + (do <>.monad + [linkflag <binary>.bits/8] + (case (.nat linkflag) + (^template [<value> <link_flag>] + [(^ <value>) + (in <link_flag>)]) + (<options>) + + _ + (<>.lifted + (exception.except ..invalid_link_flag [(.nat linkflag)]))))))] ) (abstract: .public Mode - {} - Nat - (def: .public mode - (-> Mode Nat) - (|>> :representation)) - - (def: .public (and left right) - (-> Mode Mode Mode) - (:abstraction - (i64.or (:representation left) - (:representation right)))) - - (def: mode_writer - (Writer Mode) - (|>> :representation - ..small - try.trusted - ..small_writer)) - - (exception: .public (invalid_mode {value Nat}) - (exception.report - ["Value" (%.nat value)])) - - (with_expansions [<options> (as_is ["0000" none] - - ["0001" execute_by_other] - ["0002" write_by_other] - ["0004" read_by_other] - - ["0010" execute_by_group] - ["0020" write_by_group] - ["0040" read_by_group] - - ["0100" execute_by_owner] - ["0200" write_by_owner] - ["0400" read_by_owner] - - ["1000" save_text] - ["2000" set_group_id_on_execution] - ["4000" set_user_id_on_execution])] - (template [<code> <name>] - [(def: .public <name> - Mode - (:abstraction (number.oct <code>)))] - - <options> - ) - - (def: maximum_mode - Mode - ($_ and - ..none - - ..execute_by_other - ..write_by_other - ..read_by_other - - ..execute_by_group - ..write_by_group - ..read_by_group - - ..execute_by_owner - ..write_by_owner - ..read_by_owner - - ..save_text - ..set_group_id_on_execution - ..set_user_id_on_execution - )) - - (def: mode_parser - (Parser Mode) - (do [! <>.monad] - [value (\ ! each ..from_small ..small_parser)] - (if (n.> (:representation ..maximum_mode) - value) - (<>.lifted - (exception.except ..invalid_mode [value])) - (in (:abstraction value)))))) + [(def: .public mode + (-> Mode Nat) + (|>> :representation)) + + (def: .public (and left right) + (-> Mode Mode Mode) + (:abstraction + (i64.or (:representation left) + (:representation right)))) + + (def: mode_writer + (Writer Mode) + (|>> :representation + ..small + try.trusted + ..small_writer)) + + (exception: .public (invalid_mode {value Nat}) + (exception.report + ["Value" (%.nat value)])) + + (with_expansions [<options> (as_is ["0000" none] + + ["0001" execute_by_other] + ["0002" write_by_other] + ["0004" read_by_other] + + ["0010" execute_by_group] + ["0020" write_by_group] + ["0040" read_by_group] + + ["0100" execute_by_owner] + ["0200" write_by_owner] + ["0400" read_by_owner] + + ["1000" save_text] + ["2000" set_group_id_on_execution] + ["4000" set_user_id_on_execution])] + (template [<code> <name>] + [(def: .public <name> + Mode + (:abstraction (number.oct <code>)))] + + <options> + ) + + (def: maximum_mode + Mode + ($_ and + ..none + + ..execute_by_other + ..write_by_other + ..read_by_other + + ..execute_by_group + ..write_by_group + ..read_by_group + + ..execute_by_owner + ..write_by_owner + ..read_by_owner + + ..save_text + ..set_group_id_on_execution + ..set_user_id_on_execution + )) + + (def: mode_parser + (Parser Mode) + (do [! <>.monad] + [value (\ ! each ..from_small ..small_parser)] + (if (n.> (:representation ..maximum_mode) + value) + (<>.lifted + (exception.except ..invalid_mode [value])) + (in (:abstraction value))))))] ) (def: maximum_content_size @@ -536,23 +524,21 @@ (list\mix n.* 1))) (abstract: .public Content - {} - [Big Binary] - (def: .public (content content) - (-> Binary (Try Content)) - (do try.monad - [size (..big (binary.size content))] - (in (:abstraction [size content])))) + [(def: .public (content content) + (-> Binary (Try Content)) + (do try.monad + [size (..big (binary.size content))] + (in (:abstraction [size content])))) - (def: from_content - (-> Content [Big Binary]) - (|>> :representation)) + (def: from_content + (-> Content [Big Binary]) + (|>> :representation)) - (def: .public data - (-> Content Binary) - (|>> :representation product.right)) + (def: .public data + (-> Content Binary) + (|>> :representation product.right))] ) (type: .public ID diff --git a/stdlib/source/library/lux/data/text/buffer.lux b/stdlib/source/library/lux/data/text/buffer.lux index 828a4772e..af3341930 100644 --- a/stdlib/source/library/lux/data/text/buffer.lux +++ b/stdlib/source/library/lux/data/text/buffer.lux @@ -48,8 +48,6 @@ (as_is)))) (`` (abstract: .public Buffer - {} - (for {@.old [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] @.jvm [Nat (-> java/lang/StringBuilder java/lang/StringBuilder)] @.js [Nat (-> (JS_Array Text) (JS_Array Text))] @@ -57,79 +55,79 @@ ... default (Row Text)) - (def: .public empty - Buffer - (:abstraction (with_expansions [<jvm> [0 function.identity]] - (for {@.old <jvm> - @.jvm <jvm> - @.js [0 function.identity] - @.lua [0 function.identity]} - ... default - row.empty)))) + [(def: .public empty + Buffer + (:abstraction (with_expansions [<jvm> [0 function.identity]] + (for {@.old <jvm> + @.jvm <jvm> + @.js [0 function.identity] + @.lua [0 function.identity]} + ... default + row.empty)))) - (def: .public (then chunk buffer) - (-> Text Buffer Buffer) - (with_expansions [<jvm> (let [[capacity transform] (:representation buffer) - then! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) - (function (_ chunk builder) - (exec - (java/lang/Appendable::append (:as java/lang/CharSequence chunk) - builder) - builder)))] - (:abstraction [(n.+ (//.size chunk) capacity) - (|>> transform (then! chunk))]))] - (for {@.old <jvm> - @.jvm <jvm> - @.js (let [[capacity transform] (:representation buffer) - then! (: (-> (JS_Array Text) (JS_Array Text)) - (function (_ array) - (exec - (JS_Array::push [chunk] array) - array)))] - (:abstraction [(n.+ (//.size chunk) capacity) - (|>> transform then!)])) - @.lua (let [[capacity transform] (:representation buffer) - then! (: (-> (array.Array Text) (array.Array Text)) + (def: .public (then chunk buffer) + (-> Text Buffer Buffer) + (with_expansions [<jvm> (let [[capacity transform] (:representation buffer) + then! (: (-> Text java/lang/StringBuilder java/lang/StringBuilder) + (function (_ chunk builder) + (exec + (java/lang/Appendable::append (:as java/lang/CharSequence chunk) + builder) + builder)))] + (:abstraction [(n.+ (//.size chunk) capacity) + (|>> transform (then! chunk))]))] + (for {@.old <jvm> + @.jvm <jvm> + @.js (let [[capacity transform] (:representation buffer) + then! (: (-> (JS_Array Text) (JS_Array Text)) (function (_ array) (exec - (table/insert [array chunk]) + (JS_Array::push [chunk] array) array)))] (:abstraction [(n.+ (//.size chunk) capacity) - (|>> transform then!)]))} - ... default - (|> buffer :representation (row.suffix chunk) :abstraction)))) + (|>> transform then!)])) + @.lua (let [[capacity transform] (:representation buffer) + then! (: (-> (array.Array Text) (array.Array Text)) + (function (_ array) + (exec + (table/insert [array chunk]) + array)))] + (:abstraction [(n.+ (//.size chunk) capacity) + (|>> transform then!)]))} + ... default + (|> buffer :representation (row.suffix chunk) :abstraction)))) - (def: .public size - (-> Buffer Nat) - (with_expansions [<jvm> (|>> :representation product.left)] - (for {@.old <jvm> - @.jvm <jvm> - @.js <jvm> - @.lua <jvm>} - ... default - (|>> :representation - (row\mix (function (_ chunk total) - (n.+ (//.size chunk) total)) - 0))))) + (def: .public size + (-> Buffer Nat) + (with_expansions [<jvm> (|>> :representation product.left)] + (for {@.old <jvm> + @.jvm <jvm> + @.js <jvm> + @.lua <jvm>} + ... default + (|>> :representation + (row\mix (function (_ chunk total) + (n.+ (//.size chunk) total)) + 0))))) - (def: .public (text buffer) - (-> Buffer Text) - (with_expansions [<jvm> (let [[capacity transform] (:representation buffer)] - (|> (java/lang/StringBuilder::new (.int capacity)) - transform - java/lang/StringBuilder::toString))] - (for {@.old <jvm> - @.jvm <jvm> - @.js (let [[capacity transform] (:representation buffer)] - (|> (array.empty 0) - (:as (JS_Array Text)) - transform - (JS_Array::join [""]))) - @.lua (let [[capacity transform] (:representation buffer)] - (table/concat [(transform (array.empty 0)) ""]))} - ... default - (row\mix (function (_ chunk total) - (format total chunk)) - "" - (:representation buffer))))) + (def: .public (text buffer) + (-> Buffer Text) + (with_expansions [<jvm> (let [[capacity transform] (:representation buffer)] + (|> (java/lang/StringBuilder::new (.int capacity)) + transform + java/lang/StringBuilder::toString))] + (for {@.old <jvm> + @.jvm <jvm> + @.js (let [[capacity transform] (:representation buffer)] + (|> (array.empty 0) + (:as (JS_Array Text)) + transform + (JS_Array::join [""]))) + @.lua (let [[capacity transform] (:representation buffer)] + (table/concat [(transform (array.empty 0)) ""]))} + ... default + (row\mix (function (_ chunk total) + (format total chunk)) + "" + (:representation buffer)))))] )) diff --git a/stdlib/source/library/lux/data/text/encoding.lux b/stdlib/source/library/lux/data/text/encoding.lux index 952c285f0..3b6dff526 100644 --- a/stdlib/source/library/lux/data/text/encoding.lux +++ b/stdlib/source/library/lux/data/text/encoding.lux @@ -8,161 +8,159 @@ ... https://en.wikipedia.org/wiki/Character_encoding#Common_character_encodings (abstract: .public Encoding - {} - Text - (template [<name> <encoding>] - [(`` (def: .public <name> - Encoding - (:abstraction <encoding>)))] + [(template [<name> <encoding>] + [(`` (def: .public <name> + Encoding + (:abstraction <encoding>)))] - [ascii "ASCII"] + [ascii "ASCII"] - [ibm_037 "IBM037"] - [ibm_273 "IBM273"] - [ibm_277 "IBM277"] - [ibm_278 "IBM278"] - [ibm_280 "IBM280"] - [ibm_284 "IBM284"] - [ibm_285 "IBM285"] - [ibm_290 "IBM290"] - [ibm_297 "IBM297"] - [ibm_300 "IBM300"] - [ibm_420 "IBM420"] - [ibm_424 "IBM424"] - [ibm_437 "IBM437"] - [ibm_500 "IBM500"] - [ibm_737 "IBM737"] - [ibm_775 "IBM775"] - [ibm_833 "IBM833"] - [ibm_834 "IBM834"] - [ibm_838 "IBM-Thai"] - [ibm_850 "IBM850"] - [ibm_852 "IBM852"] - [ibm_855 "IBM855"] - [ibm_856 "IBM856"] - [ibm_857 "IBM857"] - [ibm_858 "IBM00858"] - [ibm_860 "IBM860"] - [ibm_861 "IBM861"] - [ibm_862 "IBM862"] - [ibm_863 "IBM863"] - [ibm_864 "IBM864"] - [ibm_865 "IBM865"] - [ibm_866 "IBM866"] - [ibm_868 "IBM868"] - [ibm_869 "IBM869"] - [ibm_870 "IBM870"] - [ibm_871 "IBM871"] - [ibm_874 "IBM874"] - [ibm_875 "IBM875"] - [ibm_918 "IBM918"] - [ibm_921 "IBM921"] - [ibm_922 "IBM922"] - [ibm_930 "IBM930"] - [ibm_933 "IBM933"] - [ibm_935 "IBM935"] - [ibm_937 "IBM937"] - [ibm_939 "IBM939"] - [ibm_942 "IBM942"] - [ibm_942c "IBM942C"] - [ibm_943 "IBM943"] - [ibm_943c "IBM943C"] - [ibm_948 "IBM948"] - [ibm_949 "IBM949"] - [ibm_949c "IBM949C"] - [ibm_950 "IBM950"] - [ibm_964 "IBM964"] - [ibm_970 "IBM970"] - [ibm_1006 "IBM1006"] - [ibm_1025 "IBM1025"] - [ibm_1026 "IBM1026"] - [ibm_1046 "IBM1046"] - [ibm_1047 "IBM1047"] - [ibm_1097 "IBM1097"] - [ibm_1098 "IBM1098"] - [ibm_1112 "IBM1112"] - [ibm_1122 "IBM1122"] - [ibm_1123 "IBM1123"] - [ibm_1124 "IBM1124"] - [ibm_1140 "IBM01140"] - [ibm_1141 "IBM01141"] - [ibm_1142 "IBM01142"] - [ibm_1143 "IBM01143"] - [ibm_1144 "IBM01144"] - [ibm_1145 "IBM01145"] - [ibm_1146 "IBM01146"] - [ibm_1147 "IBM01147"] - [ibm_1148 "IBM01148"] - [ibm_1149 "IBM01149"] - [ibm_1166 "IBM1166"] - [ibm_1364 "IBM1364"] - [ibm_1381 "IBM1381"] - [ibm_1383 "IBM1383"] - [ibm_33722 "IBM33722"] - - [iso_2022_cn "ISO-2022-CN"] - [iso2022_cn_cns "ISO2022-CN-CNS"] - [iso2022_cn_gb "ISO2022-CN-GB"] - [iso_2022_jp "ISO-2022-JP"] - [iso_2022_jp_2 "ISO-2022-JP-2"] - [iso_2022_kr "ISO-2022-KR"] - [iso_8859_1 "ISO-8859-1"] - [iso_8859_2 "ISO-8859-2"] - [iso_8859_3 "ISO-8859-3"] - [iso_8859_4 "ISO-8859-4"] - [iso_8859_5 "ISO-8859-5"] - [iso_8859_6 "ISO-8859-6"] - [iso_8859_7 "ISO-8859-7"] - [iso_8859_8 "ISO-8859-8"] - [iso_8859_9 "ISO-8859-9"] - [iso_8859_11 "iso-8859-11"] - [iso_8859_13 "ISO-8859-13"] - [iso_8859_15 "ISO-8859-15"] + [ibm_037 "IBM037"] + [ibm_273 "IBM273"] + [ibm_277 "IBM277"] + [ibm_278 "IBM278"] + [ibm_280 "IBM280"] + [ibm_284 "IBM284"] + [ibm_285 "IBM285"] + [ibm_290 "IBM290"] + [ibm_297 "IBM297"] + [ibm_300 "IBM300"] + [ibm_420 "IBM420"] + [ibm_424 "IBM424"] + [ibm_437 "IBM437"] + [ibm_500 "IBM500"] + [ibm_737 "IBM737"] + [ibm_775 "IBM775"] + [ibm_833 "IBM833"] + [ibm_834 "IBM834"] + [ibm_838 "IBM-Thai"] + [ibm_850 "IBM850"] + [ibm_852 "IBM852"] + [ibm_855 "IBM855"] + [ibm_856 "IBM856"] + [ibm_857 "IBM857"] + [ibm_858 "IBM00858"] + [ibm_860 "IBM860"] + [ibm_861 "IBM861"] + [ibm_862 "IBM862"] + [ibm_863 "IBM863"] + [ibm_864 "IBM864"] + [ibm_865 "IBM865"] + [ibm_866 "IBM866"] + [ibm_868 "IBM868"] + [ibm_869 "IBM869"] + [ibm_870 "IBM870"] + [ibm_871 "IBM871"] + [ibm_874 "IBM874"] + [ibm_875 "IBM875"] + [ibm_918 "IBM918"] + [ibm_921 "IBM921"] + [ibm_922 "IBM922"] + [ibm_930 "IBM930"] + [ibm_933 "IBM933"] + [ibm_935 "IBM935"] + [ibm_937 "IBM937"] + [ibm_939 "IBM939"] + [ibm_942 "IBM942"] + [ibm_942c "IBM942C"] + [ibm_943 "IBM943"] + [ibm_943c "IBM943C"] + [ibm_948 "IBM948"] + [ibm_949 "IBM949"] + [ibm_949c "IBM949C"] + [ibm_950 "IBM950"] + [ibm_964 "IBM964"] + [ibm_970 "IBM970"] + [ibm_1006 "IBM1006"] + [ibm_1025 "IBM1025"] + [ibm_1026 "IBM1026"] + [ibm_1046 "IBM1046"] + [ibm_1047 "IBM1047"] + [ibm_1097 "IBM1097"] + [ibm_1098 "IBM1098"] + [ibm_1112 "IBM1112"] + [ibm_1122 "IBM1122"] + [ibm_1123 "IBM1123"] + [ibm_1124 "IBM1124"] + [ibm_1140 "IBM01140"] + [ibm_1141 "IBM01141"] + [ibm_1142 "IBM01142"] + [ibm_1143 "IBM01143"] + [ibm_1144 "IBM01144"] + [ibm_1145 "IBM01145"] + [ibm_1146 "IBM01146"] + [ibm_1147 "IBM01147"] + [ibm_1148 "IBM01148"] + [ibm_1149 "IBM01149"] + [ibm_1166 "IBM1166"] + [ibm_1364 "IBM1364"] + [ibm_1381 "IBM1381"] + [ibm_1383 "IBM1383"] + [ibm_33722 "IBM33722"] + + [iso_2022_cn "ISO-2022-CN"] + [iso2022_cn_cns "ISO2022-CN-CNS"] + [iso2022_cn_gb "ISO2022-CN-GB"] + [iso_2022_jp "ISO-2022-JP"] + [iso_2022_jp_2 "ISO-2022-JP-2"] + [iso_2022_kr "ISO-2022-KR"] + [iso_8859_1 "ISO-8859-1"] + [iso_8859_2 "ISO-8859-2"] + [iso_8859_3 "ISO-8859-3"] + [iso_8859_4 "ISO-8859-4"] + [iso_8859_5 "ISO-8859-5"] + [iso_8859_6 "ISO-8859-6"] + [iso_8859_7 "ISO-8859-7"] + [iso_8859_8 "ISO-8859-8"] + [iso_8859_9 "ISO-8859-9"] + [iso_8859_11 "iso-8859-11"] + [iso_8859_13 "ISO-8859-13"] + [iso_8859_15 "ISO-8859-15"] - [mac_arabic "MacArabic"] - [mac_central_europe "MacCentralEurope"] - [mac_croatian "MacCroatian"] - [mac_cyrillic "MacCyrillic"] - [mac_dingbat "MacDingbat"] - [mac_greek "MacGreek"] - [mac_hebrew "MacHebrew"] - [mac_iceland "MacIceland"] - [mac_roman "MacRoman"] - [mac_romania "MacRomania"] - [mac_symbol "MacSymbol"] - [mac_thai "MacThai"] - [mac_turkish "MacTurkish"] - [mac_ukraine "MacUkraine"] - - [utf_8 "UTF-8"] - [utf_16 "UTF-16"] - [utf_32 "UTF-32"] + [mac_arabic "MacArabic"] + [mac_central_europe "MacCentralEurope"] + [mac_croatian "MacCroatian"] + [mac_cyrillic "MacCyrillic"] + [mac_dingbat "MacDingbat"] + [mac_greek "MacGreek"] + [mac_hebrew "MacHebrew"] + [mac_iceland "MacIceland"] + [mac_roman "MacRoman"] + [mac_romania "MacRomania"] + [mac_symbol "MacSymbol"] + [mac_thai "MacThai"] + [mac_turkish "MacTurkish"] + [mac_ukraine "MacUkraine"] + + [utf_8 "UTF-8"] + [utf_16 "UTF-16"] + [utf_32 "UTF-32"] - [windows_31j "windows-31j"] - [windows_874 "windows-874"] - [windows_949 "windows-949"] - [windows_950 "windows-950"] - [windows_1250 "windows-1250"] - [windows_1252 "windows-1252"] - [windows_1251 "windows-1251"] - [windows_1253 "windows-1253"] - [windows_1254 "windows-1254"] - [windows_1255 "windows-1255"] - [windows_1256 "windows-1256"] - [windows_1257 "windows-1257"] - [windows_1258 "windows-1258"] - [windows_iso2022jp "windows-iso2022jp"] - [windows_50220 "windows-50220"] - [windows_50221 "windows-50221"] - - [cesu_8 "CESU-8"] - [koi8_r "KOI8-R"] - [koi8_u "KOI8-U"] - ) + [windows_31j "windows-31j"] + [windows_874 "windows-874"] + [windows_949 "windows-949"] + [windows_950 "windows-950"] + [windows_1250 "windows-1250"] + [windows_1252 "windows-1252"] + [windows_1251 "windows-1251"] + [windows_1253 "windows-1253"] + [windows_1254 "windows-1254"] + [windows_1255 "windows-1255"] + [windows_1256 "windows-1256"] + [windows_1257 "windows-1257"] + [windows_1258 "windows-1258"] + [windows_iso2022jp "windows-iso2022jp"] + [windows_50220 "windows-50220"] + [windows_50221 "windows-50221"] + + [cesu_8 "CESU-8"] + [koi8_r "KOI8-R"] + [koi8_u "KOI8-U"] + ) - (def: .public name - (-> Encoding Text) - (|>> :representation)) + (def: .public name + (-> Encoding Text) + (|>> :representation))] ) diff --git a/stdlib/source/library/lux/data/text/unicode/block.lux b/stdlib/source/library/lux/data/text/unicode/block.lux index 7d0bfca33..bca01c5ee 100644 --- a/stdlib/source/library/lux/data/text/unicode/block.lux +++ b/stdlib/source/library/lux/data/text/unicode/block.lux @@ -15,49 +15,47 @@ [/// {"+" [Char]}]) (abstract: .public Block - {} - (Interval Char) - (implementation: .public monoid - (Monoid Block) - - (def: identity - (:abstraction - (interval.between n.enum n\top n\bottom))) - - (def: (composite left right) - (let [left (:representation left) - right (:representation right)] - (:abstraction - (interval.between n.enum - (n.min (\ left bottom) - (\ right bottom)) - (n.max (\ left top) - (\ right top))))))) + [(implementation: .public monoid + (Monoid Block) + + (def: identity + (:abstraction + (interval.between n.enum n\top n\bottom))) + + (def: (composite left right) + (let [left (:representation left) + right (:representation right)] + (:abstraction + (interval.between n.enum + (n.min (\ left bottom) + (\ right bottom)) + (n.max (\ left top) + (\ right top))))))) - (def: .public (block start additional) - (-> Char Nat Block) - (:abstraction (interval.between n.enum start (n.+ additional start)))) + (def: .public (block start additional) + (-> Char Nat Block) + (:abstraction (interval.between n.enum start (n.+ additional start)))) - (template [<name> <slot>] - [(def: .public <name> - (-> Block Char) - (|>> :representation (value@ <slot>)))] + (template [<name> <slot>] + [(def: .public <name> + (-> Block Char) + (|>> :representation (value@ <slot>)))] - [start #interval.bottom] - [end #interval.top] - ) + [start #interval.bottom] + [end #interval.top] + ) - (def: .public (size block) - (-> Block Nat) - (let [start (value@ #interval.bottom (:representation block)) - end (value@ #interval.top (:representation block))] - (|> end (n.- start) ++))) + (def: .public (size block) + (-> Block Nat) + (let [start (value@ #interval.bottom (:representation block)) + end (value@ #interval.top (:representation block))] + (|> end (n.- start) ++))) - (def: .public (within? block char) - (All (_ a) (-> Block Char Bit)) - (interval.within? (:representation block) char)) + (def: .public (within? block char) + (All (_ a) (-> Block Char Bit)) + (interval.within? (:representation block) char))] ) (implementation: .public equivalence diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index bab5bf9ae..b47505a09 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -27,212 +27,210 @@ @)) (abstract: .public Set - {} - (Tree :@: Block []) - (def: .public (composite left right) - (-> Set Set Set) - (:abstraction - (\ builder branch - (:representation left) - (:representation right)))) - - (def: (singleton block) - (-> Block Set) - (:abstraction - (\ builder leaf block []))) - - (def: .public (set [head tail]) - (-> [Block (List Block)] Set) - (list\mix (: (-> Block Set Set) - (function (_ block set) - (..composite (..singleton block) set))) - (..singleton head) - tail)) - - (def: character/0 - Set - (..set [//block.basic_latin - (list //block.latin_1_supplement - //block.latin_extended_a - //block.latin_extended_b - //block.ipa_extensions - //block.spacing_modifier_letters - //block.combining_diacritical_marks - //block.greek_and_coptic - //block.cyrillic - //block.cyrillic_supplementary - //block.armenian - //block.hebrew - //block.arabic - //block.syriac - //block.thaana - //block.devanagari - //block.bengali - //block.gurmukhi - //block.gujarati - //block.oriya - //block.tamil - //block.telugu - //block.kannada - //block.malayalam - //block.sinhala - //block.thai - //block.lao - //block.tibetan - //block.myanmar - //block.georgian)])) - - (def: character/1 - Set - (..set [//block.hangul_jamo - (list //block.ethiopic - //block.cherokee - //block.unified_canadian_aboriginal_syllabics - //block.ogham - //block.runic - //block.tagalog - //block.hanunoo - //block.buhid - //block.tagbanwa - //block.khmer - //block.mongolian - //block.limbu - //block.tai_le - //block.khmer_symbols - //block.phonetic_extensions - //block.latin_extended_additional - //block.greek_extended - //block.general_punctuation - //block.superscripts_and_subscripts - //block.currency_symbols - //block.combining_diacritical_marks_for_symbols - //block.letterlike_symbols - //block.number_forms - //block.arrows - //block.mathematical_operators - //block.miscellaneous_technical - //block.control_pictures - //block.optical_character_recognition - //block.enclosed_alphanumerics - //block.box_drawing)])) - - (def: character/2 - Set - (..set [//block.block_elements - (list //block.geometric_shapes - //block.miscellaneous_symbols - //block.dingbats - //block.miscellaneous_mathematical_symbols_a - //block.supplemental_arrows_a - //block.braille_patterns - //block.supplemental_arrows_b - //block.miscellaneous_mathematical_symbols_b - //block.supplemental_mathematical_operators - //block.miscellaneous_symbols_and_arrows - //block.cjk_radicals_supplement - //block.kangxi_radicals - //block.ideographic_description_characters - //block.cjk_symbols_and_punctuation - //block.hiragana - //block.katakana - //block.bopomofo - //block.hangul_compatibility_jamo - //block.kanbun - //block.bopomofo_extended - //block.katakana_phonetic_extensions - //block.enclosed_cjk_letters_and_months - //block.cjk_compatibility - //block.cjk_unified_ideographs_extension_a - //block.yijing_hexagram_symbols - //block.cjk_unified_ideographs - //block.yi_syllables - //block.yi_radicals - //block.hangul_syllables - )])) - - (def: .public character - Set - ($_ ..composite - ..character/0 - ..character/1 - ..character/2 - )) - - (def: .public non_character - Set - (..set [//block.high_surrogates - (list //block.high_private_use_surrogates - //block.low_surrogates - //block.private_use_area - //block.cjk_compatibility_ideographs - //block.alphabetic_presentation_forms - //block.arabic_presentation_forms_a - //block.variation_selectors - //block.combining_half_marks - //block.cjk_compatibility_forms - //block.small_form_variants - //block.arabic_presentation_forms_b - //block.halfwidth_and_fullwidth_forms - //block.specials - ... //block.linear_b_syllabary - ... //block.linear_b_ideograms - ... //block.aegean_numbers - ... //block.old_italic - ... //block.gothic - ... //block.ugaritic - ... //block.deseret - ... //block.shavian - ... //block.osmanya - ... //block.cypriot_syllabary - ... //block.byzantine_musical_symbols - ... //block.musical_symbols - ... //block.tai_xuan_jing_symbols - ... //block.mathematical_alphanumeric_symbols - ... //block.cjk_unified_ideographs_extension_b - ... //block.cjk_compatibility_ideographs_supplement - ... //block.tags + [(def: .public (composite left right) + (-> Set Set Set) + (:abstraction + (\ builder branch + (:representation left) + (:representation right)))) + + (def: (singleton block) + (-> Block Set) + (:abstraction + (\ builder leaf block []))) + + (def: .public (set [head tail]) + (-> [Block (List Block)] Set) + (list\mix (: (-> Block Set Set) + (function (_ block set) + (..composite (..singleton block) set))) + (..singleton head) + tail)) + + (def: character/0 + Set + (..set [//block.basic_latin + (list //block.latin_1_supplement + //block.latin_extended_a + //block.latin_extended_b + //block.ipa_extensions + //block.spacing_modifier_letters + //block.combining_diacritical_marks + //block.greek_and_coptic + //block.cyrillic + //block.cyrillic_supplementary + //block.armenian + //block.hebrew + //block.arabic + //block.syriac + //block.thaana + //block.devanagari + //block.bengali + //block.gurmukhi + //block.gujarati + //block.oriya + //block.tamil + //block.telugu + //block.kannada + //block.malayalam + //block.sinhala + //block.thai + //block.lao + //block.tibetan + //block.myanmar + //block.georgian)])) + + (def: character/1 + Set + (..set [//block.hangul_jamo + (list //block.ethiopic + //block.cherokee + //block.unified_canadian_aboriginal_syllabics + //block.ogham + //block.runic + //block.tagalog + //block.hanunoo + //block.buhid + //block.tagbanwa + //block.khmer + //block.mongolian + //block.limbu + //block.tai_le + //block.khmer_symbols + //block.phonetic_extensions + //block.latin_extended_additional + //block.greek_extended + //block.general_punctuation + //block.superscripts_and_subscripts + //block.currency_symbols + //block.combining_diacritical_marks_for_symbols + //block.letterlike_symbols + //block.number_forms + //block.arrows + //block.mathematical_operators + //block.miscellaneous_technical + //block.control_pictures + //block.optical_character_recognition + //block.enclosed_alphanumerics + //block.box_drawing)])) + + (def: character/2 + Set + (..set [//block.block_elements + (list //block.geometric_shapes + //block.miscellaneous_symbols + //block.dingbats + //block.miscellaneous_mathematical_symbols_a + //block.supplemental_arrows_a + //block.braille_patterns + //block.supplemental_arrows_b + //block.miscellaneous_mathematical_symbols_b + //block.supplemental_mathematical_operators + //block.miscellaneous_symbols_and_arrows + //block.cjk_radicals_supplement + //block.kangxi_radicals + //block.ideographic_description_characters + //block.cjk_symbols_and_punctuation + //block.hiragana + //block.katakana + //block.bopomofo + //block.hangul_compatibility_jamo + //block.kanbun + //block.bopomofo_extended + //block.katakana_phonetic_extensions + //block.enclosed_cjk_letters_and_months + //block.cjk_compatibility + //block.cjk_unified_ideographs_extension_a + //block.yijing_hexagram_symbols + //block.cjk_unified_ideographs + //block.yi_syllables + //block.yi_radicals + //block.hangul_syllables )])) - (def: .public full - Set - ($_ ..composite - ..character - ..non_character - )) - - (def: .public start - (-> Set Char) - (|>> :representation - tree.tag - //block.start)) - - (def: .public end - (-> Set Char) - (|>> :representation - tree.tag - //block.end)) - - (def: .public (member? set character) - (-> Set Char Bit) - (loop [tree (:representation set)] - (if (//block.within? (tree.tag tree) character) - (case (tree.root tree) - (0 #0 _) - true - - (0 #1 left right) - (or (recur left) - (recur right))) - false))) - - (implementation: .public equivalence - (Equivalence Set) - - (def: (= reference subject) - (set\= (set.of_list //block.hash (tree.tags (:representation reference))) - (set.of_list //block.hash (tree.tags (:representation subject)))))) + (def: .public character + Set + ($_ ..composite + ..character/0 + ..character/1 + ..character/2 + )) + + (def: .public non_character + Set + (..set [//block.high_surrogates + (list //block.high_private_use_surrogates + //block.low_surrogates + //block.private_use_area + //block.cjk_compatibility_ideographs + //block.alphabetic_presentation_forms + //block.arabic_presentation_forms_a + //block.variation_selectors + //block.combining_half_marks + //block.cjk_compatibility_forms + //block.small_form_variants + //block.arabic_presentation_forms_b + //block.halfwidth_and_fullwidth_forms + //block.specials + ... //block.linear_b_syllabary + ... //block.linear_b_ideograms + ... //block.aegean_numbers + ... //block.old_italic + ... //block.gothic + ... //block.ugaritic + ... //block.deseret + ... //block.shavian + ... //block.osmanya + ... //block.cypriot_syllabary + ... //block.byzantine_musical_symbols + ... //block.musical_symbols + ... //block.tai_xuan_jing_symbols + ... //block.mathematical_alphanumeric_symbols + ... //block.cjk_unified_ideographs_extension_b + ... //block.cjk_compatibility_ideographs_supplement + ... //block.tags + )])) + + (def: .public full + Set + ($_ ..composite + ..character + ..non_character + )) + + (def: .public start + (-> Set Char) + (|>> :representation + tree.tag + //block.start)) + + (def: .public end + (-> Set Char) + (|>> :representation + tree.tag + //block.end)) + + (def: .public (member? set character) + (-> Set Char Bit) + (loop [tree (:representation set)] + (if (//block.within? (tree.tag tree) character) + (case (tree.root tree) + (0 #0 _) + true + + (0 #1 left right) + (or (recur left) + (recur right))) + false))) + + (implementation: .public equivalence + (Equivalence Set) + + (def: (= reference subject) + (set\= (set.of_list //block.hash (tree.tags (:representation reference))) + (set.of_list //block.hash (tree.tags (:representation subject))))))] ) (template [<name> <blocks>] diff --git a/stdlib/source/library/lux/ffi.js.lux b/stdlib/source/library/lux/ffi.js.lux index 49cd0067a..b8a1dbf58 100644 --- a/stdlib/source/library/lux/ffi.js.lux +++ b/stdlib/source/library/lux/ffi.js.lux @@ -22,20 +22,15 @@ ["[0]" code] ["[0]" template]]]]) -(abstract: .public (Object brand) - {} - - Any) +(abstract: .public (Object brand) Any []) (template [<name>] [(with_expansions [<brand> (template.identifier [<name> "'"])] (abstract: <brand> - {} - Any - (type: .public <name> - (Object <brand>))))] + [(type: .public <name> + (Object <brand>))]))] [Function] [Symbol] diff --git a/stdlib/source/library/lux/ffi.lua.lux b/stdlib/source/library/lux/ffi.lua.lux index 4144c573f..b4dac8f03 100644 --- a/stdlib/source/library/lux/ffi.lua.lux +++ b/stdlib/source/library/lux/ffi.lua.lux @@ -23,13 +23,11 @@ ["[0]" code] ["[0]" template]]]]) -(abstract: .public (Object brand) - {} - Any) +(abstract: .public (Object brand) Any []) (template [<name>] [(with_expansions [<brand> (template.identifier [<name> "'"])] - (abstract: <brand> {} Any) + (abstract: <brand> Any []) (type: .public <name> (..Object <brand>)))] diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux index 245c56391..095b1b754 100644 --- a/stdlib/source/library/lux/ffi.php.lux +++ b/stdlib/source/library/lux/ffi.php.lux @@ -23,11 +23,11 @@ ["[0]" code] ["[0]" template]]]]) -(abstract: .public (Object brand) {} Any) +(abstract: .public (Object brand) Any []) (template [<name>] [(with_expansions [<brand> (template.identifier [<name> "'"])] - (abstract: .public <brand> {} Any) + (abstract: .public <brand> Any []) (type: .public <name> (..Object <brand>)))] diff --git a/stdlib/source/library/lux/ffi.py.lux b/stdlib/source/library/lux/ffi.py.lux index b6f7eced4..d0ac65ba0 100644 --- a/stdlib/source/library/lux/ffi.py.lux +++ b/stdlib/source/library/lux/ffi.py.lux @@ -23,13 +23,11 @@ ["[0]" code] ["[0]" template]]]]) -(abstract: .public (Object brand) - {} - Any) +(abstract: .public (Object brand) Any []) (template [<name>] [(with_expansions [<brand> (template.identifier [<name> "'"])] - (abstract: <brand> {} Any) + (abstract: <brand> Any []) (type: .public <name> (..Object <brand>)))] diff --git a/stdlib/source/library/lux/ffi.rb.lux b/stdlib/source/library/lux/ffi.rb.lux index 54900494b..62620c6af 100644 --- a/stdlib/source/library/lux/ffi.rb.lux +++ b/stdlib/source/library/lux/ffi.rb.lux @@ -23,13 +23,11 @@ ["[0]" code] ["[0]" template]]]]) -(abstract: .public (Object brand) - {} - Any) +(abstract: .public (Object brand) Any []) (template [<name>] [(with_expansions [<brand> (template.identifier [<name> "'"])] - (abstract: <brand> {} Any) + (abstract: <brand> Any []) (type: .public <name> (..Object <brand>)))] diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux index f4f0a0cda..0a3efb41a 100644 --- a/stdlib/source/library/lux/ffi.scm.lux +++ b/stdlib/source/library/lux/ffi.scm.lux @@ -23,11 +23,11 @@ ["[0]" code] ["[0]" template]]]]) -(abstract: .public (Object brand) {} Any) +(abstract: .public (Object brand) Any []) (template [<name>] [(with_expansions [<brand> (template.identifier [<name> "'"])] - (abstract: .public <brand> {} Any) + (abstract: .public <brand> Any []) (type: .public <name> (..Object <brand>)))] diff --git a/stdlib/source/library/lux/locale.lux b/stdlib/source/library/lux/locale.lux index 5b855793b..e0ac8bce0 100644 --- a/stdlib/source/library/lux/locale.lux +++ b/stdlib/source/library/lux/locale.lux @@ -17,32 +17,30 @@ ["[0]" territory {"+" [Territory]}]]) (abstract: .public Locale - {} - Text - (def: territory_separator "_") - (def: encoding_separator ".") + [(def: territory_separator "_") + (def: encoding_separator ".") - (def: .public (locale language territory encoding) - (-> Language (Maybe Territory) (Maybe Encoding) Locale) - (:abstraction (format (language.code language) - (|> territory - (maybe\each (|>> territory.long_code (format ..territory_separator))) - (maybe.else "")) - (|> encoding - (maybe\each (|>> encoding.name (format ..encoding_separator))) - (maybe.else ""))))) + (def: .public (locale language territory encoding) + (-> Language (Maybe Territory) (Maybe Encoding) Locale) + (:abstraction (format (language.code language) + (|> territory + (maybe\each (|>> territory.long_code (format ..territory_separator))) + (maybe.else "")) + (|> encoding + (maybe\each (|>> encoding.name (format ..encoding_separator))) + (maybe.else ""))))) - (def: .public code - (-> Locale Text) - (|>> :representation)) + (def: .public code + (-> Locale Text) + (|>> :representation)) - (def: .public hash - (Hash Locale) - (\ hash.functor each ..code text.hash)) + (def: .public hash + (Hash Locale) + (\ hash.functor each ..code text.hash)) - (def: .public equivalence - (Equivalence Locale) - (\ ..hash &equivalence)) + (def: .public equivalence + (Equivalence Locale) + (\ ..hash &equivalence))] ) diff --git a/stdlib/source/library/lux/locale/language.lux b/stdlib/source/library/lux/locale/language.lux index e3a48b904..f8314c376 100644 --- a/stdlib/source/library/lux/locale/language.lux +++ b/stdlib/source/library/lux/locale/language.lux @@ -13,564 +13,562 @@ ... https://en.wikipedia.org/wiki/List_of_ISO_639-2_codes (abstract: .public Language - {} - (Record [#name Text #code Text]) - (template [<name> <tag>] - [(def: .public <name> - (-> Language Text) - (|>> :representation (value@ <tag>)))] - - [name #name] - [code #code] - ) - - (template [<bundle>] - [(with_expansions [<bundle>' (template.spliced <bundle>)] - (template [<code> <name> <definition> <alias>+] - [(def: .public <definition> - Language - (:abstraction [#name <name> - #code <code>])) - (`` (template [<alias>] - [(def: .public <alias> - Language - <definition>)] - - (~~ (template.spliced <alias>+))))] - - <bundle>' - ))] - - [[["mis" "uncoded languages" uncoded []] - ["mul" "multiple languages" multiple []] - ["und" "undetermined" undetermined []] - ["zxx" "no linguistic content; not applicable" not_applicable []]]] - - [[["aar" "Afar" afar []] - ["abk" "Abkhazian" abkhazian []] - ["ace" "Achinese" achinese []] - ["ach" "Acoli" acoli []] - ["ada" "Adangme" adangme []] - ["ady" "Adyghe; Adygei" adyghe []] - ["afa" "Afro-Asiatic languages" afro_asiatic []] - ["afh" "Afrihili" afrihili []] - ["afr" "Afrikaans" afrikaans []] - ["ain" "Ainu" ainu []] - ["aka" "Akan" akan []] - ["akk" "Akkadian" akkadian []] - ["ale" "Aleut" aleut []] - ["alg" "Algonquian languages" algonquian []] - ["alt" "Southern Altai" southern_altai []] - ["amh" "Amharic" amharic []] - ["ang" "Old English (ca.450–1100)" old_english []] - ["anp" "Angika" angika []] - ["apa" "Apache languages" apache []] - ["ara" "Arabic" arabic []] - ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official_aramaic [[imperial_aramaic]]] - ["arg" "Aragonese" aragonese []] - ["arn" "Mapudungun; Mapuche" mapudungun []] - ["arp" "Arapaho" arapaho []] - ["art" "Artificial languages" artificial []] - ["arw" "Arawak" arawak []] - ["asm" "Assamese" assamese []] - ["ast" "Asturian; Bable; Leonese; Asturleonese" asturian [[bable] [leonese] [asturleonese]]] - ["ath" "Athapascan languages" athapascan []] - ["aus" "Australian languages" australian []] - ["ava" "Avaric" avaric []] - ["ave" "Avestan" avestan []] - ["awa" "Awadhi" awadhi []] - ["aym" "Aymara" aymara []] - ["aze" "Azerbaijani" azerbaijani []]]] - - [[["bad" "Banda languages" banda []] - ["bai" "Bamileke languages" bamileke []] - ["bak" "Bashkir" bashkir []] - ["bal" "Baluchi" baluchi []] - ["bam" "Bambara" bambara []] - ["ban" "Balinese" balinese []] - ["bas" "Basa" basa []] - ["bat" "Baltic languages" baltic []] - ["bej" "Beja; Bedawiyet" beja []] - ["bel" "Belarusian" belarusian []] - ["bem" "Bemba" bemba []] - ["ben" "Bengali" bengali []] - ["ber" "Berber languages" berber []] - ["bho" "Bhojpuri" bhojpuri []] - ["bih" "Bihari languages" bihari []] - ["bik" "Bikol" bikol []] - ["bin" "Bini; Edo" bini [[edo]]] - ["bis" "Bislama" bislama []] - ["bla" "Siksika" siksika []] - ["bnt" "Bantu languages" bantu []] - ["bod" "Tibetan" tibetan []] - ["bos" "Bosnian" bosnian []] - ["bra" "Braj" braj []] - ["bre" "Breton" breton []] - ["btk" "Batak languages" batak []] - ["bua" "Buriat" buriat []] - ["bug" "Buginese" buginese []] - ["bul" "Bulgarian" bulgarian []] - ["byn" "Blin; Bilin" blin [[bilin]]]]] - - [[["cad" "Caddo" caddo []] - ["cai" "Central American Indian languages" central_american_indian []] - ["car" "Galibi Carib" galibi_carib []] - ["cat" "Catalan; Valencian" catalan [[valencian]]] - ["cau" "Caucasian languages" caucasian []] - ["ceb" "Cebuano" cebuano []] - ["cel" "Celtic languages" celtic []] - ["ces" "Czech" czech []] - ["cha" "Chamorro" chamorro []] - ["chb" "Chibcha" chibcha []] - ["che" "Chechen" chechen []] - ["chg" "Chagatai" chagatai []] - ["chk" "Chuukese" chuukese []] - ["chm" "Mari" mari []] - ["chn" "Chinook jargon" chinook []] - ["cho" "Choctaw" choctaw []] - ["chp" "Chipewyan; Dene Suline" chipewyan []] - ["chr" "Cherokee" cherokee []] - ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church_slavic [[old_slavonic] [church_slavonic] [old_bulgarian] [old_church_slavonic]]] - ["chv" "Chuvash" chuvash []] - ["chy" "Cheyenne" cheyenne []] - ["cmc" "Chamic languages" chamic []] - ["cnr" "Montenegrin" montenegrin []] - ["cop" "Coptic" coptic []] - ["cor" "Cornish" cornish []] - ["cos" "Corsican" corsican []] - ["cpe" "Creoles and pidgins, English based" creoles_and_pidgins/english []] - ["cpf" "Creoles and pidgins, French-based" creoles_and_pidgins/french []] - ["cpp" "Creoles and pidgins, Portuguese-based" creoles_and_pidgins/portuguese []] - ["cre" "Cree" cree []] - ["crh" "Crimean Tatar; Crimean Turkish" crimean []] - ["crp" "Creoles and pidgins" creoles_and_pidgins []] - ["csb" "Kashubian" kashubian []] - ["cus" "Cushitic languages" cushitic []] - ["cym" "Welsh" welsh []]]] - - [[["dak" "Dakota" dakota []] - ["dan" "Danish" danish []] - ["dar" "Dargwa" dargwa []] - ["day" "Land Dayak languages" land_dayak []] - ["del" "Delaware" delaware []] - ["den" "Slave (Athapascan)" slavey []] - ["deu" "German" german []] - ["dgr" "Dogrib" dogrib []] - ["din" "Dinka" dinka []] - ["div" "Divehi; Dhivehi; Maldivian" dhivehi [[maldivian]]] - ["doi" "Dogri" dogri []] - ["dra" "Dravidian languages" dravidian []] - ["dsb" "Lower Sorbian" lower_sorbian []] - ["dua" "Duala" duala []] - ["dum" "Middle Dutch (ca. 1050–1350)" middle_dutch []] - ["dyu" "Dyula" dyula []] - ["dzo" "Dzongkha" dzongkha []]]] - - [[["efi" "Efik" efik []] - ["egy" "Ancient Egyptian" egyptian []] - ["eka" "Ekajuk" ekajuk []] - ["ell" "Modern Greek (1453–)" greek []] - ["elx" "Elamite" elamite []] - ["eng" "English" english []] - ["enm" "Middle English (1100–1500)" middle_english []] - ["epo" "Esperanto" esperanto []] - ["est" "Estonian" estonian []] - ["eus" "Basque" basque []] - ["ewe" "Ewe" ewe []] - ["ewo" "Ewondo" ewondo []]]] - - [[["fan" "Fang" fang []] - ["fao" "Faroese" faroese []] - ["fas" "Persian" persian []] - ["fat" "Fanti" fanti []] - ["fij" "Fijian" fijian []] - ["fil" "Filipino; Pilipino" filipino []] - ["fin" "Finnish" finnish []] - ["fiu" "Finno-Ugrian languages" finno_ugrian []] - ["fon" "Fon" fon []] - ["fra" "French" french []] - ["frm" "Middle French (ca. 1400–1600)" middle_french []] - ["fro" "Old French (ca. 842–1400)" old_french []] - ["frr" "Northern Frisian" northern_frisian []] - ["frs" "Eastern Frisian" eastern_frisian []] - ["fry" "Western Frisian" western_frisian []] - ["ful" "Fulah" fulah []] - ["fur" "Friulian" friulian []]]] - - [[["gaa" "Ga" ga []] - ["gay" "Gayo" gayo []] - ["gba" "Gbaya" gbaya []] - ["gem" "Germanic languages" germanic []] - ["gez" "Geez" geez []] - ["gil" "Gilbertese" gilbertese []] - ["gla" "Gaelic; Scottish Gaelic" gaelic []] - ["gle" "Irish" irish []] - ["glg" "Galician" galician []] - ["glv" "Manx" manx []] - ["gmh" "Middle High German (ca. 1050–1500)" middle_high_german []] - ["goh" "Old High German (ca. 750–1050)" old_high_german []] - ["gon" "Gondi" gondi []] - ["gor" "Gorontalo" gorontalo []] - ["got" "Gothic" gothic []] - ["grb" "Grebo" grebo []] - ["grc" "Ancient Greek (to 1453)" ancient_greek []] - ["grn" "Guarani" guarani []] - ["gsw" "Swiss German; Alemannic; Alsatian" swiss_german [[alemannic] [alsatian]]] - ["guj" "Gujarati" gujarati []] - ["gwi" "Gwich'in" gwich'in []]]] - - [[["hai" "Haida" haida []] - ["hat" "Haitian; Haitian Creole" haitian []] - ["hau" "Hausa" hausa []] - ["haw" "Hawaiian" hawaiian []] - ["heb" "Hebrew" hebrew []] - ["her" "Herero" herero []] - ["hil" "Hiligaynon" hiligaynon []] - ["him" "Himachali languages; Pahari languages" himachali []] - ["hin" "Hindi" hindi []] - ["hit" "Hittite" hittite []] - ["hmn" "Hmong; Mong" hmong []] - ["hmo" "Hiri Motu" hiri_motu []] - ["hrv" "Croatian" croatian []] - ["hsb" "Upper Sorbian" upper_sorbian []] - ["hun" "Hungarian" hungarian []] - ["hup" "Hupa" hupa []] - ["hye" "Armenian" armenian []]]] - - [[["iba" "Iban" iban []] - ["ibo" "Igbo" igbo []] - ["ido" "Ido" ido []] - ["iii" "Sichuan Yi; Nuosu" sichuan_yi [[nuosu]]] - ["ijo" "Ijo languages" ijo []] - ["iku" "Inuktitut" inuktitut []] - ["ile" "Interlingue; Occidental" interlingue []] - ["ilo" "Iloko" iloko []] - ["ina" "Interlingua (International Auxiliary Language Association)" interlingua []] - ["inc" "Indic languages" indic []] - ["ind" "Indonesian" indonesian []] - ["ine" "Indo-European languages" indo_european []] - ["inh" "Ingush" ingush []] - ["ipk" "Inupiaq" inupiaq []] - ["ira" "Iranian languages" iranian []] - ["iro" "Iroquoian languages" iroquoian []] - ["isl" "Icelandic" icelandic []] - ["ita" "Italian" italian []]]] - - [[["jav" "Javanese" javanese []] - ["jbo" "Lojban" lojban []] - ["jpn" "Japanese" japanese []] - ["jpr" "Judeo-Persian" judeo_persian []] - ["jrb" "Judeo-Arabic" judeo_arabic []]]] - - [[["kaa" "Kara-Kalpak" kara_kalpak []] - ["kab" "Kabyle" kabyle []] - ["kac" "Kachin; Jingpho" kachin [[jingpho]]] - ["kal" "Kalaallisut; Greenlandic" kalaallisut [[greenlandic]]] - ["kam" "Kamba" kamba []] - ["kan" "Kannada" kannada []] - ["kar" "Karen languages" karen []] - ["kas" "Kashmiri" kashmiri []] - ["kat" "Georgian" georgian []] - ["kau" "Kanuri" kanuri []] - ["kaw" "Kawi" kawi []] - ["kaz" "Kazakh" kazakh []] - ["kbd" "Kabardian" kabardian []] - ["kha" "Khasi" khasi []] - ["khi" "Khoisan languages" khoisan []] - ["khm" "Central Khmer" central_khmer []] - ["kho" "Khotanese; Sakan" khotanese [[sakan]]] - ["kik" "Kikuyu; Gikuyu" gikuyu []] - ["kin" "Kinyarwanda" kinyarwanda []] - ["kir" "Kirghiz; Kyrgyz" kyrgyz []] - ["kmb" "Kimbundu" kimbundu []] - ["kok" "Konkani" konkani []] - ["kom" "Komi" komi []] - ["kon" "Kongo" kongo []] - ["kor" "Korean" korean []] - ["kos" "Kosraean" kosraean []] - ["kpe" "Kpelle" kpelle []] - ["krc" "Karachay-Balkar" karachay_balkar []] - ["krl" "Karelian" karelian []] - ["kro" "Kru languages" kru []] - ["kru" "Kurukh" kurukh []] - ["kua" "Kuanyama; Kwanyama" kwanyama []] - ["kum" "Kumyk" kumyk []] - ["kur" "Kurdish" kurdish []] - ["kut" "Kutenai" kutenai []]]] - - [[["lad" "Ladino" ladino []] - ["lah" "Lahnda" lahnda []] - ["lam" "Lamba" lamba []] - ["lao" "Lao" lao []] - ["lat" "Latin" latin []] - ["lav" "Latvian" latvian []] - ["lez" "Lezghian" lezghian []] - ["lim" "Limburgan; Limburger; Limburgish" limburgan []] - ["lin" "Lingala" lingala []] - ["lit" "Lithuanian" lithuanian []] - ["lol" "Mongo" mongo []] - ["loz" "Lozi" lozi []] - ["ltz" "Luxembourgish; Letzeburgesch" luxembourgish []] - ["lua" "Luba-Lulua" luba_lulua []] - ["lub" "Luba-Katanga" luba_katanga []] - ["lug" "Ganda" ganda []] - ["lui" "Luiseno" luiseno []] - ["lun" "Lunda" lunda []] - ["luo" "Luo (Kenya and Tanzania)" luo []] - ["lus" "Lushai" lushai []]]] - - [[["mad" "Madurese" madurese []] - ["mag" "Magahi" magahi []] - ["mah" "Marshallese" marshallese []] - ["mai" "Maithili" maithili []] - ["mak" "Makasar" makasar []] - ["mal" "Malayalam" malayalam []] - ["man" "Mandingo" mandingo []] - ["map" "Austronesian languages" austronesian []] - ["mar" "Marathi" marathi []] - ["mas" "Masai" masai []] - ["mdf" "Moksha" moksha []] - ["mdr" "Mandar" mandar []] - ["men" "Mende" mende []] - ["mga" "Middle Irish (900–1200)" middle_irish []] - ["mic" "Mi'kmaq; Micmac" mi'kmaq [[micmac]]] - ["min" "Minangkabau" minangkabau []] - ["mkd" "Macedonian" macedonian []] - ["mkh" "Mon-Khmer languages" mon_khmer []] - ["mlg" "Malagasy" malagasy []] - ["mlt" "Maltese" maltese []] - ["mnc" "Manchu" manchu []] - ["mni" "Manipuri" manipuri []] - ["mno" "Manobo languages" manobo []] - ["moh" "Mohawk" mohawk []] - ["mon" "Mongolian" mongolian []] - ["mos" "Mossi" mossi []] - ["mri" "Maori" maori []] - ["msa" "Malay" malay []] - ["mun" "Munda languages" munda []] - ["mus" "Creek" creek []] - ["mwl" "Mirandese" mirandese []] - ["mwr" "Marwari" marwari []] - ["mya" "Burmese" burmese []] - ["myn" "Mayan languages" mayan []] - ["myv" "Erzya" erzya []]]] - - [[["nah" "Nahuatl languages" nahuatl []] - ["nai" "North American Indian languages" north_american_indian []] - ["nap" "Neapolitan" neapolitan []] - ["nau" "Nauru" nauru []] - ["nav" "Navajo; Navaho" navajo []] - ["nbl" "South Ndebele" south_ndebele []] - ["nde" "North Ndebele" north_ndebele []] - ["ndo" "Ndonga" ndonga []] - ["nds" "Low German; Low Saxon" low_german []] - ["nep" "Nepali" nepali []] - ["new" "Nepal Bhasa; Newari" newari [[nepal_bhasa]]] - ["nia" "Nias" nias []] - ["nic" "Niger-Kordofanian languages" niger_kordofanian []] - ["niu" "Niuean" niuean []] - ["nld" "Dutch; Flemish" dutch [[flemish]]] - ["nno" "Norwegian Nynorsk" nynorsk []] - ["nob" "Norwegian Bokmål" bokmal []] - ["nog" "Nogai" nogai []] - ["non" "Old Norse" old_norse []] - ["nor" "Norwegian" norwegian []] - ["nqo" "N'Ko" n'ko []] - ["nso" "Pedi; Sepedi; Northern Sotho" northern_sotho [[pedi] [sepedi]]] - ["nub" "Nubian languages" nubian []] - ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old_newari [[classical_newari] [classical_nepal_bhasa]]] - ["nya" "Chichewa; Chewa; Nyanja" nyanja [[chichewa] [chewa]]] - ["nym" "Nyamwezi" nyamwezi []] - ["nyn" "Nyankole" nyankole []] - ["nyo" "Nyoro" nyoro []] - ["nzi" "Nzima" nzima []]]] - - [[["oci" "Occitan (post 1500); Provençal" occitan [[provencal]]] - ["oji" "Ojibwa" ojibwa []] - ["ori" "Oriya" oriya []] - ["orm" "Oromo" oromo []] - ["osa" "Osage" osage []] - ["oss" "Ossetian; Ossetic" ossetic []] - ["ota" "Ottoman Turkish (1500–1928)" ottoman_turkish []] - ["oto" "Otomian languages" otomian []]]] - - [[["paa" "Papuan languages" papuan []] - ["pag" "Pangasinan" pangasinan []] - ["pal" "Pahlavi" pahlavi []] - ["pam" "Pampanga; Kapampangan" pampanga [[kapampangan]]] - ["pan" "Panjabi; Punjabi" punjabi []] - ["pap" "Papiamento" papiamento []] - ["pau" "Palauan" palauan []] - ["peo" "Old Persian (ca. 600–400 B.C.)" old_persian []] - ["phi" "Philippine languages" philippine []] - ["phn" "Phoenician" phoenician []] - ["pli" "Pali" pali []] - ["pol" "Polish" polish []] - ["pon" "Pohnpeian" pohnpeian []] - ["por" "Portuguese" portuguese []] - ["pra" "Prakrit languages" prakrit []] - ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old_provencal []] - ["pus" "Pushto; Pashto" pashto []]]] - - [[["que" "Quechua" quechua []]]] - - [[["raj" "Rajasthani" rajasthani []] - ["rap" "Rapanui" rapanui []] - ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook_islands_maori]]] - ["roa" "Romance languages" romance []] - ["roh" "Romansh" romansh []] - ["rom" "Romany" romany []] - ["ron" "Romanian; Moldavian; Moldovan" romanian [[moldavian] [moldovan]]] - ["run" "Rundi" rundi []] - ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo_romanian]]] - ["rus" "Russian" russian []]]] - - [[["sad" "Sandawe" sandawe []] - ["sag" "Sango" sango []] - ["sah" "Yakut" yakut []] - ["sai" "South American Indian (Other)" south_american_indian []] - ["sal" "Salishan languages" salishan []] - ["sam" "Samaritan Aramaic" samaritan_aramaic []] - ["san" "Sanskrit" sanskrit []] - ["sas" "Sasak" sasak []] - ["sat" "Santali" santali []] - ["scn" "Sicilian" sicilian []] - ["sco" "Scots" scots []] - ["sel" "Selkup" selkup []] - ["sem" "Semitic languages" semitic []] - ["sga" "Old Irish (to 900)" old_irish []] - ["sgn" "Sign Languages" sign []] - ["shn" "Shan" shan []] - ["sid" "Sidamo" sidamo []] - ["sin" "Sinhala; Sinhalese" sinhalese []] - ["sio" "Siouan languages" siouan []] - ["sit" "Sino-Tibetan languages" sino_tibetan []] - ["sla" "Slavic languages" slavic []] - ["slk" "Slovak" slovak []] - ["slv" "Slovenian" slovenian []] - ["sma" "Southern Sami" southern_sami []] - ["sme" "Northern Sami" northern_sami []] - ["smi" "Sami languages" sami []] - ["smj" "Lule Sami" lule []] - ["smn" "Inari Sami" inari []] - ["smo" "Samoan" samoan []] - ["sms" "Skolt Sami" skolt_sami []] - ["sna" "Shona" shona []] - ["snd" "Sindhi" sindhi []] - ["snk" "Soninke" soninke []] - ["sog" "Sogdian" sogdian []] - ["som" "Somali" somali []] - ["son" "Songhai languages" songhai []] - ["sot" "Southern Sotho" southern_sotho []] - ["spa" "Spanish; Castilian" spanish [[castilian]]] - ["sqi" "Albanian" albanian []] - ["srd" "Sardinian" sardinian []] - ["srn" "Sranan Tongo" sranan_tongo []] - ["srp" "Serbian" serbian []] - ["srr" "Serer" serer []] - ["ssa" "Nilo-Saharan languages" nilo_saharan []] - ["ssw" "Swati" swati []] - ["suk" "Sukuma" sukuma []] - ["sun" "Sundanese" sundanese []] - ["sus" "Susu" susu []] - ["sux" "Sumerian" sumerian []] - ["swa" "Swahili" swahili []] - ["swe" "Swedish" swedish []] - ["syc" "Classical Syriac" classical_syriac []] - ["syr" "Syriac" syriac []]]] - - [[["tah" "Tahitian" tahitian []] - ["tai" "Tai languages" tai []] - ["tam" "Tamil" tamil []] - ["tat" "Tatar" tatar []] - ["tel" "Telugu" telugu []] - ["tem" "Timne" timne []] - ["ter" "Tereno" tereno []] - ["tet" "Tetum" tetum []] - ["tgk" "Tajik" tajik []] - ["tgl" "Tagalog" tagalog []] - ["tha" "Thai" thai []] - ["tig" "Tigre" tigre []] - ["tir" "Tigrinya" tigrinya []] - ["tiv" "Tiv" tiv []] - ["tkl" "Tokelau" tokelau []] - ["tlh" "Klingon; tlhIngan-Hol" klingon []] - ["tli" "Tlingit" tlingit []] - ["tmh" "Tamashek" tamashek []] - ["tog" "Tonga (Nyasa)" tonga []] - ["ton" "Tonga (Tonga Islands)" tongan []] - ["tpi" "Tok Pisin" tok_pisin []] - ["tsi" "Tsimshian" tsimshian []] - ["tsn" "Tswana" tswana []] - ["tso" "Tsonga" tsonga []] - ["tuk" "Turkmen" turkmen []] - ["tum" "Tumbuka" tumbuka []] - ["tup" "Tupi languages" tupi []] - ["tur" "Turkish" turkish []] - ["tut" "Altaic languages" altaic []] - ["tvl" "Tuvalu" tuvalu []] - ["twi" "Twi" twi []] - ["tyv" "Tuvinian" tuvinian []]]] - - [[["udm" "Udmurt" udmurt []] - ["uga" "Ugaritic" ugaritic []] - ["uig" "Uighur; Uyghur" uyghur []] - ["ukr" "Ukrainian" ukrainian []] - ["umb" "Umbundu" umbundu []] - ["urd" "Urdu" urdu []] - ["uzb" "Uzbek" uzbek []]]] - - [[["vai" "Vai" vai []] - ["ven" "Venda" venda []] - ["vie" "Vietnamese" vietnamese []] - ["vol" "Volapük" volapük []] - ["vot" "Votic" votic []]]] - - [[["wak" "Wakashan languages" wakashan []] - ["wal" "Wolaitta; Wolaytta" walamo []] - ["war" "Waray" waray []] - ["was" "Washo" washo []] - ["wen" "Sorbian languages" sorbian []] - ["wln" "Walloon" walloon []] - ["wol" "Wolof" wolof []]]] - - [[["xal" "Kalmyk; Oirat" kalmyk [[oirat]]] - ["xho" "Xhosa" xhosa []]]] - - [[["yao" "Yao" yao []] - ["yap" "Yapese" yapese []] - ["yid" "Yiddish" yiddish []] - ["yor" "Yoruba" yoruba []] - ["ypk" "Yupik languages" yupik []]]] - - [[["zap" "Zapotec" zapotec []] - ["zbl" "Blissymbols; Blissymbolics; Bliss" blissymbols []] - ["zen" "Zenaga" zenaga []] - ["zgh" "Standard Moroccan Tamazight" standard_moroccan_tamazight []] - ["zha" "Zhuang; Chuang" zhuang []] - ["zho" "Chinese" chinese []] - ["znd" "Zande languages" zande []] - ["zul" "Zulu" zulu []] - ["zun" "Zuni" zuni []] - ["zza" "Zaza; Dimili; Dimli; Kirdki; Kirmanjki; Zazaki" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]]]]) - - (implementation: .public equivalence - (Equivalence Language) - - (def: (= reference sample) - (same? reference sample))) - - (implementation: .public hash - (Hash Language) - - (def: &equivalence - ..equivalence) - - (def: hash - (|>> ..code - (\ text.hash hash)))) + [(template [<name> <tag>] + [(def: .public <name> + (-> Language Text) + (|>> :representation (value@ <tag>)))] + + [name #name] + [code #code] + ) + + (template [<bundle>] + [(with_expansions [<bundle>' (template.spliced <bundle>)] + (template [<code> <name> <definition> <alias>+] + [(def: .public <definition> + Language + (:abstraction [#name <name> + #code <code>])) + (`` (template [<alias>] + [(def: .public <alias> + Language + <definition>)] + + (~~ (template.spliced <alias>+))))] + + <bundle>' + ))] + + [[["mis" "uncoded languages" uncoded []] + ["mul" "multiple languages" multiple []] + ["und" "undetermined" undetermined []] + ["zxx" "no linguistic content; not applicable" not_applicable []]]] + + [[["aar" "Afar" afar []] + ["abk" "Abkhazian" abkhazian []] + ["ace" "Achinese" achinese []] + ["ach" "Acoli" acoli []] + ["ada" "Adangme" adangme []] + ["ady" "Adyghe; Adygei" adyghe []] + ["afa" "Afro-Asiatic languages" afro_asiatic []] + ["afh" "Afrihili" afrihili []] + ["afr" "Afrikaans" afrikaans []] + ["ain" "Ainu" ainu []] + ["aka" "Akan" akan []] + ["akk" "Akkadian" akkadian []] + ["ale" "Aleut" aleut []] + ["alg" "Algonquian languages" algonquian []] + ["alt" "Southern Altai" southern_altai []] + ["amh" "Amharic" amharic []] + ["ang" "Old English (ca.450–1100)" old_english []] + ["anp" "Angika" angika []] + ["apa" "Apache languages" apache []] + ["ara" "Arabic" arabic []] + ["arc" "Official Aramaic (700–300 BCE); Imperial Aramaic (700–300 BCE)" official_aramaic [[imperial_aramaic]]] + ["arg" "Aragonese" aragonese []] + ["arn" "Mapudungun; Mapuche" mapudungun []] + ["arp" "Arapaho" arapaho []] + ["art" "Artificial languages" artificial []] + ["arw" "Arawak" arawak []] + ["asm" "Assamese" assamese []] + ["ast" "Asturian; Bable; Leonese; Asturleonese" asturian [[bable] [leonese] [asturleonese]]] + ["ath" "Athapascan languages" athapascan []] + ["aus" "Australian languages" australian []] + ["ava" "Avaric" avaric []] + ["ave" "Avestan" avestan []] + ["awa" "Awadhi" awadhi []] + ["aym" "Aymara" aymara []] + ["aze" "Azerbaijani" azerbaijani []]]] + + [[["bad" "Banda languages" banda []] + ["bai" "Bamileke languages" bamileke []] + ["bak" "Bashkir" bashkir []] + ["bal" "Baluchi" baluchi []] + ["bam" "Bambara" bambara []] + ["ban" "Balinese" balinese []] + ["bas" "Basa" basa []] + ["bat" "Baltic languages" baltic []] + ["bej" "Beja; Bedawiyet" beja []] + ["bel" "Belarusian" belarusian []] + ["bem" "Bemba" bemba []] + ["ben" "Bengali" bengali []] + ["ber" "Berber languages" berber []] + ["bho" "Bhojpuri" bhojpuri []] + ["bih" "Bihari languages" bihari []] + ["bik" "Bikol" bikol []] + ["bin" "Bini; Edo" bini [[edo]]] + ["bis" "Bislama" bislama []] + ["bla" "Siksika" siksika []] + ["bnt" "Bantu languages" bantu []] + ["bod" "Tibetan" tibetan []] + ["bos" "Bosnian" bosnian []] + ["bra" "Braj" braj []] + ["bre" "Breton" breton []] + ["btk" "Batak languages" batak []] + ["bua" "Buriat" buriat []] + ["bug" "Buginese" buginese []] + ["bul" "Bulgarian" bulgarian []] + ["byn" "Blin; Bilin" blin [[bilin]]]]] + + [[["cad" "Caddo" caddo []] + ["cai" "Central American Indian languages" central_american_indian []] + ["car" "Galibi Carib" galibi_carib []] + ["cat" "Catalan; Valencian" catalan [[valencian]]] + ["cau" "Caucasian languages" caucasian []] + ["ceb" "Cebuano" cebuano []] + ["cel" "Celtic languages" celtic []] + ["ces" "Czech" czech []] + ["cha" "Chamorro" chamorro []] + ["chb" "Chibcha" chibcha []] + ["che" "Chechen" chechen []] + ["chg" "Chagatai" chagatai []] + ["chk" "Chuukese" chuukese []] + ["chm" "Mari" mari []] + ["chn" "Chinook jargon" chinook []] + ["cho" "Choctaw" choctaw []] + ["chp" "Chipewyan; Dene Suline" chipewyan []] + ["chr" "Cherokee" cherokee []] + ["chu" "Church Slavic; Old Slavonic; Church Slavonic; Old Bulgarian; Old Church Slavonic" church_slavic [[old_slavonic] [church_slavonic] [old_bulgarian] [old_church_slavonic]]] + ["chv" "Chuvash" chuvash []] + ["chy" "Cheyenne" cheyenne []] + ["cmc" "Chamic languages" chamic []] + ["cnr" "Montenegrin" montenegrin []] + ["cop" "Coptic" coptic []] + ["cor" "Cornish" cornish []] + ["cos" "Corsican" corsican []] + ["cpe" "Creoles and pidgins, English based" creoles_and_pidgins/english []] + ["cpf" "Creoles and pidgins, French-based" creoles_and_pidgins/french []] + ["cpp" "Creoles and pidgins, Portuguese-based" creoles_and_pidgins/portuguese []] + ["cre" "Cree" cree []] + ["crh" "Crimean Tatar; Crimean Turkish" crimean []] + ["crp" "Creoles and pidgins" creoles_and_pidgins []] + ["csb" "Kashubian" kashubian []] + ["cus" "Cushitic languages" cushitic []] + ["cym" "Welsh" welsh []]]] + + [[["dak" "Dakota" dakota []] + ["dan" "Danish" danish []] + ["dar" "Dargwa" dargwa []] + ["day" "Land Dayak languages" land_dayak []] + ["del" "Delaware" delaware []] + ["den" "Slave (Athapascan)" slavey []] + ["deu" "German" german []] + ["dgr" "Dogrib" dogrib []] + ["din" "Dinka" dinka []] + ["div" "Divehi; Dhivehi; Maldivian" dhivehi [[maldivian]]] + ["doi" "Dogri" dogri []] + ["dra" "Dravidian languages" dravidian []] + ["dsb" "Lower Sorbian" lower_sorbian []] + ["dua" "Duala" duala []] + ["dum" "Middle Dutch (ca. 1050–1350)" middle_dutch []] + ["dyu" "Dyula" dyula []] + ["dzo" "Dzongkha" dzongkha []]]] + + [[["efi" "Efik" efik []] + ["egy" "Ancient Egyptian" egyptian []] + ["eka" "Ekajuk" ekajuk []] + ["ell" "Modern Greek (1453–)" greek []] + ["elx" "Elamite" elamite []] + ["eng" "English" english []] + ["enm" "Middle English (1100–1500)" middle_english []] + ["epo" "Esperanto" esperanto []] + ["est" "Estonian" estonian []] + ["eus" "Basque" basque []] + ["ewe" "Ewe" ewe []] + ["ewo" "Ewondo" ewondo []]]] + + [[["fan" "Fang" fang []] + ["fao" "Faroese" faroese []] + ["fas" "Persian" persian []] + ["fat" "Fanti" fanti []] + ["fij" "Fijian" fijian []] + ["fil" "Filipino; Pilipino" filipino []] + ["fin" "Finnish" finnish []] + ["fiu" "Finno-Ugrian languages" finno_ugrian []] + ["fon" "Fon" fon []] + ["fra" "French" french []] + ["frm" "Middle French (ca. 1400–1600)" middle_french []] + ["fro" "Old French (ca. 842–1400)" old_french []] + ["frr" "Northern Frisian" northern_frisian []] + ["frs" "Eastern Frisian" eastern_frisian []] + ["fry" "Western Frisian" western_frisian []] + ["ful" "Fulah" fulah []] + ["fur" "Friulian" friulian []]]] + + [[["gaa" "Ga" ga []] + ["gay" "Gayo" gayo []] + ["gba" "Gbaya" gbaya []] + ["gem" "Germanic languages" germanic []] + ["gez" "Geez" geez []] + ["gil" "Gilbertese" gilbertese []] + ["gla" "Gaelic; Scottish Gaelic" gaelic []] + ["gle" "Irish" irish []] + ["glg" "Galician" galician []] + ["glv" "Manx" manx []] + ["gmh" "Middle High German (ca. 1050–1500)" middle_high_german []] + ["goh" "Old High German (ca. 750–1050)" old_high_german []] + ["gon" "Gondi" gondi []] + ["gor" "Gorontalo" gorontalo []] + ["got" "Gothic" gothic []] + ["grb" "Grebo" grebo []] + ["grc" "Ancient Greek (to 1453)" ancient_greek []] + ["grn" "Guarani" guarani []] + ["gsw" "Swiss German; Alemannic; Alsatian" swiss_german [[alemannic] [alsatian]]] + ["guj" "Gujarati" gujarati []] + ["gwi" "Gwich'in" gwich'in []]]] + + [[["hai" "Haida" haida []] + ["hat" "Haitian; Haitian Creole" haitian []] + ["hau" "Hausa" hausa []] + ["haw" "Hawaiian" hawaiian []] + ["heb" "Hebrew" hebrew []] + ["her" "Herero" herero []] + ["hil" "Hiligaynon" hiligaynon []] + ["him" "Himachali languages; Pahari languages" himachali []] + ["hin" "Hindi" hindi []] + ["hit" "Hittite" hittite []] + ["hmn" "Hmong; Mong" hmong []] + ["hmo" "Hiri Motu" hiri_motu []] + ["hrv" "Croatian" croatian []] + ["hsb" "Upper Sorbian" upper_sorbian []] + ["hun" "Hungarian" hungarian []] + ["hup" "Hupa" hupa []] + ["hye" "Armenian" armenian []]]] + + [[["iba" "Iban" iban []] + ["ibo" "Igbo" igbo []] + ["ido" "Ido" ido []] + ["iii" "Sichuan Yi; Nuosu" sichuan_yi [[nuosu]]] + ["ijo" "Ijo languages" ijo []] + ["iku" "Inuktitut" inuktitut []] + ["ile" "Interlingue; Occidental" interlingue []] + ["ilo" "Iloko" iloko []] + ["ina" "Interlingua (International Auxiliary Language Association)" interlingua []] + ["inc" "Indic languages" indic []] + ["ind" "Indonesian" indonesian []] + ["ine" "Indo-European languages" indo_european []] + ["inh" "Ingush" ingush []] + ["ipk" "Inupiaq" inupiaq []] + ["ira" "Iranian languages" iranian []] + ["iro" "Iroquoian languages" iroquoian []] + ["isl" "Icelandic" icelandic []] + ["ita" "Italian" italian []]]] + + [[["jav" "Javanese" javanese []] + ["jbo" "Lojban" lojban []] + ["jpn" "Japanese" japanese []] + ["jpr" "Judeo-Persian" judeo_persian []] + ["jrb" "Judeo-Arabic" judeo_arabic []]]] + + [[["kaa" "Kara-Kalpak" kara_kalpak []] + ["kab" "Kabyle" kabyle []] + ["kac" "Kachin; Jingpho" kachin [[jingpho]]] + ["kal" "Kalaallisut; Greenlandic" kalaallisut [[greenlandic]]] + ["kam" "Kamba" kamba []] + ["kan" "Kannada" kannada []] + ["kar" "Karen languages" karen []] + ["kas" "Kashmiri" kashmiri []] + ["kat" "Georgian" georgian []] + ["kau" "Kanuri" kanuri []] + ["kaw" "Kawi" kawi []] + ["kaz" "Kazakh" kazakh []] + ["kbd" "Kabardian" kabardian []] + ["kha" "Khasi" khasi []] + ["khi" "Khoisan languages" khoisan []] + ["khm" "Central Khmer" central_khmer []] + ["kho" "Khotanese; Sakan" khotanese [[sakan]]] + ["kik" "Kikuyu; Gikuyu" gikuyu []] + ["kin" "Kinyarwanda" kinyarwanda []] + ["kir" "Kirghiz; Kyrgyz" kyrgyz []] + ["kmb" "Kimbundu" kimbundu []] + ["kok" "Konkani" konkani []] + ["kom" "Komi" komi []] + ["kon" "Kongo" kongo []] + ["kor" "Korean" korean []] + ["kos" "Kosraean" kosraean []] + ["kpe" "Kpelle" kpelle []] + ["krc" "Karachay-Balkar" karachay_balkar []] + ["krl" "Karelian" karelian []] + ["kro" "Kru languages" kru []] + ["kru" "Kurukh" kurukh []] + ["kua" "Kuanyama; Kwanyama" kwanyama []] + ["kum" "Kumyk" kumyk []] + ["kur" "Kurdish" kurdish []] + ["kut" "Kutenai" kutenai []]]] + + [[["lad" "Ladino" ladino []] + ["lah" "Lahnda" lahnda []] + ["lam" "Lamba" lamba []] + ["lao" "Lao" lao []] + ["lat" "Latin" latin []] + ["lav" "Latvian" latvian []] + ["lez" "Lezghian" lezghian []] + ["lim" "Limburgan; Limburger; Limburgish" limburgan []] + ["lin" "Lingala" lingala []] + ["lit" "Lithuanian" lithuanian []] + ["lol" "Mongo" mongo []] + ["loz" "Lozi" lozi []] + ["ltz" "Luxembourgish; Letzeburgesch" luxembourgish []] + ["lua" "Luba-Lulua" luba_lulua []] + ["lub" "Luba-Katanga" luba_katanga []] + ["lug" "Ganda" ganda []] + ["lui" "Luiseno" luiseno []] + ["lun" "Lunda" lunda []] + ["luo" "Luo (Kenya and Tanzania)" luo []] + ["lus" "Lushai" lushai []]]] + + [[["mad" "Madurese" madurese []] + ["mag" "Magahi" magahi []] + ["mah" "Marshallese" marshallese []] + ["mai" "Maithili" maithili []] + ["mak" "Makasar" makasar []] + ["mal" "Malayalam" malayalam []] + ["man" "Mandingo" mandingo []] + ["map" "Austronesian languages" austronesian []] + ["mar" "Marathi" marathi []] + ["mas" "Masai" masai []] + ["mdf" "Moksha" moksha []] + ["mdr" "Mandar" mandar []] + ["men" "Mende" mende []] + ["mga" "Middle Irish (900–1200)" middle_irish []] + ["mic" "Mi'kmaq; Micmac" mi'kmaq [[micmac]]] + ["min" "Minangkabau" minangkabau []] + ["mkd" "Macedonian" macedonian []] + ["mkh" "Mon-Khmer languages" mon_khmer []] + ["mlg" "Malagasy" malagasy []] + ["mlt" "Maltese" maltese []] + ["mnc" "Manchu" manchu []] + ["mni" "Manipuri" manipuri []] + ["mno" "Manobo languages" manobo []] + ["moh" "Mohawk" mohawk []] + ["mon" "Mongolian" mongolian []] + ["mos" "Mossi" mossi []] + ["mri" "Maori" maori []] + ["msa" "Malay" malay []] + ["mun" "Munda languages" munda []] + ["mus" "Creek" creek []] + ["mwl" "Mirandese" mirandese []] + ["mwr" "Marwari" marwari []] + ["mya" "Burmese" burmese []] + ["myn" "Mayan languages" mayan []] + ["myv" "Erzya" erzya []]]] + + [[["nah" "Nahuatl languages" nahuatl []] + ["nai" "North American Indian languages" north_american_indian []] + ["nap" "Neapolitan" neapolitan []] + ["nau" "Nauru" nauru []] + ["nav" "Navajo; Navaho" navajo []] + ["nbl" "South Ndebele" south_ndebele []] + ["nde" "North Ndebele" north_ndebele []] + ["ndo" "Ndonga" ndonga []] + ["nds" "Low German; Low Saxon" low_german []] + ["nep" "Nepali" nepali []] + ["new" "Nepal Bhasa; Newari" newari [[nepal_bhasa]]] + ["nia" "Nias" nias []] + ["nic" "Niger-Kordofanian languages" niger_kordofanian []] + ["niu" "Niuean" niuean []] + ["nld" "Dutch; Flemish" dutch [[flemish]]] + ["nno" "Norwegian Nynorsk" nynorsk []] + ["nob" "Norwegian Bokmål" bokmal []] + ["nog" "Nogai" nogai []] + ["non" "Old Norse" old_norse []] + ["nor" "Norwegian" norwegian []] + ["nqo" "N'Ko" n'ko []] + ["nso" "Pedi; Sepedi; Northern Sotho" northern_sotho [[pedi] [sepedi]]] + ["nub" "Nubian languages" nubian []] + ["nwc" "Classical Newari; Old Newari; Classical Nepal Bhasa" old_newari [[classical_newari] [classical_nepal_bhasa]]] + ["nya" "Chichewa; Chewa; Nyanja" nyanja [[chichewa] [chewa]]] + ["nym" "Nyamwezi" nyamwezi []] + ["nyn" "Nyankole" nyankole []] + ["nyo" "Nyoro" nyoro []] + ["nzi" "Nzima" nzima []]]] + + [[["oci" "Occitan (post 1500); Provençal" occitan [[provencal]]] + ["oji" "Ojibwa" ojibwa []] + ["ori" "Oriya" oriya []] + ["orm" "Oromo" oromo []] + ["osa" "Osage" osage []] + ["oss" "Ossetian; Ossetic" ossetic []] + ["ota" "Ottoman Turkish (1500–1928)" ottoman_turkish []] + ["oto" "Otomian languages" otomian []]]] + + [[["paa" "Papuan languages" papuan []] + ["pag" "Pangasinan" pangasinan []] + ["pal" "Pahlavi" pahlavi []] + ["pam" "Pampanga; Kapampangan" pampanga [[kapampangan]]] + ["pan" "Panjabi; Punjabi" punjabi []] + ["pap" "Papiamento" papiamento []] + ["pau" "Palauan" palauan []] + ["peo" "Old Persian (ca. 600–400 B.C.)" old_persian []] + ["phi" "Philippine languages" philippine []] + ["phn" "Phoenician" phoenician []] + ["pli" "Pali" pali []] + ["pol" "Polish" polish []] + ["pon" "Pohnpeian" pohnpeian []] + ["por" "Portuguese" portuguese []] + ["pra" "Prakrit languages" prakrit []] + ["pro" "Old Provençal (to 1500); Old Occitan (to 1500)" old_provencal []] + ["pus" "Pushto; Pashto" pashto []]]] + + [[["que" "Quechua" quechua []]]] + + [[["raj" "Rajasthani" rajasthani []] + ["rap" "Rapanui" rapanui []] + ["rar" "Rarotongan; Cook Islands Maori" rarotongan [[cook_islands_maori]]] + ["roa" "Romance languages" romance []] + ["roh" "Romansh" romansh []] + ["rom" "Romany" romany []] + ["ron" "Romanian; Moldavian; Moldovan" romanian [[moldavian] [moldovan]]] + ["run" "Rundi" rundi []] + ["rup" "Aromanian; Arumanian; Macedo-Romanian" aromanian [[arumanian] [macedo_romanian]]] + ["rus" "Russian" russian []]]] + + [[["sad" "Sandawe" sandawe []] + ["sag" "Sango" sango []] + ["sah" "Yakut" yakut []] + ["sai" "South American Indian (Other)" south_american_indian []] + ["sal" "Salishan languages" salishan []] + ["sam" "Samaritan Aramaic" samaritan_aramaic []] + ["san" "Sanskrit" sanskrit []] + ["sas" "Sasak" sasak []] + ["sat" "Santali" santali []] + ["scn" "Sicilian" sicilian []] + ["sco" "Scots" scots []] + ["sel" "Selkup" selkup []] + ["sem" "Semitic languages" semitic []] + ["sga" "Old Irish (to 900)" old_irish []] + ["sgn" "Sign Languages" sign []] + ["shn" "Shan" shan []] + ["sid" "Sidamo" sidamo []] + ["sin" "Sinhala; Sinhalese" sinhalese []] + ["sio" "Siouan languages" siouan []] + ["sit" "Sino-Tibetan languages" sino_tibetan []] + ["sla" "Slavic languages" slavic []] + ["slk" "Slovak" slovak []] + ["slv" "Slovenian" slovenian []] + ["sma" "Southern Sami" southern_sami []] + ["sme" "Northern Sami" northern_sami []] + ["smi" "Sami languages" sami []] + ["smj" "Lule Sami" lule []] + ["smn" "Inari Sami" inari []] + ["smo" "Samoan" samoan []] + ["sms" "Skolt Sami" skolt_sami []] + ["sna" "Shona" shona []] + ["snd" "Sindhi" sindhi []] + ["snk" "Soninke" soninke []] + ["sog" "Sogdian" sogdian []] + ["som" "Somali" somali []] + ["son" "Songhai languages" songhai []] + ["sot" "Southern Sotho" southern_sotho []] + ["spa" "Spanish; Castilian" spanish [[castilian]]] + ["sqi" "Albanian" albanian []] + ["srd" "Sardinian" sardinian []] + ["srn" "Sranan Tongo" sranan_tongo []] + ["srp" "Serbian" serbian []] + ["srr" "Serer" serer []] + ["ssa" "Nilo-Saharan languages" nilo_saharan []] + ["ssw" "Swati" swati []] + ["suk" "Sukuma" sukuma []] + ["sun" "Sundanese" sundanese []] + ["sus" "Susu" susu []] + ["sux" "Sumerian" sumerian []] + ["swa" "Swahili" swahili []] + ["swe" "Swedish" swedish []] + ["syc" "Classical Syriac" classical_syriac []] + ["syr" "Syriac" syriac []]]] + + [[["tah" "Tahitian" tahitian []] + ["tai" "Tai languages" tai []] + ["tam" "Tamil" tamil []] + ["tat" "Tatar" tatar []] + ["tel" "Telugu" telugu []] + ["tem" "Timne" timne []] + ["ter" "Tereno" tereno []] + ["tet" "Tetum" tetum []] + ["tgk" "Tajik" tajik []] + ["tgl" "Tagalog" tagalog []] + ["tha" "Thai" thai []] + ["tig" "Tigre" tigre []] + ["tir" "Tigrinya" tigrinya []] + ["tiv" "Tiv" tiv []] + ["tkl" "Tokelau" tokelau []] + ["tlh" "Klingon; tlhIngan-Hol" klingon []] + ["tli" "Tlingit" tlingit []] + ["tmh" "Tamashek" tamashek []] + ["tog" "Tonga (Nyasa)" tonga []] + ["ton" "Tonga (Tonga Islands)" tongan []] + ["tpi" "Tok Pisin" tok_pisin []] + ["tsi" "Tsimshian" tsimshian []] + ["tsn" "Tswana" tswana []] + ["tso" "Tsonga" tsonga []] + ["tuk" "Turkmen" turkmen []] + ["tum" "Tumbuka" tumbuka []] + ["tup" "Tupi languages" tupi []] + ["tur" "Turkish" turkish []] + ["tut" "Altaic languages" altaic []] + ["tvl" "Tuvalu" tuvalu []] + ["twi" "Twi" twi []] + ["tyv" "Tuvinian" tuvinian []]]] + + [[["udm" "Udmurt" udmurt []] + ["uga" "Ugaritic" ugaritic []] + ["uig" "Uighur; Uyghur" uyghur []] + ["ukr" "Ukrainian" ukrainian []] + ["umb" "Umbundu" umbundu []] + ["urd" "Urdu" urdu []] + ["uzb" "Uzbek" uzbek []]]] + + [[["vai" "Vai" vai []] + ["ven" "Venda" venda []] + ["vie" "Vietnamese" vietnamese []] + ["vol" "Volapük" volapük []] + ["vot" "Votic" votic []]]] + + [[["wak" "Wakashan languages" wakashan []] + ["wal" "Wolaitta; Wolaytta" walamo []] + ["war" "Waray" waray []] + ["was" "Washo" washo []] + ["wen" "Sorbian languages" sorbian []] + ["wln" "Walloon" walloon []] + ["wol" "Wolof" wolof []]]] + + [[["xal" "Kalmyk; Oirat" kalmyk [[oirat]]] + ["xho" "Xhosa" xhosa []]]] + + [[["yao" "Yao" yao []] + ["yap" "Yapese" yapese []] + ["yid" "Yiddish" yiddish []] + ["yor" "Yoruba" yoruba []] + ["ypk" "Yupik languages" yupik []]]] + + [[["zap" "Zapotec" zapotec []] + ["zbl" "Blissymbols; Blissymbolics; Bliss" blissymbols []] + ["zen" "Zenaga" zenaga []] + ["zgh" "Standard Moroccan Tamazight" standard_moroccan_tamazight []] + ["zha" "Zhuang; Chuang" zhuang []] + ["zho" "Chinese" chinese []] + ["znd" "Zande languages" zande []] + ["zul" "Zulu" zulu []] + ["zun" "Zuni" zuni []] + ["zza" "Zaza; Dimili; Dimli; Kirdki; Kirmanjki; Zazaki" zaza [[dimili] [dimli] [kirdki] [kirmanjki] [zazaki]]]]]) + + (implementation: .public equivalence + (Equivalence Language) + + (def: (= reference sample) + (same? reference sample))) + + (implementation: .public hash + (Hash Language) + + (def: &equivalence + ..equivalence) + + (def: hash + (|>> ..code + (\ text.hash hash))))] ) diff --git a/stdlib/source/library/lux/locale/territory.lux b/stdlib/source/library/lux/locale/territory.lux index 834828075..ded9f2110 100644 --- a/stdlib/source/library/lux/locale/territory.lux +++ b/stdlib/source/library/lux/locale/territory.lux @@ -13,303 +13,301 @@ ... https://en.wikipedia.org/wiki/ISO_3166-1 (abstract: .public Territory - {} - (Record [#name Text #short Text #long Text #code Nat]) - (template [<name> <field> <type>] - [(def: .public <name> - (-> Territory <type>) - (|>> :representation - (value@ <field>)))] + [(template [<name> <field> <type>] + [(def: .public <name> + (-> Territory <type>) + (|>> :representation + (value@ <field>)))] - [name #name Text] - [short_code #short Text] - [long_code #long Text] - [numeric_code #code Nat] - ) + [name #name Text] + [short_code #short Text] + [long_code #long Text] + [numeric_code #code Nat] + ) - (template [<short> <long> <number> <name> <main> <neighbor>+] - [(def: .public <main> - Territory - (:abstraction [#name <name> - #short <short> - #long <long> - #code <number>])) + (template [<short> <long> <number> <name> <main> <neighbor>+] + [(def: .public <main> + Territory + (:abstraction [#name <name> + #short <short> + #long <long> + #code <number>])) - (`` (template [<neighbor>] - [(def: .public <neighbor> Territory <main>)] + (`` (template [<neighbor>] + [(def: .public <neighbor> Territory <main>)] - (~~ (template.spliced <neighbor>+))))] + (~~ (template.spliced <neighbor>+))))] - ["AF" "AFG" 004 "Afghanistan" afghanistan []] - ["AX" "ALA" 248 "Åland Islands" aland_islands []] - ["AL" "ALB" 008 "Albania" albania []] - ["DZ" "DZA" 012 "Algeria" algeria []] - ["AS" "ASM" 016 "American Samoa" american_samoa []] - ["AD" "AND" 020 "Andorra" andorra []] - ["AO" "AGO" 024 "Angola" angola []] - ["AI" "AIA" 660 "Anguilla" anguilla []] - ["AQ" "ATA" 010 "Antarctica" antarctica []] - ["AG" "ATG" 028 "Antigua and Barbuda" antigua [[barbuda]]] - ["AR" "ARG" 032 "Argentina" argentina []] - ["AM" "ARM" 051 "Armenia" armenia []] - ["AW" "ABW" 533 "Aruba" aruba []] - ["AU" "AUS" 036 "Australia" australia []] - ["AT" "AUT" 040 "Austria" austria []] - ["AZ" "AZE" 031 "Azerbaijan" azerbaijan []] - ["BS" "BHS" 044 "The Bahamas" the_bahamas []] - ["BH" "BHR" 048 "Bahrain" bahrain []] - ["BD" "BGD" 050 "Bangladesh" bangladesh []] - ["BB" "BRB" 052 "Barbados" barbados []] - ["BY" "BLR" 112 "Belarus" belarus []] - ["BE" "BEL" 056 "Belgium" belgium []] - ["BZ" "BLZ" 084 "Belize" belize []] - ["BJ" "BEN" 204 "Benin" benin []] - ["BM" "BMU" 060 "Bermuda" bermuda []] - ["BT" "BTN" 064 "Bhutan" bhutan []] - ["BO" "BOL" 068 "Bolivia" bolivia []] - ["BQ" "BES" 535 "Bonaire, Sint Eustatius and Saba" bonaire [[sint_eustatius] [saba]]] - ["BA" "BIH" 070 "Bosnia and Herzegovina" bosnia [[herzegovina]]] - ["BW" "BWA" 072 "Botswana" botswana []] - ["BV" "BVT" 074 "Bouvet Island" bouvet_island []] - ["BR" "BRA" 076 "Brazil" brazil []] - ["IO" "IOT" 086 "British Indian Ocean Territory" british_indian_ocean_territory []] - ["BN" "BRN" 096 "Brunei Darussalam" brunei_darussalam []] - ["BG" "BGR" 100 "Bulgaria" bulgaria []] - ["BF" "BFA" 854 "Burkina Faso" burkina_faso []] - ["BI" "BDI" 108 "Burundi" burundi []] - ["CV" "CPV" 132 "Cape Verde" cape_verde []] - ["KH" "KHM" 116 "Cambodia" cambodia []] - ["CM" "CMR" 120 "Cameroon" cameroon []] - ["CA" "CAN" 124 "Canada" canada []] - ["KY" "CYM" 136 "Cayman Islands" cayman_islands []] - ["CF" "CAF" 140 "Central African Republic" central_african_republic []] - ["TD" "TCD" 148 "Chad" chad []] - ["CL" "CHL" 152 "Chile" chile []] - ["CN" "CHN" 156 "China" china []] - ["CX" "CXR" 162 "Christmas Island" christmas_island []] - ["CC" "CCK" 166 "Cocos (Keeling) Islands" cocos_islands []] - ["CO" "COL" 170 "Colombia" colombia []] - ["KM" "COM" 174 "Comoros" comoros []] - ["CG" "COG" 178 "Congo" congo []] - ["CD" "COD" 180 "Democratic Republic of the Congo" democratic_republic_of_the_congo []] - ["CK" "COK" 184 "Cook Islands" cook_islands []] - ["CR" "CRI" 188 "Costa Rica" costa_rica []] - ["CI" "CIV" 384 "Ivory Coast" ivory_coast []] - ["HR" "HRV" 191 "Croatia" croatia []] - ["CU" "CUB" 192 "Cuba" cuba []] - ["CW" "CUW" 531 "Curacao" curacao []] - ["CY" "CYP" 196 "Cyprus" cyprus []] - ["CZ" "CZE" 203 "Czech Republic" czech_republic []] - ["DK" "DNK" 208 "Denmark" denmark []] - ["DJ" "DJI" 262 "Djibouti" djibouti []] - ["DM" "DMA" 212 "Dominica" dominica []] - ["DO" "DOM" 214 "Dominican Republic" dominican_republic []] - ["EC" "ECU" 218 "Ecuador" ecuador []] - ["EG" "EGY" 818 "Egypt" egypt []] - ["SV" "SLV" 222 "El Salvador" el_salvador []] - ["GQ" "GNQ" 226 "Equatorial Guinea" equatorial_guinea []] - ["ER" "ERI" 232 "Eritrea" eritrea []] - ["EE" "EST" 233 "Estonia" estonia []] - ["SZ" "SWZ" 748 "Eswatini" eswatini []] - ["ET" "ETH" 231 "Ethiopia" ethiopia []] - ["FK" "FLK" 238 "Falkland Islands" falkland_islands []] - ["FO" "FRO" 234 "Faroe Islands" faroe_islands []] - ["FJ" "FJI" 242 "Fiji" fiji []] - ["FI" "FIN" 246 "Finland" finland []] - ["FR" "FRA" 250 "France" france []] - ["GF" "GUF" 254 "French Guiana" french_guiana []] - ["PF" "PYF" 258 "French Polynesia" french_polynesia []] - ["TF" "ATF" 260 "French Southern Territories" french_southern_territories []] - ["GA" "GAB" 266 "Gabon" gabon []] - ["GM" "GMB" 270 "The Gambia" the_gambia []] - ["GE" "GEO" 268 "Georgia" georgia []] - ["DE" "DEU" 276 "Germany" germany []] - ["GH" "GHA" 288 "Ghana" ghana []] - ["GI" "GIB" 292 "Gibraltar" gibraltar []] - ["GR" "GRC" 300 "Greece" greece []] - ["GL" "GRL" 304 "Greenland" greenland []] - ["GD" "GRD" 308 "Grenada" grenada []] - ["GP" "GLP" 312 "Guadeloupe" guadeloupe []] - ["GU" "GUM" 316 "Guam" guam []] - ["GT" "GTM" 320 "Guatemala" guatemala []] - ["GG" "GGY" 831 "Guernsey" guernsey []] - ["GN" "GIN" 324 "Guinea" guinea []] - ["GW" "GNB" 624 "Guinea-Bissau" guinea_bissau []] - ["GY" "GUY" 328 "Guyana" guyana []] - ["HT" "HTI" 332 "Haiti" haiti []] - ["HM" "HMD" 334 "Heard Island and McDonald Islands" heard_island [[mcdonald_islands]]] - ["VA" "VAT" 336 "Vatican City" vatican_city []] - ["HN" "HND" 340 "Honduras" honduras []] - ["HK" "HKG" 344 "Hong Kong" hong_kong []] - ["HU" "HUN" 348 "Hungary" hungary []] - ["IS" "ISL" 352 "Iceland" iceland []] - ["IN" "IND" 356 "India" india []] - ["ID" "IDN" 360 "Indonesia" indonesia []] - ["IR" "IRN" 364 "Iran" iran []] - ["IQ" "IRQ" 368 "Iraq" iraq []] - ["IE" "IRL" 372 "Ireland" ireland []] - ["IM" "IMN" 833 "Isle of Man" isle_of_man []] - ["IL" "ISR" 376 "Israel" israel []] - ["IT" "ITA" 380 "Italy" italy []] - ["JM" "JAM" 388 "Jamaica" jamaica []] - ["JP" "JPN" 392 "Japan" japan []] - ["JE" "JEY" 832 "Jersey" jersey []] - ["JO" "JOR" 400 "Jordan" jordan []] - ["KZ" "KAZ" 398 "Kazakhstan" kazakhstan []] - ["KE" "KEN" 404 "Kenya" kenya []] - ["KI" "KIR" 296 "Kiribati" kiribati []] - ["KP" "PRK" 408 "North Korea" north_korea []] - ["KR" "KOR" 410 "South Korea" south_korea []] - ["KW" "KWT" 414 "Kuwait" kuwait []] - ["KG" "KGZ" 417 "Kyrgyzstan" kyrgyzstan []] - ["LA" "LAO" 418 "Laos" laos []] - ["LV" "LVA" 428 "Latvia" latvia []] - ["LB" "LBN" 422 "Lebanon" lebanon []] - ["LS" "LSO" 426 "Lesotho" lesotho []] - ["LR" "LBR" 430 "Liberia" liberia []] - ["LY" "LBY" 434 "Libya" libya []] - ["LI" "LIE" 438 "Liechtenstein" liechtenstein []] - ["LT" "LTU" 440 "Lithuania" lithuania []] - ["LU" "LUX" 442 "Luxembourg" luxembourg []] - ["MO" "MAC" 446 "Macau" macau []] - ["MK" "MKD" 807 "Macedonia" macedonia []] - ["MG" "MDG" 450 "Madagascar" madagascar []] - ["MW" "MWI" 454 "Malawi" malawi []] - ["MY" "MYS" 458 "Malaysia" malaysia []] - ["MV" "MDV" 462 "Maldives" maldives []] - ["ML" "MLI" 466 "Mali" mali []] - ["MT" "MLT" 470 "Malta" malta []] - ["MH" "MHL" 584 "Marshall Islands" marshall_islands []] - ["MQ" "MTQ" 474 "Martinique" martinique []] - ["MR" "MRT" 478 "Mauritania" mauritania []] - ["MU" "MUS" 480 "Mauritius" mauritius []] - ["YT" "MYT" 175 "Mayotte" mayotte []] - ["MX" "MEX" 484 "Mexico" mexico []] - ["FM" "FSM" 583 "Micronesia" micronesia []] - ["MD" "MDA" 498 "Moldova" moldova []] - ["MC" "MCO" 492 "Monaco" monaco []] - ["MN" "MNG" 496 "Mongolia" mongolia []] - ["ME" "MNE" 499 "Montenegro" montenegro []] - ["MS" "MSR" 500 "Montserrat" montserrat []] - ["MA" "MAR" 504 "Morocco" morocco []] - ["MZ" "MOZ" 508 "Mozambique" mozambique []] - ["MM" "MMR" 104 "Myanmar" myanmar []] - ["NA" "NAM" 516 "Namibia" namibia []] - ["NR" "NRU" 520 "Nauru" nauru []] - ["NP" "NPL" 524 "Nepal" nepal []] - ["NL" "NLD" 528 "Netherlands" netherlands []] - ["NC" "NCL" 540 "New Caledonia" new_caledonia []] - ["NZ" "NZL" 554 "New Zealand" new_zealand []] - ["NI" "NIC" 558 "Nicaragua" nicaragua []] - ["NE" "NER" 562 "Niger" niger []] - ["NG" "NGA" 566 "Nigeria" nigeria []] - ["NU" "NIU" 570 "Niue" niue []] - ["NF" "NFK" 574 "Norfolk Island" norfolk_island []] - ["MP" "MNP" 580 "Northern Mariana Islands" northern_mariana_islands []] - ["NO" "NOR" 578 "Norway" norway []] - ["OM" "OMN" 512 "Oman" oman []] - ["PK" "PAK" 586 "Pakistan" pakistan []] - ["PW" "PLW" 585 "Palau" palau []] - ["PS" "PSE" 275 "Palestine" palestine []] - ["PA" "PAN" 591 "Panama" panama []] - ["PG" "PNG" 598 "Papua New Guinea" papua_new_guinea []] - ["PY" "PRY" 600 "Paraguay" paraguay []] - ["PE" "PER" 604 "Peru" peru []] - ["PH" "PHL" 608 "Philippines" philippines []] - ["PN" "PCN" 612 "Pitcairn Islands" pitcairn_islands []] - ["PL" "POL" 616 "Poland" poland []] - ["PT" "PRT" 620 "Portugal" portugal []] - ["PR" "PRI" 630 "Puerto Rico" puerto_rico []] - ["QA" "QAT" 634 "Qatar" qatar []] - ["RE" "REU" 638 "Reunion" reunion []] - ["RO" "ROU" 642 "Romania" romania []] - ["RU" "RUS" 643 "Russia" russia []] - ["RW" "RWA" 646 "Rwanda" rwanda []] - ["BL" "BLM" 652 "Saint Barthélemy" saint_barthelemy []] - ["SH" "SHN" 654 "Saint Helena, Ascension and Tristan da Cunha" saint_helena [[ascension] [tristan_da_cunha]]] - ["KN" "KNA" 659 "Saint Kitts and Nevis" saint_kitts [[nevis]]] - ["LC" "LCA" 662 "Saint Lucia" saint_lucia []] - ["MF" "MAF" 663 "Saint Martin" saint_martin []] - ["PM" "SPM" 666 "Saint Pierre and Miquelon" saint_pierre [[miquelon]]] - ["VC" "VCT" 670 "Saint Vincent and the Grenadines" saint_vincent [[the_grenadines]]] - ["WS" "WSM" 882 "Samoa" samoa []] - ["SM" "SMR" 674 "San Marino" san_marino []] - ["ST" "STP" 678 "Sao Tome and Principe" sao_tome [[principe]]] - ["SA" "SAU" 682 "Saudi Arabia" saudi_arabia []] - ["SN" "SEN" 686 "Senegal" senegal []] - ["RS" "SRB" 688 "Serbia" serbia []] - ["SC" "SYC" 690 "Seychelles" seychelles []] - ["SL" "SLE" 694 "Sierra Leone" sierra_leone []] - ["SG" "SGP" 702 "Singapore" singapore []] - ["SX" "SXM" 534 "Sint Maarten" sint_maarten []] - ["SK" "SVK" 703 "Slovakia" slovakia []] - ["SI" "SVN" 705 "Slovenia" slovenia []] - ["SB" "SLB" 090 "Solomon Islands" solomon_islands []] - ["SO" "SOM" 706 "Somalia" somalia []] - ["ZA" "ZAF" 710 "South Africa" south_africa []] - ["GS" "SGS" 239 "South Georgia and the South Sandwich Islands" south_georgia [[south_sandwich_islands]]] - ["SS" "SSD" 728 "South Sudan" south_sudan []] - ["ES" "ESP" 724 "Spain" spain []] - ["LK" "LKA" 144 "Sri Lanka" sri_lanka []] - ["SD" "SDN" 729 "Sudan" sudan []] - ["SR" "SUR" 740 "Suriname" suriname []] - ["SJ" "SJM" 744 "Svalbard and Jan Mayen" svalbard [[jan_mayen]]] - ["SE" "SWE" 752 "Sweden" sweden []] - ["CH" "CHE" 756 "Switzerland" switzerland []] - ["SY" "SYR" 760 "Syria" syria []] - ["TW" "TWN" 158 "Taiwan" taiwan []] - ["TJ" "TJK" 762 "Tajikistan" tajikistan []] - ["TZ" "TZA" 834 "Tanzania" tanzania []] - ["TH" "THA" 764 "Thailand" thailand []] - ["TL" "TLS" 626 "East Timor" east_timor []] - ["TG" "TGO" 768 "Togo" togo []] - ["TK" "TKL" 772 "Tokelau" tokelau []] - ["TO" "TON" 776 "Tonga" tonga []] - ["TT" "TTO" 780 "Trinidad and Tobago" trinidad [[tobago]]] - ["TN" "TUN" 788 "Tunisia" tunisia []] - ["TR" "TUR" 792 "Turkey" turkey []] - ["TM" "TKM" 795 "Turkmenistan" turkmenistan []] - ["TC" "TCA" 796 "Turks and Caicos Islands" turks [[caicos_islands]]] - ["TV" "TUV" 798 "Tuvalu" tuvalu []] - ["UG" "UGA" 800 "Uganda" uganda []] - ["UA" "UKR" 804 "Ukraine" ukraine []] - ["AE" "ARE" 784 "United Arab Emirates" united_arab_emirates []] - ["GB" "GBR" 826 "United Kingdom of Great Britain and Northern Ireland" united_kingdom [[northern_ireland]]] - ["US" "USA" 840 "United States of America" united_states_of_america []] - ["UM" "UMI" 581 "United States Minor Outlying Islands" united_states_minor_outlying_islands []] - ["UY" "URY" 858 "Uruguay" uruguay []] - ["UZ" "UZB" 860 "Uzbekistan" uzbekistan []] - ["VU" "VUT" 548 "Vanuatu" vanuatu []] - ["VE" "VEN" 862 "Venezuela" venezuela []] - ["VN" "VNM" 704 "Vietnam" vietnam []] - ["VG" "VGB" 092 "British Virgin Islands" british_virgin_islands []] - ["VI" "VIR" 850 "United States Virgin Islands" united_states_virgin_islands []] - ["WF" "WLF" 876 "Wallis and Futuna" wallis [[futuna]]] - ["EH" "ESH" 732 "Western Sahara" western_sahara []] - ["YE" "YEM" 887 "Yemen" yemen []] - ["ZM" "ZMB" 894 "Zambia" zambia []] - ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []] - ) + ["AF" "AFG" 004 "Afghanistan" afghanistan []] + ["AX" "ALA" 248 "Åland Islands" aland_islands []] + ["AL" "ALB" 008 "Albania" albania []] + ["DZ" "DZA" 012 "Algeria" algeria []] + ["AS" "ASM" 016 "American Samoa" american_samoa []] + ["AD" "AND" 020 "Andorra" andorra []] + ["AO" "AGO" 024 "Angola" angola []] + ["AI" "AIA" 660 "Anguilla" anguilla []] + ["AQ" "ATA" 010 "Antarctica" antarctica []] + ["AG" "ATG" 028 "Antigua and Barbuda" antigua [[barbuda]]] + ["AR" "ARG" 032 "Argentina" argentina []] + ["AM" "ARM" 051 "Armenia" armenia []] + ["AW" "ABW" 533 "Aruba" aruba []] + ["AU" "AUS" 036 "Australia" australia []] + ["AT" "AUT" 040 "Austria" austria []] + ["AZ" "AZE" 031 "Azerbaijan" azerbaijan []] + ["BS" "BHS" 044 "The Bahamas" the_bahamas []] + ["BH" "BHR" 048 "Bahrain" bahrain []] + ["BD" "BGD" 050 "Bangladesh" bangladesh []] + ["BB" "BRB" 052 "Barbados" barbados []] + ["BY" "BLR" 112 "Belarus" belarus []] + ["BE" "BEL" 056 "Belgium" belgium []] + ["BZ" "BLZ" 084 "Belize" belize []] + ["BJ" "BEN" 204 "Benin" benin []] + ["BM" "BMU" 060 "Bermuda" bermuda []] + ["BT" "BTN" 064 "Bhutan" bhutan []] + ["BO" "BOL" 068 "Bolivia" bolivia []] + ["BQ" "BES" 535 "Bonaire, Sint Eustatius and Saba" bonaire [[sint_eustatius] [saba]]] + ["BA" "BIH" 070 "Bosnia and Herzegovina" bosnia [[herzegovina]]] + ["BW" "BWA" 072 "Botswana" botswana []] + ["BV" "BVT" 074 "Bouvet Island" bouvet_island []] + ["BR" "BRA" 076 "Brazil" brazil []] + ["IO" "IOT" 086 "British Indian Ocean Territory" british_indian_ocean_territory []] + ["BN" "BRN" 096 "Brunei Darussalam" brunei_darussalam []] + ["BG" "BGR" 100 "Bulgaria" bulgaria []] + ["BF" "BFA" 854 "Burkina Faso" burkina_faso []] + ["BI" "BDI" 108 "Burundi" burundi []] + ["CV" "CPV" 132 "Cape Verde" cape_verde []] + ["KH" "KHM" 116 "Cambodia" cambodia []] + ["CM" "CMR" 120 "Cameroon" cameroon []] + ["CA" "CAN" 124 "Canada" canada []] + ["KY" "CYM" 136 "Cayman Islands" cayman_islands []] + ["CF" "CAF" 140 "Central African Republic" central_african_republic []] + ["TD" "TCD" 148 "Chad" chad []] + ["CL" "CHL" 152 "Chile" chile []] + ["CN" "CHN" 156 "China" china []] + ["CX" "CXR" 162 "Christmas Island" christmas_island []] + ["CC" "CCK" 166 "Cocos (Keeling) Islands" cocos_islands []] + ["CO" "COL" 170 "Colombia" colombia []] + ["KM" "COM" 174 "Comoros" comoros []] + ["CG" "COG" 178 "Congo" congo []] + ["CD" "COD" 180 "Democratic Republic of the Congo" democratic_republic_of_the_congo []] + ["CK" "COK" 184 "Cook Islands" cook_islands []] + ["CR" "CRI" 188 "Costa Rica" costa_rica []] + ["CI" "CIV" 384 "Ivory Coast" ivory_coast []] + ["HR" "HRV" 191 "Croatia" croatia []] + ["CU" "CUB" 192 "Cuba" cuba []] + ["CW" "CUW" 531 "Curacao" curacao []] + ["CY" "CYP" 196 "Cyprus" cyprus []] + ["CZ" "CZE" 203 "Czech Republic" czech_republic []] + ["DK" "DNK" 208 "Denmark" denmark []] + ["DJ" "DJI" 262 "Djibouti" djibouti []] + ["DM" "DMA" 212 "Dominica" dominica []] + ["DO" "DOM" 214 "Dominican Republic" dominican_republic []] + ["EC" "ECU" 218 "Ecuador" ecuador []] + ["EG" "EGY" 818 "Egypt" egypt []] + ["SV" "SLV" 222 "El Salvador" el_salvador []] + ["GQ" "GNQ" 226 "Equatorial Guinea" equatorial_guinea []] + ["ER" "ERI" 232 "Eritrea" eritrea []] + ["EE" "EST" 233 "Estonia" estonia []] + ["SZ" "SWZ" 748 "Eswatini" eswatini []] + ["ET" "ETH" 231 "Ethiopia" ethiopia []] + ["FK" "FLK" 238 "Falkland Islands" falkland_islands []] + ["FO" "FRO" 234 "Faroe Islands" faroe_islands []] + ["FJ" "FJI" 242 "Fiji" fiji []] + ["FI" "FIN" 246 "Finland" finland []] + ["FR" "FRA" 250 "France" france []] + ["GF" "GUF" 254 "French Guiana" french_guiana []] + ["PF" "PYF" 258 "French Polynesia" french_polynesia []] + ["TF" "ATF" 260 "French Southern Territories" french_southern_territories []] + ["GA" "GAB" 266 "Gabon" gabon []] + ["GM" "GMB" 270 "The Gambia" the_gambia []] + ["GE" "GEO" 268 "Georgia" georgia []] + ["DE" "DEU" 276 "Germany" germany []] + ["GH" "GHA" 288 "Ghana" ghana []] + ["GI" "GIB" 292 "Gibraltar" gibraltar []] + ["GR" "GRC" 300 "Greece" greece []] + ["GL" "GRL" 304 "Greenland" greenland []] + ["GD" "GRD" 308 "Grenada" grenada []] + ["GP" "GLP" 312 "Guadeloupe" guadeloupe []] + ["GU" "GUM" 316 "Guam" guam []] + ["GT" "GTM" 320 "Guatemala" guatemala []] + ["GG" "GGY" 831 "Guernsey" guernsey []] + ["GN" "GIN" 324 "Guinea" guinea []] + ["GW" "GNB" 624 "Guinea-Bissau" guinea_bissau []] + ["GY" "GUY" 328 "Guyana" guyana []] + ["HT" "HTI" 332 "Haiti" haiti []] + ["HM" "HMD" 334 "Heard Island and McDonald Islands" heard_island [[mcdonald_islands]]] + ["VA" "VAT" 336 "Vatican City" vatican_city []] + ["HN" "HND" 340 "Honduras" honduras []] + ["HK" "HKG" 344 "Hong Kong" hong_kong []] + ["HU" "HUN" 348 "Hungary" hungary []] + ["IS" "ISL" 352 "Iceland" iceland []] + ["IN" "IND" 356 "India" india []] + ["ID" "IDN" 360 "Indonesia" indonesia []] + ["IR" "IRN" 364 "Iran" iran []] + ["IQ" "IRQ" 368 "Iraq" iraq []] + ["IE" "IRL" 372 "Ireland" ireland []] + ["IM" "IMN" 833 "Isle of Man" isle_of_man []] + ["IL" "ISR" 376 "Israel" israel []] + ["IT" "ITA" 380 "Italy" italy []] + ["JM" "JAM" 388 "Jamaica" jamaica []] + ["JP" "JPN" 392 "Japan" japan []] + ["JE" "JEY" 832 "Jersey" jersey []] + ["JO" "JOR" 400 "Jordan" jordan []] + ["KZ" "KAZ" 398 "Kazakhstan" kazakhstan []] + ["KE" "KEN" 404 "Kenya" kenya []] + ["KI" "KIR" 296 "Kiribati" kiribati []] + ["KP" "PRK" 408 "North Korea" north_korea []] + ["KR" "KOR" 410 "South Korea" south_korea []] + ["KW" "KWT" 414 "Kuwait" kuwait []] + ["KG" "KGZ" 417 "Kyrgyzstan" kyrgyzstan []] + ["LA" "LAO" 418 "Laos" laos []] + ["LV" "LVA" 428 "Latvia" latvia []] + ["LB" "LBN" 422 "Lebanon" lebanon []] + ["LS" "LSO" 426 "Lesotho" lesotho []] + ["LR" "LBR" 430 "Liberia" liberia []] + ["LY" "LBY" 434 "Libya" libya []] + ["LI" "LIE" 438 "Liechtenstein" liechtenstein []] + ["LT" "LTU" 440 "Lithuania" lithuania []] + ["LU" "LUX" 442 "Luxembourg" luxembourg []] + ["MO" "MAC" 446 "Macau" macau []] + ["MK" "MKD" 807 "Macedonia" macedonia []] + ["MG" "MDG" 450 "Madagascar" madagascar []] + ["MW" "MWI" 454 "Malawi" malawi []] + ["MY" "MYS" 458 "Malaysia" malaysia []] + ["MV" "MDV" 462 "Maldives" maldives []] + ["ML" "MLI" 466 "Mali" mali []] + ["MT" "MLT" 470 "Malta" malta []] + ["MH" "MHL" 584 "Marshall Islands" marshall_islands []] + ["MQ" "MTQ" 474 "Martinique" martinique []] + ["MR" "MRT" 478 "Mauritania" mauritania []] + ["MU" "MUS" 480 "Mauritius" mauritius []] + ["YT" "MYT" 175 "Mayotte" mayotte []] + ["MX" "MEX" 484 "Mexico" mexico []] + ["FM" "FSM" 583 "Micronesia" micronesia []] + ["MD" "MDA" 498 "Moldova" moldova []] + ["MC" "MCO" 492 "Monaco" monaco []] + ["MN" "MNG" 496 "Mongolia" mongolia []] + ["ME" "MNE" 499 "Montenegro" montenegro []] + ["MS" "MSR" 500 "Montserrat" montserrat []] + ["MA" "MAR" 504 "Morocco" morocco []] + ["MZ" "MOZ" 508 "Mozambique" mozambique []] + ["MM" "MMR" 104 "Myanmar" myanmar []] + ["NA" "NAM" 516 "Namibia" namibia []] + ["NR" "NRU" 520 "Nauru" nauru []] + ["NP" "NPL" 524 "Nepal" nepal []] + ["NL" "NLD" 528 "Netherlands" netherlands []] + ["NC" "NCL" 540 "New Caledonia" new_caledonia []] + ["NZ" "NZL" 554 "New Zealand" new_zealand []] + ["NI" "NIC" 558 "Nicaragua" nicaragua []] + ["NE" "NER" 562 "Niger" niger []] + ["NG" "NGA" 566 "Nigeria" nigeria []] + ["NU" "NIU" 570 "Niue" niue []] + ["NF" "NFK" 574 "Norfolk Island" norfolk_island []] + ["MP" "MNP" 580 "Northern Mariana Islands" northern_mariana_islands []] + ["NO" "NOR" 578 "Norway" norway []] + ["OM" "OMN" 512 "Oman" oman []] + ["PK" "PAK" 586 "Pakistan" pakistan []] + ["PW" "PLW" 585 "Palau" palau []] + ["PS" "PSE" 275 "Palestine" palestine []] + ["PA" "PAN" 591 "Panama" panama []] + ["PG" "PNG" 598 "Papua New Guinea" papua_new_guinea []] + ["PY" "PRY" 600 "Paraguay" paraguay []] + ["PE" "PER" 604 "Peru" peru []] + ["PH" "PHL" 608 "Philippines" philippines []] + ["PN" "PCN" 612 "Pitcairn Islands" pitcairn_islands []] + ["PL" "POL" 616 "Poland" poland []] + ["PT" "PRT" 620 "Portugal" portugal []] + ["PR" "PRI" 630 "Puerto Rico" puerto_rico []] + ["QA" "QAT" 634 "Qatar" qatar []] + ["RE" "REU" 638 "Reunion" reunion []] + ["RO" "ROU" 642 "Romania" romania []] + ["RU" "RUS" 643 "Russia" russia []] + ["RW" "RWA" 646 "Rwanda" rwanda []] + ["BL" "BLM" 652 "Saint Barthélemy" saint_barthelemy []] + ["SH" "SHN" 654 "Saint Helena, Ascension and Tristan da Cunha" saint_helena [[ascension] [tristan_da_cunha]]] + ["KN" "KNA" 659 "Saint Kitts and Nevis" saint_kitts [[nevis]]] + ["LC" "LCA" 662 "Saint Lucia" saint_lucia []] + ["MF" "MAF" 663 "Saint Martin" saint_martin []] + ["PM" "SPM" 666 "Saint Pierre and Miquelon" saint_pierre [[miquelon]]] + ["VC" "VCT" 670 "Saint Vincent and the Grenadines" saint_vincent [[the_grenadines]]] + ["WS" "WSM" 882 "Samoa" samoa []] + ["SM" "SMR" 674 "San Marino" san_marino []] + ["ST" "STP" 678 "Sao Tome and Principe" sao_tome [[principe]]] + ["SA" "SAU" 682 "Saudi Arabia" saudi_arabia []] + ["SN" "SEN" 686 "Senegal" senegal []] + ["RS" "SRB" 688 "Serbia" serbia []] + ["SC" "SYC" 690 "Seychelles" seychelles []] + ["SL" "SLE" 694 "Sierra Leone" sierra_leone []] + ["SG" "SGP" 702 "Singapore" singapore []] + ["SX" "SXM" 534 "Sint Maarten" sint_maarten []] + ["SK" "SVK" 703 "Slovakia" slovakia []] + ["SI" "SVN" 705 "Slovenia" slovenia []] + ["SB" "SLB" 090 "Solomon Islands" solomon_islands []] + ["SO" "SOM" 706 "Somalia" somalia []] + ["ZA" "ZAF" 710 "South Africa" south_africa []] + ["GS" "SGS" 239 "South Georgia and the South Sandwich Islands" south_georgia [[south_sandwich_islands]]] + ["SS" "SSD" 728 "South Sudan" south_sudan []] + ["ES" "ESP" 724 "Spain" spain []] + ["LK" "LKA" 144 "Sri Lanka" sri_lanka []] + ["SD" "SDN" 729 "Sudan" sudan []] + ["SR" "SUR" 740 "Suriname" suriname []] + ["SJ" "SJM" 744 "Svalbard and Jan Mayen" svalbard [[jan_mayen]]] + ["SE" "SWE" 752 "Sweden" sweden []] + ["CH" "CHE" 756 "Switzerland" switzerland []] + ["SY" "SYR" 760 "Syria" syria []] + ["TW" "TWN" 158 "Taiwan" taiwan []] + ["TJ" "TJK" 762 "Tajikistan" tajikistan []] + ["TZ" "TZA" 834 "Tanzania" tanzania []] + ["TH" "THA" 764 "Thailand" thailand []] + ["TL" "TLS" 626 "East Timor" east_timor []] + ["TG" "TGO" 768 "Togo" togo []] + ["TK" "TKL" 772 "Tokelau" tokelau []] + ["TO" "TON" 776 "Tonga" tonga []] + ["TT" "TTO" 780 "Trinidad and Tobago" trinidad [[tobago]]] + ["TN" "TUN" 788 "Tunisia" tunisia []] + ["TR" "TUR" 792 "Turkey" turkey []] + ["TM" "TKM" 795 "Turkmenistan" turkmenistan []] + ["TC" "TCA" 796 "Turks and Caicos Islands" turks [[caicos_islands]]] + ["TV" "TUV" 798 "Tuvalu" tuvalu []] + ["UG" "UGA" 800 "Uganda" uganda []] + ["UA" "UKR" 804 "Ukraine" ukraine []] + ["AE" "ARE" 784 "United Arab Emirates" united_arab_emirates []] + ["GB" "GBR" 826 "United Kingdom of Great Britain and Northern Ireland" united_kingdom [[northern_ireland]]] + ["US" "USA" 840 "United States of America" united_states_of_america []] + ["UM" "UMI" 581 "United States Minor Outlying Islands" united_states_minor_outlying_islands []] + ["UY" "URY" 858 "Uruguay" uruguay []] + ["UZ" "UZB" 860 "Uzbekistan" uzbekistan []] + ["VU" "VUT" 548 "Vanuatu" vanuatu []] + ["VE" "VEN" 862 "Venezuela" venezuela []] + ["VN" "VNM" 704 "Vietnam" vietnam []] + ["VG" "VGB" 092 "British Virgin Islands" british_virgin_islands []] + ["VI" "VIR" 850 "United States Virgin Islands" united_states_virgin_islands []] + ["WF" "WLF" 876 "Wallis and Futuna" wallis [[futuna]]] + ["EH" "ESH" 732 "Western Sahara" western_sahara []] + ["YE" "YEM" 887 "Yemen" yemen []] + ["ZM" "ZMB" 894 "Zambia" zambia []] + ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []] + ) - (implementation: .public equivalence - (Equivalence Territory) - - (def: (= reference sample) - (same? reference sample))) + (implementation: .public equivalence + (Equivalence Territory) + + (def: (= reference sample) + (same? reference sample))) - (implementation: .public hash - (Hash Territory) - - (def: &equivalence ..equivalence) - - (def: hash - (|>> :representation - (value@ #long) - (\ text.hash hash)))) + (implementation: .public hash + (Hash Territory) + + (def: &equivalence ..equivalence) + + (def: hash + (|>> :representation + (value@ #long) + (\ text.hash hash))))] ) diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index bc496557f..a1f8b8bd3 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -28,118 +28,116 @@ ["[1]" modulus {"+" [Modulus]}]]) (abstract: .public (Mod m) - {} - (Record [#modulus (Modulus m) #value Int]) - (def: .public (modular modulus value) - (All (_ %) (-> (Modulus %) Int (Mod %))) - (:abstraction [#modulus modulus - #value (i.mod (//.divisor modulus) value)])) - - (template [<name> <type> <side>] - [(def: .public <name> - (All (_ %) (-> (Mod %) <type>)) - (|>> :representation <side>))] - - [modulus (Modulus %) product.left] - [value Int product.right] - ) - - (exception: .public [%] (incorrect_modulus {modulus (Modulus %)} - {parsed Int}) - (exception.report - ["Expected" (i\encoded (//.divisor modulus))] - ["Actual" (i\encoded parsed)])) - - (def: separator - " mod ") - - (def: intL - (Parser Int) - (<>.codec i.decimal - (<text>.and (<text>.one_of "-+") (<text>.many <text>.decimal)))) - - (implementation: .public (codec expected) - (All (_ %) (-> (Modulus %) (Codec Text (Mod %)))) - - (def: (encoded modular) - (let [[_ value] (:representation modular)] - ($_ text\composite - (i\encoded value) - ..separator - (i\encoded (//.divisor expected))))) - - (def: decoded - (<text>.result - (do <>.monad - [[value _ actual] ($_ <>.and intL (<text>.this ..separator) intL) - _ (<>.assertion (exception.error ..incorrect_modulus [expected actual]) - (i.= (//.divisor expected) actual))] - (in (..modular expected value)))))) - - (template [<name> <op>] - [(def: .public (<name> reference subject) - (All (_ %) (-> (Mod %) (Mod %) Bit)) - (let [[_ reference] (:representation reference) - [_ subject] (:representation subject)] - (<op> reference subject)))] - - [= i.=] - [< i.<] - [<= i.<=] - [> i.>] - [>= i.>=] - ) - - (implementation: .public equivalence - (All (_ %) (Equivalence (Mod %))) - - (def: = ..=)) - - (implementation: .public order - (All (_ %) (Order (Mod %))) - - (def: &equivalence ..equivalence) - (def: < ..<)) - - (template [<name> <op>] - [(def: .public (<name> param subject) - (All (_ %) (-> (Mod %) (Mod %) (Mod %))) - (let [[modulus param] (:representation param) - [_ subject] (:representation subject)] - (:abstraction [#modulus modulus - #value (|> subject - (<op> param) - (i.mod (//.divisor modulus)))])))] - - [+ i.+] - [- i.-] - [* i.*] - ) - - (template [<composition> <identity> <monoid>] - [(implementation: .public (<monoid> modulus) - (All (_ %) (-> (Modulus %) (Monoid (Mod %)))) - - (def: identity - (..modular modulus <identity>)) - (def: composite - <composition>))] - - [..+ +0 addition] - [..* +1 multiplication] - ) - - (def: .public (inverse modular) - (All (_ %) (-> (Mod %) (Maybe (Mod %)))) - (let [[modulus value] (:representation modular) - [[vk mk] gcd] (i.extended_gcd value (//.divisor modulus))] - (case gcd - +1 (#.Some (..modular modulus vk)) - _ #.None))) + [(def: .public (modular modulus value) + (All (_ %) (-> (Modulus %) Int (Mod %))) + (:abstraction [#modulus modulus + #value (i.mod (//.divisor modulus) value)])) + + (template [<name> <type> <side>] + [(def: .public <name> + (All (_ %) (-> (Mod %) <type>)) + (|>> :representation <side>))] + + [modulus (Modulus %) product.left] + [value Int product.right] + ) + + (exception: .public [%] (incorrect_modulus {modulus (Modulus %)} + {parsed Int}) + (exception.report + ["Expected" (i\encoded (//.divisor modulus))] + ["Actual" (i\encoded parsed)])) + + (def: separator + " mod ") + + (def: intL + (Parser Int) + (<>.codec i.decimal + (<text>.and (<text>.one_of "-+") (<text>.many <text>.decimal)))) + + (implementation: .public (codec expected) + (All (_ %) (-> (Modulus %) (Codec Text (Mod %)))) + + (def: (encoded modular) + (let [[_ value] (:representation modular)] + ($_ text\composite + (i\encoded value) + ..separator + (i\encoded (//.divisor expected))))) + + (def: decoded + (<text>.result + (do <>.monad + [[value _ actual] ($_ <>.and intL (<text>.this ..separator) intL) + _ (<>.assertion (exception.error ..incorrect_modulus [expected actual]) + (i.= (//.divisor expected) actual))] + (in (..modular expected value)))))) + + (template [<name> <op>] + [(def: .public (<name> reference subject) + (All (_ %) (-> (Mod %) (Mod %) Bit)) + (let [[_ reference] (:representation reference) + [_ subject] (:representation subject)] + (<op> reference subject)))] + + [= i.=] + [< i.<] + [<= i.<=] + [> i.>] + [>= i.>=] + ) + + (implementation: .public equivalence + (All (_ %) (Equivalence (Mod %))) + + (def: = ..=)) + + (implementation: .public order + (All (_ %) (Order (Mod %))) + + (def: &equivalence ..equivalence) + (def: < ..<)) + + (template [<name> <op>] + [(def: .public (<name> param subject) + (All (_ %) (-> (Mod %) (Mod %) (Mod %))) + (let [[modulus param] (:representation param) + [_ subject] (:representation subject)] + (:abstraction [#modulus modulus + #value (|> subject + (<op> param) + (i.mod (//.divisor modulus)))])))] + + [+ i.+] + [- i.-] + [* i.*] + ) + + (template [<composition> <identity> <monoid>] + [(implementation: .public (<monoid> modulus) + (All (_ %) (-> (Modulus %) (Monoid (Mod %)))) + + (def: identity + (..modular modulus <identity>)) + (def: composite + <composition>))] + + [..+ +0 addition] + [..* +1 multiplication] + ) + + (def: .public (inverse modular) + (All (_ %) (-> (Mod %) (Maybe (Mod %)))) + (let [[modulus value] (:representation modular) + [[vk mk] gcd] (i.extended_gcd value (//.divisor modulus))] + (case gcd + +1 (#.Some (..modular modulus vk)) + _ #.None)))] ) (exception: .public [r% s%] (moduli_are_not_equal {reference (Modulus r%)} diff --git a/stdlib/source/library/lux/math/modulus.lux b/stdlib/source/library/lux/math/modulus.lux index 6879bd012..4a4b000df 100644 --- a/stdlib/source/library/lux/math/modulus.lux +++ b/stdlib/source/library/lux/math/modulus.lux @@ -21,31 +21,29 @@ (exception: .public zero_cannot_be_a_modulus) (abstract: .public (Modulus %) - {} - Int - (def: .public (modulus value) - (Ex (_ %) (-> Int (Try (Modulus %)))) - (if (i.= +0 value) - (exception.except ..zero_cannot_be_a_modulus []) - (#try.Success (:abstraction value)))) - - (def: .public divisor - (All (_ %) (-> (Modulus %) Int)) - (|>> :representation)) - - (def: .public (= reference subject) - (All (_ %r %s) (-> (Modulus %r) (Modulus %s) Bit)) - (i.= (:representation reference) - (:representation subject))) - - (def: .public (congruent? modulus reference subject) - (All (_ %) (-> (Modulus %) Int Int Bit)) - (|> subject - (i.- reference) - (i.% (:representation modulus)) - (i.= +0))) + [(def: .public (modulus value) + (Ex (_ %) (-> Int (Try (Modulus %)))) + (if (i.= +0 value) + (exception.except ..zero_cannot_be_a_modulus []) + (#try.Success (:abstraction value)))) + + (def: .public divisor + (All (_ %) (-> (Modulus %) Int)) + (|>> :representation)) + + (def: .public (= reference subject) + (All (_ %r %s) (-> (Modulus %r) (Modulus %s) Bit)) + (i.= (:representation reference) + (:representation subject))) + + (def: .public (congruent? modulus reference subject) + (All (_ %) (-> (Modulus %) Int Int Bit)) + (|> subject + (i.- reference) + (i.% (:representation modulus)) + (i.= +0)))] ) (syntax: .public (literal [divisor <code>.int]) diff --git a/stdlib/source/library/lux/target/common_lisp.lux b/stdlib/source/library/lux/target/common_lisp.lux index db711eabf..a208ba0ff 100644 --- a/stdlib/source/library/lux/target/common_lisp.lux +++ b/stdlib/source/library/lux/target/common_lisp.lux @@ -21,450 +21,448 @@ (text.enclosed ["(" ")"])) (abstract: .public (Code brand) - {} - Text - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: .public (<brand> brand) {} Any)) - (`` (type: .public (<type> brand) - (<super> (<brand> brand)))))] - - [Expression Code] - [Computation Expression] - [Access Computation] - [Var Access] - - [Input Code] - ) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: .public <brand> {} Any)) - (`` (type: .public <type> (<super> <brand>))))] - - [Label Code] - [Tag Expression] - [Literal Expression] - [Var/1 Var] - [Var/* Input] - ) - - (type: .public Lambda - (Record - [#input Var/* - #output (Expression Any)])) - - (def: .public nil - Literal - (:abstraction "()")) - - (template [<prefix> <name>] - [(def: .public <name> - (-> Text Literal) - (|>> (format <prefix>) :abstraction))] - - ["'" symbol] - [":" keyword]) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 ..nil - #1 (..symbol "t")))) - - (def: .public int - (-> Int Literal) - (|>> %.int :abstraction)) - - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "(/ 1.0 0.0)" [])] - - [(f.= f.negative_infinity)] - [(new> "(/ -1.0 0.0)" [])] - - [f.not_a_number?] - [(new> "(/ 0.0 0.0)" [])] - - ... else - [%.frac]) + [(def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: .public (<brand> brand) Any [])) + (`` (type: .public (<type> brand) + (<super> (<brand> brand)))))] + + [Expression Code] + [Computation Expression] + [Access Computation] + [Var Access] + + [Input Code] + ) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: .public <brand> Any [])) + (`` (type: .public <type> (<super> <brand>))))] + + [Label Code] + [Tag Expression] + [Literal Expression] + [Var/1 Var] + [Var/* Input] + ) + + (type: .public Lambda + (Record + [#input Var/* + #output (Expression Any)])) + + (def: .public nil + Literal + (:abstraction "()")) + + (template [<prefix> <name>] + [(def: .public <name> + (-> Text Literal) + (|>> (format <prefix>) :abstraction))] + + ["'" symbol] + [":" keyword]) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 ..nil + #1 (..symbol "t")))) + + (def: .public int + (-> Int Literal) + (|>> %.int :abstraction)) + + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "(/ 1.0 0.0)" [])] + + [(f.= f.negative_infinity)] + [(new> "(/ -1.0 0.0)" [])] + + [f.not_a_number?] + [(new> "(/ 0.0 0.0)" [])] + + ... else + [%.frac]) + :abstraction)) + + (def: .public (double value) + (-> Frac Literal) + (:abstraction + (.cond (f.= f.positive_infinity value) + "(/ 1.0d0 0.0d0)" + + (f.= f.negative_infinity value) + "(/ -1.0d0 0.0d0)" + + (f.not_a_number? value) + "(/ 0.0d0 0.0d0)" + + ... else + (.let [raw (%.frac value)] + (.if (text.contains? "E" raw) + (text.replaced/1 "E" "d" raw) + (format raw "d0")))))) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed' text.double_quote) + :abstraction)) + + (def: .public var + (-> Text Var/1) + (|>> :abstraction)) + + (def: .public args + (-> (List Var/1) Var/*) + (|>> (list\each ..code) + (text.interposed " ") + ..as_form + :abstraction)) + + (def: .public (args& singles rest) + (-> (List Var/1) Var/1 Var/*) + (|> (case singles + #.End + "" + + (#.Item _) + (|> singles + (list\each ..code) + (text.interposed " ") + (text.suffix " "))) + (format "&rest " (:representation rest)) + ..as_form :abstraction)) - (def: .public (double value) - (-> Frac Literal) - (:abstraction - (.cond (f.= f.positive_infinity value) - "(/ 1.0d0 0.0d0)" - - (f.= f.negative_infinity value) - "(/ -1.0d0 0.0d0)" + (def: form + (-> (List (Expression Any)) Expression) + (|>> (list\each ..code) + (text.interposed " ") + ..as_form + :abstraction)) + + (def: .public (call/* func) + (-> (Expression Any) (-> (List (Expression Any)) (Computation Any))) + (|>> (#.Item func) ..form)) + + (template [<name> <function>] + [(def: .public <name> + (-> (List (Expression Any)) (Computation Any)) + (..call/* (..var <function>)))] + + [vector/* "vector"] + [list/* "list"] + ) + + (def: .public (labels definitions body) + (-> (List [Var/1 Lambda]) (Expression Any) (Computation Any)) + (..form (list (..var "labels") + (..form (list\each (function (_ [def_name [def_args def_body]]) + (..form (list def_name (:transmutation def_args) def_body))) + definitions)) + body))) + + (def: .public (destructuring_bind [bindings expression] body) + (-> [Var/* (Expression Any)] (List (Expression Any)) (Computation Any)) + (..form (list& (..var "destructuring-bind") + (:transmutation bindings) expression + body))) + + (template [<call> <input_var>+ <input_type>+ <function>+] + [(`` (def: .public (<call> [(~~ (template.spliced <input_var>+))] function) + (-> [(~~ (template.spliced <input_type>+))] (Expression Any) (Computation Any)) + (..call/* function (list (~~ (template.spliced <input_var>+)))))) + + (`` (template [<lux_name> <host_name>] + [(def: .public (<lux_name> args) + (-> [(~~ (template.spliced <input_type>+))] (Computation Any)) + (<call> args (..var <host_name>)))] - (f.not_a_number? value) - "(/ 0.0d0 0.0d0)" + (~~ (template.spliced <function>+))))] + + [call/0 [] [] + [[get_universal_time/0 "get-universal-time"] + [make_hash_table/0 "make-hash-table"]]] + [call/1 [in0] [(Expression Any)] + [[length/1 "length"] + [function/1 "function"] + [copy_seq/1 "copy-seq"] + [null/1 "null"] + [error/1 "error"] + [not/1 "not"] + [floor/1 "floor"] + [type_of/1 "type-of"] + [write_to_string/1 "write-to-string"] + [read_from_string/1 "read-from-string"] + [print/1 "print"] + [reverse/1 "reverse"] + [sxhash/1 "sxhash"] + [string_upcase/1 "string-upcase"] + [string_downcase/1 "string-downcase"] + [char_int/1 "char-int"] + [text/1 "text"] + [hash_table_size/1 "hash-table-size"] + [hash_table_rehash_size/1 "hash-table-rehash-size"] + [code_char/1 "code-char"] + [char_code/1 "char-code"] + [string/1 "string"] + [write_line/1 "write-line"] + [pprint/1 "pprint"] + [identity/1 "identity"]]] + [call/2 [in0 in1] [(Expression Any) (Expression Any)] + [[apply/2 "apply"] + [append/2 "append"] + [cons/2 "cons"] + [char/2 "char"] + [nth/2 "nth"] + [nthcdr/2 "nthcdr"] + [coerce/2 "coerce"] + [eq/2 "eq"] + [equal/2 "equal"] + [string=/2 "string="] + [=/2 "="] + [+/2 "+"] + [*/2 "*"]]] + [call/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)] + [[subseq/3 "subseq"] + [map/3 "map"] + [concatenate/3 "concatenate"] + [format/3 "format"]]] + ) + + (template [<call> <input_type>+ <function>+] + [(`` (template [<lux_name> <host_name>] + [(def: .public (<lux_name> args) + (-> [(~~ (template.spliced <input_type>+))] (Access Any)) + (:transmutation (<call> args (..var <host_name>))))] - ... else - (.let [raw (%.frac value)] - (.if (text.contains? "E" raw) - (text.replaced/1 "E" "d" raw) - (format raw "d0")))))) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed' text.double_quote) - :abstraction)) - - (def: .public var - (-> Text Var/1) - (|>> :abstraction)) - - (def: .public args - (-> (List Var/1) Var/*) - (|>> (list\each ..code) - (text.interposed " ") - ..as_form - :abstraction)) - - (def: .public (args& singles rest) - (-> (List Var/1) Var/1 Var/*) - (|> (case singles + (~~ (template.spliced <function>+))))] + + [call/1 [(Expression Any)] + [[car/1 "car"] + [cdr/1 "cdr"] + [cadr/1 "cadr"] + [cddr/1 "cddr"]]] + [call/2 [(Expression Any) (Expression Any)] + [[svref/2 "svref"] + [elt/2 "elt"] + [gethash/2 "gethash"]]] + ) + + (def: .public (make_hash_table/with_size size) + (-> (Expression Any) (Computation Any)) + (..call/* (..var "make-hash-table") + (list (..keyword "size") + size))) + + (def: .public (funcall/+ [func args]) + (-> [(Expression Any) (List (Expression Any))] (Computation Any)) + (..call/* (..var "funcall") (list& func args))) + + (def: .public (search/3 [reference space start]) + (-> [(Expression Any) (Expression Any) (Expression Any)] (Computation Any)) + (..call/* (..var "search") + (list reference + space + (..keyword "start2") start))) + + (def: .public (concatenate/2|string [left right]) + (-> [(Expression Any) (Expression Any)] (Computation Any)) + (concatenate/3 [(..symbol "string") left right])) + + (template [<lux_name> <host_name>] + [(def: .public (<lux_name> left right) + (-> (Expression Any) (Expression Any) (Computation Any)) + (..form (list (..var <host_name>) left right)))] + + [or "or"] + [and "and"] + ) + + (template [<lux_name> <host_name>] + [(def: .public (<lux_name> [param subject]) + (-> [(Expression Any) (Expression Any)] (Computation Any)) + (..form (list (..var <host_name>) subject param)))] + + [</2 "<"] + [<=/2 "<="] + [>/2 ">"] + [>=/2 ">="] + [string</2 "string<"] + [-/2 "-"] + [//2 "/"] + [rem/2 "rem"] + [floor/2 "floor"] + [mod/2 "mod"] + [ash/2 "ash"] + [logand/2 "logand"] + [logior/2 "logior"] + [logxor/2 "logxor"] + ) + + (def: .public (if test then else) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (..form (list (..var "if") test then else))) + + (def: .public (when test then) + (-> (Expression Any) (Expression Any) (Computation Any)) + (..form (list (..var "when") test then))) + + (def: .public (lambda input body) + (-> Var/* (Expression Any) Literal) + (..form (list (..var "lambda") (:transmutation input) body))) + + (template [<lux_name> <host_name>] + [(def: .public (<lux_name> bindings body) + (-> (List [Var/1 (Expression Any)]) (List (Expression Any)) (Computation Any)) + (..form (list& (..var <host_name>) + (|> bindings + (list\each (function (_ [name value]) + (..form (list name value)))) + ..form) + body)))] + + [let "let"] + [let* "let*"] + ) + + (def: .public (defparameter name body) + (-> Var/1 (Expression Any) (Expression Any)) + (..form (list (..var "defparameter") name body))) + + (def: .public (defun name inputs body) + (-> Var/1 Var/* (Expression Any) (Expression Any)) + (..form (list (..var "defun") name (:transmutation inputs) body))) + + (template [<name> <symbol>] + [(def: .public <name> + (-> (List (Expression Any)) (Computation Any)) + (|>> (list& (..var <symbol>)) ..form))] + + [progn "progn"] + [tagbody "tagbody"] + [values/* "values"] + ) + + (def: .public (setq name value) + (-> Var/1 (Expression Any) (Expression Any)) + (..form (list (..var "setq") name value))) + + (def: .public (setf access value) + (-> (Access Any) (Expression Any) (Expression Any)) + (..form (list (..var "setf") access value))) + + (type: .public Handler + (Record + [#condition_type (Expression Any) + #condition Var/1 + #body (Expression Any)])) + + (def: .public (handler_case handlers body) + (-> (List Handler) (Expression Any) (Computation Any)) + (..form (list& (..var "handler-case") + body + (list\each (function (_ [type condition handler]) + (..form (list type + (:transmutation (..args (list condition))) + handler))) + handlers)))) + + (template [<name> <prefix>] + [(def: .public (<name> conditions expression) + (-> (List Text) (Expression Any) (Expression Any)) + (case conditions #.End - "" + expression - (#.Item _) - (|> singles - (list\each ..code) - (text.interposed " ") - (text.suffix " "))) - (format "&rest " (:representation rest)) - ..as_form - :abstraction)) - - (def: form - (-> (List (Expression Any)) Expression) - (|>> (list\each ..code) - (text.interposed " ") - ..as_form - :abstraction)) - - (def: .public (call/* func) - (-> (Expression Any) (-> (List (Expression Any)) (Computation Any))) - (|>> (#.Item func) ..form)) - - (template [<name> <function>] - [(def: .public <name> - (-> (List (Expression Any)) (Computation Any)) - (..call/* (..var <function>)))] - - [vector/* "vector"] - [list/* "list"] - ) - - (def: .public (labels definitions body) - (-> (List [Var/1 Lambda]) (Expression Any) (Computation Any)) - (..form (list (..var "labels") - (..form (list\each (function (_ [def_name [def_args def_body]]) - (..form (list def_name (:transmutation def_args) def_body))) - definitions)) - body))) - - (def: .public (destructuring_bind [bindings expression] body) - (-> [Var/* (Expression Any)] (List (Expression Any)) (Computation Any)) - (..form (list& (..var "destructuring-bind") - (:transmutation bindings) expression - body))) - - (template [<call> <input_var>+ <input_type>+ <function>+] - [(`` (def: .public (<call> [(~~ (template.spliced <input_var>+))] function) - (-> [(~~ (template.spliced <input_type>+))] (Expression Any) (Computation Any)) - (..call/* function (list (~~ (template.spliced <input_var>+)))))) - - (`` (template [<lux_name> <host_name>] - [(def: .public (<lux_name> args) - (-> [(~~ (template.spliced <input_type>+))] (Computation Any)) - (<call> args (..var <host_name>)))] - - (~~ (template.spliced <function>+))))] - - [call/0 [] [] - [[get_universal_time/0 "get-universal-time"] - [make_hash_table/0 "make-hash-table"]]] - [call/1 [in0] [(Expression Any)] - [[length/1 "length"] - [function/1 "function"] - [copy_seq/1 "copy-seq"] - [null/1 "null"] - [error/1 "error"] - [not/1 "not"] - [floor/1 "floor"] - [type_of/1 "type-of"] - [write_to_string/1 "write-to-string"] - [read_from_string/1 "read-from-string"] - [print/1 "print"] - [reverse/1 "reverse"] - [sxhash/1 "sxhash"] - [string_upcase/1 "string-upcase"] - [string_downcase/1 "string-downcase"] - [char_int/1 "char-int"] - [text/1 "text"] - [hash_table_size/1 "hash-table-size"] - [hash_table_rehash_size/1 "hash-table-rehash-size"] - [code_char/1 "code-char"] - [char_code/1 "char-code"] - [string/1 "string"] - [write_line/1 "write-line"] - [pprint/1 "pprint"] - [identity/1 "identity"]]] - [call/2 [in0 in1] [(Expression Any) (Expression Any)] - [[apply/2 "apply"] - [append/2 "append"] - [cons/2 "cons"] - [char/2 "char"] - [nth/2 "nth"] - [nthcdr/2 "nthcdr"] - [coerce/2 "coerce"] - [eq/2 "eq"] - [equal/2 "equal"] - [string=/2 "string="] - [=/2 "="] - [+/2 "+"] - [*/2 "*"]]] - [call/3 [in0 in1 in2] [(Expression Any) (Expression Any) (Expression Any)] - [[subseq/3 "subseq"] - [map/3 "map"] - [concatenate/3 "concatenate"] - [format/3 "format"]]] - ) - - (template [<call> <input_type>+ <function>+] - [(`` (template [<lux_name> <host_name>] - [(def: .public (<lux_name> args) - (-> [(~~ (template.spliced <input_type>+))] (Access Any)) - (:transmutation (<call> args (..var <host_name>))))] - - (~~ (template.spliced <function>+))))] - - [call/1 [(Expression Any)] - [[car/1 "car"] - [cdr/1 "cdr"] - [cadr/1 "cadr"] - [cddr/1 "cddr"]]] - [call/2 [(Expression Any) (Expression Any)] - [[svref/2 "svref"] - [elt/2 "elt"] - [gethash/2 "gethash"]]] - ) - - (def: .public (make_hash_table/with_size size) - (-> (Expression Any) (Computation Any)) - (..call/* (..var "make-hash-table") - (list (..keyword "size") - size))) - - (def: .public (funcall/+ [func args]) - (-> [(Expression Any) (List (Expression Any))] (Computation Any)) - (..call/* (..var "funcall") (list& func args))) - - (def: .public (search/3 [reference space start]) - (-> [(Expression Any) (Expression Any) (Expression Any)] (Computation Any)) - (..call/* (..var "search") - (list reference - space - (..keyword "start2") start))) - - (def: .public (concatenate/2|string [left right]) - (-> [(Expression Any) (Expression Any)] (Computation Any)) - (concatenate/3 [(..symbol "string") left right])) - - (template [<lux_name> <host_name>] - [(def: .public (<lux_name> left right) - (-> (Expression Any) (Expression Any) (Computation Any)) - (..form (list (..var <host_name>) left right)))] - - [or "or"] - [and "and"] - ) - - (template [<lux_name> <host_name>] - [(def: .public (<lux_name> [param subject]) - (-> [(Expression Any) (Expression Any)] (Computation Any)) - (..form (list (..var <host_name>) subject param)))] - - [</2 "<"] - [<=/2 "<="] - [>/2 ">"] - [>=/2 ">="] - [string</2 "string<"] - [-/2 "-"] - [//2 "/"] - [rem/2 "rem"] - [floor/2 "floor"] - [mod/2 "mod"] - [ash/2 "ash"] - [logand/2 "logand"] - [logior/2 "logior"] - [logxor/2 "logxor"] - ) - - (def: .public (if test then else) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) - (..form (list (..var "if") test then else))) - - (def: .public (when test then) - (-> (Expression Any) (Expression Any) (Computation Any)) - (..form (list (..var "when") test then))) - - (def: .public (lambda input body) - (-> Var/* (Expression Any) Literal) - (..form (list (..var "lambda") (:transmutation input) body))) - - (template [<lux_name> <host_name>] - [(def: .public (<lux_name> bindings body) - (-> (List [Var/1 (Expression Any)]) (List (Expression Any)) (Computation Any)) - (..form (list& (..var <host_name>) - (|> bindings - (list\each (function (_ [name value]) - (..form (list name value)))) - ..form) - body)))] - - [let "let"] - [let* "let*"] - ) - - (def: .public (defparameter name body) - (-> Var/1 (Expression Any) (Expression Any)) - (..form (list (..var "defparameter") name body))) - - (def: .public (defun name inputs body) - (-> Var/1 Var/* (Expression Any) (Expression Any)) - (..form (list (..var "defun") name (:transmutation inputs) body))) - - (template [<name> <symbol>] - [(def: .public <name> - (-> (List (Expression Any)) (Computation Any)) - (|>> (list& (..var <symbol>)) ..form))] - - [progn "progn"] - [tagbody "tagbody"] - [values/* "values"] - ) - - (def: .public (setq name value) - (-> Var/1 (Expression Any) (Expression Any)) - (..form (list (..var "setq") name value))) - - (def: .public (setf access value) - (-> (Access Any) (Expression Any) (Expression Any)) - (..form (list (..var "setf") access value))) - - (type: .public Handler - (Record - [#condition_type (Expression Any) - #condition Var/1 - #body (Expression Any)])) - - (def: .public (handler_case handlers body) - (-> (List Handler) (Expression Any) (Computation Any)) - (..form (list& (..var "handler-case") - body - (list\each (function (_ [type condition handler]) - (..form (list type - (:transmutation (..args (list condition))) - handler))) - handlers)))) - - (template [<name> <prefix>] - [(def: .public (<name> conditions expression) - (-> (List Text) (Expression Any) (Expression Any)) - (case conditions - #.End - expression - - (#.Item single #.End) - (:abstraction - (format <prefix> single " " (:representation expression))) - - _ - (:abstraction - (format <prefix> (|> conditions (list\each ..symbol) - (list& (..symbol "or")) ..form - :representation) - " " (:representation expression)))))] - - [conditional+ "#+"] - [conditional- "#-"]) - - (def: .public label - (-> Text Label) - (|>> :abstraction)) - - (def: .public (block name body) - (-> Label (List (Expression Any)) (Computation Any)) - (..form (list& (..var "block") (:transmutation name) body))) - - (def: .public (return_from target value) - (-> Label (Expression Any) (Computation Any)) - (..form (list (..var "return-from") (:transmutation target) value))) - - (def: .public (return value) - (-> (Expression Any) (Computation Any)) - (..form (list (..var "return") value))) - - (def: .public (cond clauses else) - (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any)) - (..form (list& (..var "cond") - (list\composite (list\each (function (_ [test then]) - (..form (list test then))) - clauses) - (list (..form (list (..bool true) else))))))) - - (def: .public tag - (-> Text Tag) - (|>> :abstraction)) - - (def: .public go - (-> Tag (Expression Any)) - (|>> (list (..var "go")) - ..form)) - - (def: .public values_list/1 - (-> (Expression Any) (Expression Any)) - (|>> (list (..var "values-list")) - ..form)) - - (def: .public (multiple_value_setq bindings values) - (-> Var/* (Expression Any) (Expression Any)) - (..form (list (..var "multiple-value-setq") - (:transmutation bindings) - values))) + (#.Item single #.End) + (:abstraction + (format <prefix> single " " (:representation expression))) + + _ + (:abstraction + (format <prefix> (|> conditions (list\each ..symbol) + (list& (..symbol "or")) ..form + :representation) + " " (:representation expression)))))] + + [conditional+ "#+"] + [conditional- "#-"]) + + (def: .public label + (-> Text Label) + (|>> :abstraction)) + + (def: .public (block name body) + (-> Label (List (Expression Any)) (Computation Any)) + (..form (list& (..var "block") (:transmutation name) body))) + + (def: .public (return_from target value) + (-> Label (Expression Any) (Computation Any)) + (..form (list (..var "return-from") (:transmutation target) value))) + + (def: .public (return value) + (-> (Expression Any) (Computation Any)) + (..form (list (..var "return") value))) + + (def: .public (cond clauses else) + (-> (List [(Expression Any) (Expression Any)]) (Expression Any) (Computation Any)) + (..form (list& (..var "cond") + (list\composite (list\each (function (_ [test then]) + (..form (list test then))) + clauses) + (list (..form (list (..bool true) else))))))) + + (def: .public tag + (-> Text Tag) + (|>> :abstraction)) + + (def: .public go + (-> Tag (Expression Any)) + (|>> (list (..var "go")) + ..form)) + + (def: .public values_list/1 + (-> (Expression Any) (Expression Any)) + (|>> (list (..var "values-list")) + ..form)) + + (def: .public (multiple_value_setq bindings values) + (-> Var/* (Expression Any) (Expression Any)) + (..form (list (..var "multiple-value-setq") + (:transmutation bindings) + values)))] ) (def: .public (while condition body) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index d6eff28b5..3f0233f62 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -29,392 +29,390 @@ (text.replaced text.new_line (format text.new_line text.tab)))) (abstract: .public (Code brand) - {} - Text - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) {} Any) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: <brand> {} Any) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Var [Location' Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [Literal [Computation' Expression' Code]] - [Loop [Statement' Code]] - [Label [Code]] - ) - - (template [<name> <literal>] - [(def: .public <name> Literal (:abstraction <literal>))] - - [null "null"] - [undefined "undefined"] - ) - - (def: .public boolean - (-> Bit Literal) - (|>> (case> - #0 "false" - #1 "true") + [(def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any []) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: <brand> Any []) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Var [Location' Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [Literal [Computation' Expression' Code]] + [Loop [Statement' Code]] + [Label [Code]] + ) + + (template [<name> <literal>] + [(def: .public <name> Literal (:abstraction <literal>))] + + [null "null"] + [undefined "undefined"] + ) + + (def: .public boolean + (-> Bit Literal) + (|>> (case> + #0 "false" + #1 "true") + :abstraction)) + + (def: .public (number value) + (-> Frac Literal) + (:abstraction + (.cond (f.not_a_number? value) + "NaN" + + (f.= f.positive_infinity value) + "Infinity" + + (f.= f.negative_infinity value) + "-Infinity" + + ... else + (|> value %.frac ..expression)))) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<replace> <find>] + [(text.replaced <find> <replace>)] + + ["\\" "\"] + ["\t" text.tab] + ["\v" text.vertical_tab] + ["\0" text.null] + ["\b" text.back_space] + ["\f" text.form_feed] + ["\n" text.new_line] + ["\r" text.carriage_return] + [(format "\" text.double_quote) + text.double_quote] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed [text.double_quote text.double_quote]) + :abstraction)) + + (def: argument_separator ", ") + (def: field_separator ": ") + (def: statement_suffix ";") + + (def: .public array + (-> (List Expression) Computation) + (|>> (list\each ..code) + (text.interposed ..argument_separator) + ..element + :abstraction)) + + (def: .public var + (-> Text Var) + (|>> :abstraction)) + + (def: .public (at index array_or_object) + (-> Expression Expression Access) + (:abstraction (format (:representation array_or_object) (..element (:representation index))))) + + (def: .public (the field object) + (-> Text Expression Access) + (:abstraction (format (:representation object) "." field))) + + (def: .public (apply/* function inputs) + (-> Expression (List Expression) Computation) + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression + (format (:representation function)) :abstraction)) - (def: .public (number value) - (-> Frac Literal) - (:abstraction - (.cond (f.not_a_number? value) - "NaN" - - (f.= f.positive_infinity value) - "Infinity" - - (f.= f.negative_infinity value) - "-Infinity" - - ... else - (|> value %.frac ..expression)))) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<replace> <find>] - [(text.replaced <find> <replace>)] - - ["\\" "\"] - ["\t" text.tab] - ["\v" text.vertical_tab] - ["\0" text.null] - ["\b" text.back_space] - ["\f" text.form_feed] - ["\n" text.new_line] - ["\r" text.carriage_return] - [(format "\" text.double_quote) - text.double_quote] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed [text.double_quote text.double_quote]) + (def: .public (do method inputs object) + (-> Text (List Expression) Expression Computation) + (apply/* (..the method object) inputs)) + + (def: .public object + (-> (List [Text Expression]) Computation) + (|>> (list\each (.function (_ [key val]) + (format (:representation (..string key)) ..field_separator (:representation val)))) + (text.interposed ..argument_separator) + (text.enclosed ["{" "}"]) + ..expression + :abstraction)) + + (def: .public (, pre post) + (-> Expression Expression Computation) + (|> (format (:representation pre) ..argument_separator (:representation post)) + ..expression :abstraction)) - (def: argument_separator ", ") - (def: field_separator ": ") - (def: statement_suffix ";") + (def: .public (then pre post) + (-> Statement Statement Statement) + (:abstraction (format (:representation pre) + text.new_line + (:representation post)))) - (def: .public array - (-> (List Expression) Computation) - (|>> (list\each ..code) - (text.interposed ..argument_separator) - ..element + (def: block + (-> Statement Text) + (let [close (format text.new_line "}")] + (|>> :representation + ..nested + (text.enclosed ["{" + close])))) + + (def: .public (function! name inputs body) + (-> Var (List Var) Statement Statement) + (|> body + ..block + (format "function " (:representation name) + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression) + " ") :abstraction)) - (def: .public var - (-> Text Var) - (|>> :abstraction)) - - (def: .public (at index array_or_object) - (-> Expression Expression Access) - (:abstraction (format (:representation array_or_object) (..element (:representation index))))) - - (def: .public (the field object) - (-> Text Expression Access) - (:abstraction (format (:representation object) "." field))) - - (def: .public (apply/* function inputs) - (-> Expression (List Expression) Computation) - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression - (format (:representation function)) - :abstraction)) - - (def: .public (do method inputs object) - (-> Text (List Expression) Expression Computation) - (apply/* (..the method object) inputs)) - - (def: .public object - (-> (List [Text Expression]) Computation) - (|>> (list\each (.function (_ [key val]) - (format (:representation (..string key)) ..field_separator (:representation val)))) - (text.interposed ..argument_separator) - (text.enclosed ["{" "}"]) + (def: .public (function name inputs body) + (-> Var (List Var) Statement Computation) + (|> (..function! name inputs body) + :representation ..expression :abstraction)) - (def: .public (, pre post) - (-> Expression Expression Computation) - (|> (format (:representation pre) ..argument_separator (:representation post)) - ..expression - :abstraction)) - - (def: .public (then pre post) - (-> Statement Statement Statement) - (:abstraction (format (:representation pre) - text.new_line - (:representation post)))) - - (def: block - (-> Statement Text) - (let [close (format text.new_line "}")] - (|>> :representation - ..nested - (text.enclosed ["{" - close])))) - - (def: .public (function! name inputs body) - (-> Var (List Var) Statement Statement) - (|> body - ..block - (format "function " (:representation name) - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression) - " ") - :abstraction)) - - (def: .public (function name inputs body) - (-> Var (List Var) Statement Computation) - (|> (..function! name inputs body) - :representation - ..expression - :abstraction)) - - (def: .public (closure inputs body) - (-> (List Var) Statement Computation) - (|> body - ..block - (format "function" - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression) - " ") - ..expression - :abstraction)) - - (template [<name> <op>] - [(def: .public (<name> param subject) - (-> Expression Expression Computation) - (|> (format (:representation subject) " " <op> " " (:representation param)) - ..expression - :abstraction))] - - [= "==="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [% "%"] - - [left_shift "<<"] - [arithmetic_right_shift ">>"] - [logic_right_shift ">>>"] - - [or "||"] - [and "&&"] - [bit_xor "^"] - [bit_or "|"] - [bit_and "&"] - ) - - (template [<name> <prefix>] - [(def: .public <name> - (-> Expression Computation) - (|>> :representation (text.prefix <prefix>) ..expression :abstraction))] - - [not "!"] - [bit_not "~"] - [opposite "-"] - ) - - (template [<name> <input> <format>] - [(def: .public (<name> value) - {#.doc "A 32-bit integer expression."} - (-> <input> Computation) - (:abstraction (..expression (format (<format> value) "|0"))))] - - [to_i32 Expression :representation] - [i32 Int %.int] - ) - - (def: .public (int value) - (-> Int Literal) - (:abstraction (.if (i.< +0 value) - (%.int value) - (%.nat (.nat value))))) - - (def: .public (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (:representation test) - " ? " (:representation then) - " : " (:representation else)) - ..expression - :abstraction)) - - (def: .public type_of - (-> Expression Computation) - (|>> :representation - (format "typeof ") + (def: .public (closure inputs body) + (-> (List Var) Statement Computation) + (|> body + ..block + (format "function" + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression) + " ") ..expression :abstraction)) - (def: .public (new constructor inputs) - (-> Expression (List Expression) Computation) - (|> (format "new " (:representation constructor) - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression)) - ..expression - :abstraction)) - - (def: .public statement - (-> Expression Statement) - (|>> :representation (text.suffix ..statement_suffix) :abstraction)) - - (def: .public use_strict - Statement - (:abstraction (format text.double_quote "use strict" text.double_quote ..statement_suffix))) - - (def: .public (declare name) - (-> Var Statement) - (:abstraction (format "var " (:representation name) ..statement_suffix))) - - (def: .public (define name value) - (-> Var Expression Statement) - (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement_suffix))) - - (def: .public (set name value) - (-> Location Expression Statement) - (:abstraction (format (:representation name) " = " (:representation value) ..statement_suffix))) - - (def: .public (throw message) - (-> Expression Statement) - (:abstraction (format "throw " (:representation message) ..statement_suffix))) - - (def: .public (return value) - (-> Expression Statement) - (:abstraction (format "return " (:representation value) ..statement_suffix))) - - (def: .public (delete value) - (-> Location Statement) - (:abstraction (format "delete " (:representation value) ..statement_suffix))) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (:abstraction (format "if(" (:representation test) ") " - (..block then!) - " else " - (..block else!)))) - - (def: .public (when test then!) - (-> Expression Statement Statement) - (:abstraction (format "if(" (:representation test) ") " - (..block then!)))) - - (def: .public (while test body) - (-> Expression Statement Loop) - (:abstraction (format "while(" (:representation test) ") " - (..block body)))) - - (def: .public (do_while test body) - (-> Expression Statement Loop) - (:abstraction (format "do " (..block body) - " while(" (:representation test) ")" ..statement_suffix))) - - (def: .public (try body [exception catch]) - (-> Statement [Var Statement] Statement) - (:abstraction (format "try " - (..block body) - " catch(" (:representation exception) ") " - (..block catch)))) - - (def: .public (for var init condition update iteration) - (-> Var Expression Expression Expression Statement Loop) - (:abstraction (format "for(" (:representation (..define var init)) - " " (:representation condition) - ..statement_suffix " " (:representation update) - ")" - (..block iteration)))) - - (def: .public label - (-> Text Label) - (|>> :abstraction)) - - (def: .public (with_label label loop) - (-> Label Loop Statement) - (:abstraction (format (:representation label) ": " (:representation loop)))) - - (template [<keyword> <0> <1>] - [(def: .public <0> - Statement - (:abstraction (format <keyword> ..statement_suffix))) - - (def: .public (<1> label) - (-> Label Statement) - (:abstraction (format <keyword> " " (:representation label) ..statement_suffix)))] - - ["break" break break_at] - ["continue" continue continue_at] - ) - - (template [<name> <js>] - [(def: .public <name> - (-> Location Expression) - (|>> :representation - (text.suffix <js>) + (template [<name> <op>] + [(def: .public (<name> param subject) + (-> Expression Expression Computation) + (|> (format (:representation subject) " " <op> " " (:representation param)) + ..expression :abstraction))] - [++ "++"] - [-- "--"] - ) - - (def: .public (comment commentary on) - (All (_ kind) (-> Text (Code kind) (Code kind))) - (:abstraction (format "/* " commentary " */" " " (:representation on)))) - - (def: .public (switch input cases default) - (-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement) - (:abstraction (format "switch (" (:representation input) ") " - (|> (format (|> cases - (list\each (.function (_ [when then]) - (format (|> when - (list\each (|>> :representation (text.enclosed ["case " ":"]))) - (text.interposed text.new_line)) - (..nested (:representation then))))) - (text.interposed text.new_line)) - text.new_line - (case default - (#.Some default) - (format "default:" - (..nested (:representation default))) - - #.None "")) - :abstraction - ..block)))) + [= "==="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [% "%"] + + [left_shift "<<"] + [arithmetic_right_shift ">>"] + [logic_right_shift ">>>"] + + [or "||"] + [and "&&"] + [bit_xor "^"] + [bit_or "|"] + [bit_and "&"] + ) + + (template [<name> <prefix>] + [(def: .public <name> + (-> Expression Computation) + (|>> :representation (text.prefix <prefix>) ..expression :abstraction))] + + [not "!"] + [bit_not "~"] + [opposite "-"] + ) + + (template [<name> <input> <format>] + [(def: .public (<name> value) + {#.doc "A 32-bit integer expression."} + (-> <input> Computation) + (:abstraction (..expression (format (<format> value) "|0"))))] + + [to_i32 Expression :representation] + [i32 Int %.int] + ) + + (def: .public (int value) + (-> Int Literal) + (:abstraction (.if (i.< +0 value) + (%.int value) + (%.nat (.nat value))))) + + (def: .public (? test then else) + (-> Expression Expression Expression Computation) + (|> (format (:representation test) + " ? " (:representation then) + " : " (:representation else)) + ..expression + :abstraction)) + + (def: .public type_of + (-> Expression Computation) + (|>> :representation + (format "typeof ") + ..expression + :abstraction)) + + (def: .public (new constructor inputs) + (-> Expression (List Expression) Computation) + (|> (format "new " (:representation constructor) + (|> inputs + (list\each ..code) + (text.interposed ..argument_separator) + ..expression)) + ..expression + :abstraction)) + + (def: .public statement + (-> Expression Statement) + (|>> :representation (text.suffix ..statement_suffix) :abstraction)) + + (def: .public use_strict + Statement + (:abstraction (format text.double_quote "use strict" text.double_quote ..statement_suffix))) + + (def: .public (declare name) + (-> Var Statement) + (:abstraction (format "var " (:representation name) ..statement_suffix))) + + (def: .public (define name value) + (-> Var Expression Statement) + (:abstraction (format "var " (:representation name) " = " (:representation value) ..statement_suffix))) + + (def: .public (set name value) + (-> Location Expression Statement) + (:abstraction (format (:representation name) " = " (:representation value) ..statement_suffix))) + + (def: .public (throw message) + (-> Expression Statement) + (:abstraction (format "throw " (:representation message) ..statement_suffix))) + + (def: .public (return value) + (-> Expression Statement) + (:abstraction (format "return " (:representation value) ..statement_suffix))) + + (def: .public (delete value) + (-> Location Statement) + (:abstraction (format "delete " (:representation value) ..statement_suffix))) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (:abstraction (format "if(" (:representation test) ") " + (..block then!) + " else " + (..block else!)))) + + (def: .public (when test then!) + (-> Expression Statement Statement) + (:abstraction (format "if(" (:representation test) ") " + (..block then!)))) + + (def: .public (while test body) + (-> Expression Statement Loop) + (:abstraction (format "while(" (:representation test) ") " + (..block body)))) + + (def: .public (do_while test body) + (-> Expression Statement Loop) + (:abstraction (format "do " (..block body) + " while(" (:representation test) ")" ..statement_suffix))) + + (def: .public (try body [exception catch]) + (-> Statement [Var Statement] Statement) + (:abstraction (format "try " + (..block body) + " catch(" (:representation exception) ") " + (..block catch)))) + + (def: .public (for var init condition update iteration) + (-> Var Expression Expression Expression Statement Loop) + (:abstraction (format "for(" (:representation (..define var init)) + " " (:representation condition) + ..statement_suffix " " (:representation update) + ")" + (..block iteration)))) + + (def: .public label + (-> Text Label) + (|>> :abstraction)) + + (def: .public (with_label label loop) + (-> Label Loop Statement) + (:abstraction (format (:representation label) ": " (:representation loop)))) + + (template [<keyword> <0> <1>] + [(def: .public <0> + Statement + (:abstraction (format <keyword> ..statement_suffix))) + + (def: .public (<1> label) + (-> Label Statement) + (:abstraction (format <keyword> " " (:representation label) ..statement_suffix)))] + + ["break" break break_at] + ["continue" continue continue_at] + ) + + (template [<name> <js>] + [(def: .public <name> + (-> Location Expression) + (|>> :representation + (text.suffix <js>) + :abstraction))] + + [++ "++"] + [-- "--"] + ) + + (def: .public (comment commentary on) + (All (_ kind) (-> Text (Code kind) (Code kind))) + (:abstraction (format "/* " commentary " */" " " (:representation on)))) + + (def: .public (switch input cases default) + (-> Expression (List [(List Literal) Statement]) (Maybe Statement) Statement) + (:abstraction (format "switch (" (:representation input) ") " + (|> (format (|> cases + (list\each (.function (_ [when then]) + (format (|> when + (list\each (|>> :representation (text.enclosed ["case " ":"]))) + (text.interposed text.new_line)) + (..nested (:representation then))))) + (text.interposed text.new_line)) + text.new_line + (case default + (#.Some default) + (format "default:" + (..nested (:representation default))) + + #.None "")) + :abstraction + ..block))))] ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/address.lux b/stdlib/source/library/lux/target/jvm/bytecode/address.lux index 063c3eff6..2908238d5 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/address.lux @@ -24,53 +24,51 @@ ["[1][0]" signed {"+" [S4]}]]]]) (abstract: .public Address - {} - U2 - (def: .public value - (-> Address U2) - (|>> :representation)) + [(def: .public value + (-> Address U2) + (|>> :representation)) - (def: .public start - Address - (|> 0 ///unsigned.u2 try.trusted :abstraction)) + (def: .public start + Address + (|> 0 ///unsigned.u2 try.trusted :abstraction)) - (def: .public (move distance) - (-> U2 (-> Address (Try Address))) - (|>> :representation - (///unsigned.+/2 distance) - (\ try.functor each (|>> :abstraction)))) + (def: .public (move distance) + (-> U2 (-> Address (Try Address))) + (|>> :representation + (///unsigned.+/2 distance) + (\ try.functor each (|>> :abstraction)))) - (def: with_sign - (-> Address (Try S4)) - (|>> :representation ///unsigned.value .int ///signed.s4)) + (def: with_sign + (-> Address (Try S4)) + (|>> :representation ///unsigned.value .int ///signed.s4)) - (def: .public (jump from to) - (-> Address Address (Try Big_Jump)) - (do try.monad - [from (with_sign from) - to (with_sign to)] - (///signed.-/4 from to))) + (def: .public (jump from to) + (-> Address Address (Try Big_Jump)) + (do try.monad + [from (with_sign from) + to (with_sign to)] + (///signed.-/4 from to))) - (def: .public (after? reference subject) - (-> Address Address Bit) - (n.> (|> reference :representation ///unsigned.value) - (|> subject :representation ///unsigned.value))) + (def: .public (after? reference subject) + (-> Address Address Bit) + (n.> (|> reference :representation ///unsigned.value) + (|> subject :representation ///unsigned.value))) - (implementation: .public equivalence - (Equivalence Address) - - (def: (= reference subject) - (\ ///unsigned.equivalence = - (:representation reference) - (:representation subject)))) + (implementation: .public equivalence + (Equivalence Address) + + (def: (= reference subject) + (\ ///unsigned.equivalence = + (:representation reference) + (:representation subject)))) - (def: .public writer - (Writer Address) - (|>> :representation ///unsigned.writer/2)) + (def: .public writer + (Writer Address) + (|>> :representation ///unsigned.writer/2)) - (def: .public format - (Format Address) - (|>> :representation ///unsigned.value %.nat)) + (def: .public format + (Format Address) + (|>> :representation ///unsigned.value %.nat))] ) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux index 9a111eb22..13f9343a7 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -29,65 +29,63 @@ (def: wide 2) (abstract: .public Registry - {} - U2 - (def: .public registry - (-> U2 Registry) - (|>> :abstraction)) + [(def: .public registry + (-> U2 Registry) + (|>> :abstraction)) - (def: (minimal type) - (-> (Type Method) Nat) - (let [[type_variables inputs output exceptions] (/////type/parser.method type)] - (|> inputs - (list\each (function (_ input) - (if (or (same? /////type.long input) - (same? /////type.double input)) - ..wide - ..normal))) - (list\mix n.+ 0)))) + (def: (minimal type) + (-> (Type Method) Nat) + (let [[type_variables inputs output exceptions] (/////type/parser.method type)] + (|> inputs + (list\each (function (_ input) + (if (or (same? /////type.long input) + (same? /////type.double input)) + ..wide + ..normal))) + (list\mix n.+ 0)))) - (template [<start> <name>] - [(def: .public <name> - (-> (Type Method) (Try Registry)) - (|>> ..minimal - (n.+ <start>) - /////unsigned.u2 - (try\each ..registry)))] + (template [<start> <name>] + [(def: .public <name> + (-> (Type Method) (Try Registry)) + (|>> ..minimal + (n.+ <start>) + /////unsigned.u2 + (try\each ..registry)))] - [0 static] - [1 virtual] - ) + [0 static] + [1 virtual] + ) - (def: .public equivalence - (Equivalence Registry) - (\ equivalence.functor each - (|>> :representation) - /////unsigned.equivalence)) + (def: .public equivalence + (Equivalence Registry) + (\ equivalence.functor each + (|>> :representation) + /////unsigned.equivalence)) - (def: .public writer - (Writer Registry) - (|>> :representation /////unsigned.writer/2)) + (def: .public writer + (Writer Registry) + (|>> :representation /////unsigned.writer/2)) - (def: .public (has needed) - (-> Registry Registry Registry) - (|>> :representation - (/////unsigned.max/2 (:representation needed)) - :abstraction)) + (def: .public (has needed) + (-> Registry Registry Registry) + (|>> :representation + (/////unsigned.max/2 (:representation needed)) + :abstraction)) - (template [<name> <extra>] - [(def: .public <name> - (-> Register Registry) - (let [extra (|> <extra> /////unsigned.u2 try.trusted)] - (|>> /////unsigned.lifted/2 - (/////unsigned.+/2 extra) - try.trusted - :abstraction)))] + (template [<name> <extra>] + [(def: .public <name> + (-> Register Registry) + (let [extra (|> <extra> /////unsigned.u2 try.trusted)] + (|>> /////unsigned.lifted/2 + (/////unsigned.+/2 extra) + try.trusted + :abstraction)))] - [for ..normal] - [for_wide ..wide] - ) + [for ..normal] + [for_wide ..wide] + )] ) (def: .public length diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux index 48cfba7a8..1118c3b22 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit/stack.lux @@ -18,53 +18,51 @@ ["[1][0]" unsigned {"+" [U2]}]]]) (abstract: .public Stack - {} - U2 - (template [<frames> <name>] - [(def: .public <name> - Stack - (|> <frames> /////unsigned.u2 maybe.trusted :abstraction))] + [(template [<frames> <name>] + [(def: .public <name> + Stack + (|> <frames> /////unsigned.u2 maybe.trusted :abstraction))] - [0 empty] - [1 catch] - ) + [0 empty] + [1 catch] + ) - (def: .public equivalence - (Equivalence Stack) - (\ equivalence.functor each - (|>> :representation) - /////unsigned.equivalence)) + (def: .public equivalence + (Equivalence Stack) + (\ equivalence.functor each + (|>> :representation) + /////unsigned.equivalence)) - (def: .public writer - (Writer Stack) - (|>> :representation /////unsigned.writer/2)) + (def: .public writer + (Writer Stack) + (|>> :representation /////unsigned.writer/2)) - (def: stack - (-> U2 Stack) - (|>> :abstraction)) + (def: stack + (-> U2 Stack) + (|>> :abstraction)) - (template [<op> <name>] - [(def: .public (<name> amount) - (-> U2 (-> Stack (Try Stack))) - (|>> :representation - (<op> amount) - (\ try.functor each ..stack)))] + (template [<op> <name>] + [(def: .public (<name> amount) + (-> U2 (-> Stack (Try Stack))) + (|>> :representation + (<op> amount) + (\ try.functor each ..stack)))] - [/////unsigned.+/2 push] - [/////unsigned.-/2 pop] - ) + [/////unsigned.+/2 push] + [/////unsigned.-/2 pop] + ) - (def: .public (max left right) - (-> Stack Stack Stack) - (:abstraction - (/////unsigned.max/2 (:representation left) - (:representation right)))) + (def: .public (max left right) + (-> Stack Stack Stack) + (:abstraction + (/////unsigned.max/2 (:representation left) + (:representation right)))) - (def: .public format - (Format Stack) - (|>> :representation /////unsigned.value %.nat)) + (def: .public format + (Format Stack) + (|>> :representation /////unsigned.value %.nat))] ) (def: .public length diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index 449eb0d19..9fe36c303 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -235,26 +235,24 @@ (|>> mutation ((trinary/211' opcode input0 input1 input2)))])]) (abstract: .public Primitive_Array_Type - {} - U1 - (def: code - (-> Primitive_Array_Type U1) - (|>> :representation)) - - (template [<code> <name>] - [(def: .public <name> (|> <code> ///unsigned.u1 try.trusted :abstraction))] - - [04 t_boolean] - [05 t_char] - [06 t_float] - [07 t_double] - [08 t_byte] - [09 t_short] - [10 t_int] - [11 t_long] - )) + [(def: code + (-> Primitive_Array_Type U1) + (|>> :representation)) + + (template [<code> <name>] + [(def: .public <name> (|> <code> ///unsigned.u1 try.trusted :abstraction))] + + [04 t_boolean] + [05 t_char] + [06 t_float] + [07 t_double] + [08 t_byte] + [09 t_short] + [10 t_int] + [11 t_long] + )]) ... https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5 (with_expansions [<constants> (template [<code> <name>] diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux index 742c1101e..ef1076787 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -42,27 +42,25 @@ binaryF.utf8/16) (abstract: .public Class - {} - (Index UTF8) - (def: .public index - (-> Class (Index UTF8)) - (|>> :representation)) - - (def: .public class - (-> (Index UTF8) Class) - (|>> :abstraction)) - - (def: .public class_equivalence - (Equivalence Class) - (\ equivalence.functor each - ..index - //index.equivalence)) - - (def: class_writer - (Writer Class) - (|>> :representation //index.writer)) + [(def: .public index + (-> Class (Index UTF8)) + (|>> :representation)) + + (def: .public class + (-> (Index UTF8) Class) + (|>> :abstraction)) + + (def: .public class_equivalence + (Equivalence Class) + (\ equivalence.functor each + ..index + //index.equivalence)) + + (def: class_writer + (Writer Class) + (|>> :representation //index.writer))] ) (import: java/lang/Float @@ -86,50 +84,48 @@ ("static" doubleToRawLongBits [double] long)]) (abstract: .public (Value kind) - {} - kind - (def: .public value - (All (_ kind) (-> (Value kind) kind)) - (|>> :representation)) - - (def: .public (value_equivalence Equivalence<kind>) - (All (_ kind) - (-> (Equivalence kind) - (Equivalence (Value kind)))) - (\ equivalence.functor each - (|>> :representation) - Equivalence<kind>)) - - (template [<constructor> <type> <marker>] - [(type: .public <type> - (Value <marker>)) - - (def: .public <constructor> - (-> <marker> <type>) - (|>> :abstraction))] - - [integer Integer I32] - [float Float java/lang/Float] - [long Long .Int] - [double Double Frac] - [string String (Index UTF8)] - ) - - (template [<writer_name> <type> <write> <writer>] - [(def: <writer_name> - (Writer <type>) - (`` (|>> :representation - (~~ (template.spliced <write>)) - (~~ (template.spliced <writer>)))))] - - [integer_writer Integer [] [binaryF.bits/32]] - [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]] - [long_writer Long [] [binaryF.bits/64]] - [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] - [string_writer String [] [//index.writer]] - ) + [(def: .public value + (All (_ kind) (-> (Value kind) kind)) + (|>> :representation)) + + (def: .public (value_equivalence Equivalence<kind>) + (All (_ kind) + (-> (Equivalence kind) + (Equivalence (Value kind)))) + (\ equivalence.functor each + (|>> :representation) + Equivalence<kind>)) + + (template [<constructor> <type> <marker>] + [(type: .public <type> + (Value <marker>)) + + (def: .public <constructor> + (-> <marker> <type>) + (|>> :abstraction))] + + [integer Integer I32] + [float Float java/lang/Float] + [long Long .Int] + [double Double Frac] + [string String (Index UTF8)] + ) + + (template [<writer_name> <type> <write> <writer>] + [(def: <writer_name> + (Writer <type>) + (`` (|>> :representation + (~~ (template.spliced <write>)) + (~~ (template.spliced <writer>)))))] + + [integer_writer Integer [] [binaryF.bits/32]] + [float_writer Float [java/lang/Float::floatToRawIntBits ffi.int_to_long (:as I64)] [i32.i32 binaryF.bits/32]] + [long_writer Long [] [binaryF.bits/64]] + [double_writer Double [java/lang/Double::doubleToRawLongBits] [binaryF.bits/64]] + [string_writer String [] [//index.writer]] + )] ) (type: .public (Name_And_Type of) diff --git a/stdlib/source/library/lux/target/jvm/constant/tag.lux b/stdlib/source/library/lux/target/jvm/constant/tag.lux index ad56d1042..b774dfd4e 100644 --- a/stdlib/source/library/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/library/lux/target/jvm/constant/tag.lux @@ -15,38 +15,36 @@ ["[1][0]" unsigned {"+" [U1]} ("u1//[0]" equivalence)]]]) (abstract: .public Tag - {} - U1 - (implementation: .public equivalence - (Equivalence Tag) - (def: (= reference sample) - (u1//= (:representation reference) - (:representation sample)))) + [(implementation: .public equivalence + (Equivalence Tag) + (def: (= reference sample) + (u1//= (:representation reference) + (:representation sample)))) - (template [<code> <name>] - [(def: .public <name> - Tag - (|> <code> ///unsigned.u1 try.trusted :abstraction))] + (template [<code> <name>] + [(def: .public <name> + Tag + (|> <code> ///unsigned.u1 try.trusted :abstraction))] - [01 utf8] - [03 integer] - [04 float] - [05 long] - [06 double] - [07 class] - [08 string] - [09 field] - [10 method] - [11 interface_method] - [12 name_and_type] - [15 method_handle] - [16 method_type] - [18 invoke_dynamic] - ) + [01 utf8] + [03 integer] + [04 float] + [05 long] + [06 double] + [07 class] + [08 string] + [09 field] + [10 method] + [11 interface_method] + [12 name_and_type] + [15 method_handle] + [16 method_type] + [18 invoke_dynamic] + ) - (def: .public writer - (Writer Tag) - (|>> :representation ///unsigned.writer/1)) + (def: .public writer + (Writer Tag) + (|>> :representation ///unsigned.writer/1))] ) diff --git a/stdlib/source/library/lux/target/jvm/encoding/name.lux b/stdlib/source/library/lux/target/jvm/encoding/name.lux index 7553285f2..390b7c95c 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/name.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/name.lux @@ -14,25 +14,23 @@ Text) (abstract: .public Internal - {} - Text - (def: .public internal - (-> External Internal) - (|>> (text.replaced ..external_separator - ..internal_separator) - :abstraction)) - - (def: .public read - (-> Internal Text) - (|>> :representation)) - - (def: .public external - (-> Internal External) - (|>> :representation - (text.replaced ..internal_separator - ..external_separator)))) + [(def: .public internal + (-> External Internal) + (|>> (text.replaced ..external_separator + ..internal_separator) + :abstraction)) + + (def: .public read + (-> Internal Text) + (|>> :representation)) + + (def: .public external + (-> Internal External) + (|>> :representation + (text.replaced ..internal_separator + ..external_separator)))]) (def: .public safe (-> Text External) diff --git a/stdlib/source/library/lux/target/jvm/encoding/signed.lux b/stdlib/source/library/lux/target/jvm/encoding/signed.lux index e2aa094dc..5a13c9619 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -23,87 +23,85 @@ abstract]]]) (abstract: .public (Signed brand) - {} - Int - (def: .public value - (-> (Signed Any) Int) - (|>> :representation)) + [(def: .public value + (-> (Signed Any) Int) + (|>> :representation)) - (implementation: .public equivalence - (All (_ brand) (Equivalence (Signed brand))) - (def: (= reference sample) - (i.= (:representation reference) (:representation sample)))) + (implementation: .public equivalence + (All (_ brand) (Equivalence (Signed brand))) + (def: (= reference sample) + (i.= (:representation reference) (:representation sample)))) - (implementation: .public order - (All (_ brand) (Order (Signed brand))) - - (def: &equivalence ..equivalence) - (def: (< reference sample) - (i.< (:representation reference) (:representation sample)))) + (implementation: .public order + (All (_ brand) (Order (Signed brand))) + + (def: &equivalence ..equivalence) + (def: (< reference sample) + (i.< (:representation reference) (:representation sample)))) - (exception: .public (value_exceeds_the_scope {value Int} - {scope Nat}) - (exception.report - ["Value" (%.int value)] - ["Scope (in bytes)" (%.nat scope)])) + (exception: .public (value_exceeds_the_scope {value Int} + {scope Nat}) + (exception.report + ["Value" (%.int value)] + ["Scope (in bytes)" (%.nat scope)])) - (template [<bytes> <name> <size> <constructor> <maximum> <+> <->] - [(with_expansions [<raw> (template.identifier [<name> "'"])] - (abstract: .public <raw> {} Any) - (type: .public <name> (Signed <raw>))) + (template [<bytes> <name> <size> <constructor> <maximum> <+> <->] + [(with_expansions [<raw> (template.identifier [<name> "'"])] + (abstract: .public <raw> Any []) + (type: .public <name> (Signed <raw>))) - (def: .public <size> <bytes>) - - (def: .public <maximum> - <name> - (|> <bytes> (n.* i64.bits_per_byte) -- i64.mask :abstraction)) - - (def: .public <constructor> - (-> Int (Try <name>)) - (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask) - negative (|> positive .int (i.right_shifted 1) i64.not)] - (function (_ value) - (if (i.= (if (i.< +0 value) - (i64.or negative value) - (i64.and positive value)) - value) - (#try.Success (:abstraction value)) - (exception.except ..value_exceeds_the_scope [value <size>]))))) + (def: .public <size> <bytes>) + + (def: .public <maximum> + <name> + (|> <bytes> (n.* i64.bits_per_byte) -- i64.mask :abstraction)) + + (def: .public <constructor> + (-> Int (Try <name>)) + (let [positive (|> <bytes> (n.* i64.bits_per_byte) i64.mask) + negative (|> positive .int (i.right_shifted 1) i64.not)] + (function (_ value) + (if (i.= (if (i.< +0 value) + (i64.or negative value) + (i64.and positive value)) + value) + (#try.Success (:abstraction value)) + (exception.except ..value_exceeds_the_scope [value <size>]))))) - (template [<abstract_operation> <concrete_operation>] - [(def: .public (<abstract_operation> parameter subject) - (-> <name> <name> (Try <name>)) - (<constructor> - (<concrete_operation> (:representation parameter) - (:representation subject))))] + (template [<abstract_operation> <concrete_operation>] + [(def: .public (<abstract_operation> parameter subject) + (-> <name> <name> (Try <name>)) + (<constructor> + (<concrete_operation> (:representation parameter) + (:representation subject))))] - [<+> i.+] - [<-> i.-] - )] + [<+> i.+] + [<-> i.-] + )] - [1 S1 bytes/1 s1 maximum/1 +/1 -/1] - [2 S2 bytes/2 s2 maximum/2 +/2 -/2] - [4 S4 bytes/4 s4 maximum/4 +/4 -/4] - ) + [1 S1 bytes/1 s1 maximum/1 +/1 -/1] + [2 S2 bytes/2 s2 maximum/2 +/2 -/2] + [4 S4 bytes/4 s4 maximum/4 +/4 -/4] + ) - (template [<name> <from> <to>] - [(def: .public <name> - (-> <from> <to>) - (|>> :transmutation))] + (template [<name> <from> <to>] + [(def: .public <name> + (-> <from> <to>) + (|>> :transmutation))] - [lifted/2 S1 S2] - [lifted/4 S2 S4] - ) + [lifted/2 S1 S2] + [lifted/4 S2 S4] + ) - (template [<writer_name> <type> <writer>] - [(def: .public <writer_name> - (Writer <type>) - (|>> :representation <writer>))] + (template [<writer_name> <type> <writer>] + [(def: .public <writer_name> + (Writer <type>) + (|>> :representation <writer>))] - [writer/1 S1 format.bits/8] - [writer/2 S2 format.bits/16] - [writer/4 S4 format.bits/32] - ) + [writer/1 S1 format.bits/8] + [writer/2 S2 format.bits/16] + [writer/4 S4 format.bits/32] + )] ) diff --git a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux index 863aadea3..199ea697a 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux @@ -22,102 +22,100 @@ abstract]]]) (abstract: .public (Unsigned brand) - {} - Nat - (def: .public value - (-> (Unsigned Any) Nat) - (|>> :representation)) - - (implementation: .public equivalence - (All (_ brand) (Equivalence (Unsigned brand))) - (def: (= reference sample) - (n.= (:representation reference) - (:representation sample)))) - - (implementation: .public order - (All (_ brand) (Order (Unsigned brand))) - - (def: &equivalence ..equivalence) - (def: (< reference sample) - (n.< (:representation reference) - (:representation sample)))) - - (exception: .public (value_exceeds_the_maximum {type Name} - {value Nat} - {maximum (Unsigned Any)}) - (exception.report - ["Type" (%.name type)] - ["Value" (%.nat value)] - ["Maximum" (%.nat (:representation maximum))])) - - (exception: .public [brand] (subtraction_cannot_yield_negative_value - {type Name} - {parameter (Unsigned brand)} - {subject (Unsigned brand)}) - (exception.report - ["Type" (%.name type)] - ["Parameter" (%.nat (:representation parameter))] - ["Subject" (%.nat (:representation subject))])) - - (template [<bytes> <name> <size> <constructor> <maximum> <+> <-> <max>] - [(with_expansions [<raw> (template.identifier [<name> "'"])] - (abstract: .public <raw> {} Any) - (type: .public <name> (Unsigned <raw>))) - - (def: .public <size> <bytes>) - - (def: .public <maximum> - <name> - (|> <bytes> (n.* i64.bits_per_byte) i64.mask :abstraction)) + [(def: .public value + (-> (Unsigned Any) Nat) + (|>> :representation)) + + (implementation: .public equivalence + (All (_ brand) (Equivalence (Unsigned brand))) + (def: (= reference sample) + (n.= (:representation reference) + (:representation sample)))) + + (implementation: .public order + (All (_ brand) (Order (Unsigned brand))) - (def: .public (<constructor> value) - (-> Nat (Try <name>)) - (if (n.> (:representation <maximum>) value) - (exception.except ..value_exceeds_the_maximum [(name_of <name>) value <maximum>]) - (#try.Success (:abstraction value)))) - - (def: .public (<+> parameter subject) - (-> <name> <name> (Try <name>)) - (<constructor> - (n.+ (:representation parameter) - (:representation subject)))) - - (def: .public (<-> parameter subject) - (-> <name> <name> (Try <name>)) - (let [parameter' (:representation parameter) - subject' (:representation subject)] - (if (n.> subject' parameter') - (exception.except ..subtraction_cannot_yield_negative_value [(name_of <name>) parameter subject]) - (#try.Success (:abstraction (n.- parameter' subject')))))) - - (def: .public (<max> left right) - (-> <name> <name> <name>) - (:abstraction (n.max (:representation left) - (:representation right))))] - - [1 U1 bytes/1 u1 maximum/1 +/1 -/1 max/1] - [2 U2 bytes/2 u2 maximum/2 +/2 -/2 max/2] - [4 U4 bytes/4 u4 maximum/4 +/4 -/4 max/4] - ) - - (template [<name> <from> <to>] - [(def: .public <name> - (-> <from> <to>) - (|>> :transmutation))] - - [lifted/2 U1 U2] - [lifted/4 U2 U4] - ) - - (template [<writer_name> <type> <writer>] - [(def: .public <writer_name> - (Writer <type>) - (|>> :representation <writer>))] - - [writer/1 U1 format.bits/8] - [writer/2 U2 format.bits/16] - [writer/4 U4 format.bits/32] - ) + (def: &equivalence ..equivalence) + (def: (< reference sample) + (n.< (:representation reference) + (:representation sample)))) + + (exception: .public (value_exceeds_the_maximum {type Name} + {value Nat} + {maximum (Unsigned Any)}) + (exception.report + ["Type" (%.name type)] + ["Value" (%.nat value)] + ["Maximum" (%.nat (:representation maximum))])) + + (exception: .public [brand] (subtraction_cannot_yield_negative_value + {type Name} + {parameter (Unsigned brand)} + {subject (Unsigned brand)}) + (exception.report + ["Type" (%.name type)] + ["Parameter" (%.nat (:representation parameter))] + ["Subject" (%.nat (:representation subject))])) + + (template [<bytes> <name> <size> <constructor> <maximum> <+> <-> <max>] + [(with_expansions [<raw> (template.identifier [<name> "'"])] + (abstract: .public <raw> Any []) + (type: .public <name> (Unsigned <raw>))) + + (def: .public <size> <bytes>) + + (def: .public <maximum> + <name> + (|> <bytes> (n.* i64.bits_per_byte) i64.mask :abstraction)) + + (def: .public (<constructor> value) + (-> Nat (Try <name>)) + (if (n.> (:representation <maximum>) value) + (exception.except ..value_exceeds_the_maximum [(name_of <name>) value <maximum>]) + (#try.Success (:abstraction value)))) + + (def: .public (<+> parameter subject) + (-> <name> <name> (Try <name>)) + (<constructor> + (n.+ (:representation parameter) + (:representation subject)))) + + (def: .public (<-> parameter subject) + (-> <name> <name> (Try <name>)) + (let [parameter' (:representation parameter) + subject' (:representation subject)] + (if (n.> subject' parameter') + (exception.except ..subtraction_cannot_yield_negative_value [(name_of <name>) parameter subject]) + (#try.Success (:abstraction (n.- parameter' subject')))))) + + (def: .public (<max> left right) + (-> <name> <name> <name>) + (:abstraction (n.max (:representation left) + (:representation right))))] + + [1 U1 bytes/1 u1 maximum/1 +/1 -/1 max/1] + [2 U2 bytes/2 u2 maximum/2 +/2 -/2 max/2] + [4 U4 bytes/4 u4 maximum/4 +/4 -/4 max/4] + ) + + (template [<name> <from> <to>] + [(def: .public <name> + (-> <from> <to>) + (|>> :transmutation))] + + [lifted/2 U1 U2] + [lifted/4 U2 U4] + ) + + (template [<writer_name> <type> <writer>] + [(def: .public <writer_name> + (Writer <type>) + (|>> :representation <writer>))] + + [writer/1 U1 format.bits/8] + [writer/2 U2 format.bits/16] + [writer/4 U4 format.bits/32] + )] ) diff --git a/stdlib/source/library/lux/target/jvm/index.lux b/stdlib/source/library/lux/target/jvm/index.lux index 6a45de99d..cdf27baba 100644 --- a/stdlib/source/library/lux/target/jvm/index.lux +++ b/stdlib/source/library/lux/target/jvm/index.lux @@ -16,25 +16,23 @@ //unsigned.bytes/2) (abstract: .public (Index kind) - {} - U2 - (def: .public index - (All (_ kind) (-> U2 (Index kind))) - (|>> :abstraction)) + [(def: .public index + (All (_ kind) (-> U2 (Index kind))) + (|>> :abstraction)) - (def: .public value - (-> (Index Any) U2) - (|>> :representation)) + (def: .public value + (-> (Index Any) U2) + (|>> :representation)) - (def: .public equivalence - (All (_ kind) (Equivalence (Index kind))) - (\ equivalence.functor each - ..value - //unsigned.equivalence)) + (def: .public equivalence + (All (_ kind) (Equivalence (Index kind))) + (\ equivalence.functor each + ..value + //unsigned.equivalence)) - (def: .public writer - (All (_ kind) (Writer (Index kind))) - (|>> :representation //unsigned.writer/2)) + (def: .public writer + (All (_ kind) (Writer (Index kind))) + (|>> :representation //unsigned.writer/2))] ) diff --git a/stdlib/source/library/lux/target/jvm/modifier.lux b/stdlib/source/library/lux/target/jvm/modifier.lux index bb066ab29..48c0697d9 100644 --- a/stdlib/source/library/lux/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/target/jvm/modifier.lux @@ -24,60 +24,58 @@ ["[1][0]" unsigned]]]) (abstract: .public (Modifier of) - {} - //unsigned.U2 - (def: .public code - (-> (Modifier Any) //unsigned.U2) - (|>> :representation)) + [(def: .public code + (-> (Modifier Any) //unsigned.U2) + (|>> :representation)) - (implementation: .public equivalence - (All (_ of) (Equivalence (Modifier of))) - - (def: (= reference sample) - (\ //unsigned.equivalence = - (:representation reference) - (:representation sample)))) + (implementation: .public equivalence + (All (_ of) (Equivalence (Modifier of))) + + (def: (= reference sample) + (\ //unsigned.equivalence = + (:representation reference) + (:representation sample)))) - (template: (!wrap value) - [(|> value - //unsigned.u2 - try.trusted - :abstraction)]) + (template: (!wrap value) + [(|> value + //unsigned.u2 + try.trusted + :abstraction)]) - (template: (!unwrap value) - [(|> value - :representation - //unsigned.value)]) + (template: (!unwrap value) + [(|> value + :representation + //unsigned.value)]) - (def: .public (has? sub super) - (All (_ of) (-> (Modifier of) (Modifier of) Bit)) - (let [sub (!unwrap sub)] - (|> (!unwrap super) - (i64.and sub) - (\ i64.equivalence = sub)))) + (def: .public (has? sub super) + (All (_ of) (-> (Modifier of) (Modifier of) Bit)) + (let [sub (!unwrap sub)] + (|> (!unwrap super) + (i64.and sub) + (\ i64.equivalence = sub)))) - (implementation: .public monoid - (All (_ of) (Monoid (Modifier of))) + (implementation: .public monoid + (All (_ of) (Monoid (Modifier of))) - (def: identity - (!wrap (hex "0000"))) - - (def: (composite left right) - (!wrap (i64.or (!unwrap left) (!unwrap right))))) + (def: identity + (!wrap (hex "0000"))) + + (def: (composite left right) + (!wrap (i64.or (!unwrap left) (!unwrap right))))) - (def: .public empty - Modifier - (\ ..monoid identity)) + (def: .public empty + Modifier + (\ ..monoid identity)) - (def: .public writer - (All (_ of) (Writer (Modifier of))) - (|>> :representation //unsigned.writer/2)) + (def: .public writer + (All (_ of) (Writer (Modifier of))) + (|>> :representation //unsigned.writer/2)) - (def: modifier - (-> Nat Modifier) - (|>> !wrap)) + (def: modifier + (-> Nat Modifier) + (|>> !wrap))] ) (syntax: .public (modifiers: [ofT <code>.any diff --git a/stdlib/source/library/lux/target/jvm/modifier/inner.lux b/stdlib/source/library/lux/target/jvm/modifier/inner.lux index a3777c380..6327fefa8 100644 --- a/stdlib/source/library/lux/target/jvm/modifier/inner.lux +++ b/stdlib/source/library/lux/target/jvm/modifier/inner.lux @@ -5,7 +5,7 @@ abstract]]] [// {"+" [modifiers:]}]) -(abstract: .public Inner {} Any) +(abstract: .public Inner Any []) (modifiers: Inner ["0001" public] diff --git a/stdlib/source/library/lux/target/jvm/type.lux b/stdlib/source/library/lux/target/jvm/type.lux index 8cac8e4df..e3ec58a89 100644 --- a/stdlib/source/library/lux/target/jvm/type.lux +++ b/stdlib/source/library/lux/target/jvm/type.lux @@ -26,169 +26,169 @@ ["[1][0]" reflection {"+" [Reflection]}]]) (abstract: .public (Type category) - {} - - [(Signature category) (Descriptor category) (Reflection category)] - - (type: .public Argument - [Text (Type Value)]) - - (type: .public (Typed a) - [(Type Value) a]) - - (type: .public Constraint - (Record - [#name Text - #super_class (Type Class) - #super_interfaces (List (Type Class))])) - - (template [<name> <style>] - [(def: .public (<name> type) - (All (_ category) (-> (Type category) (<style> category))) - (let [[signature descriptor reflection] (:representation type)] - <name>))] - - [signature Signature] - [descriptor Descriptor] - ) - - (def: .public (reflection type) - (All (_ category) - (-> (Type (<| Return' Value' category)) - (Reflection (<| Return' Value' category)))) - (let [[signature descriptor reflection] (:representation type)] - reflection)) - - (template [<category> <name> <signature> <descriptor> <reflection>] - [(def: .public <name> - (Type <category>) - (:abstraction [<signature> <descriptor> <reflection>]))] - - [Void void /signature.void /descriptor.void /reflection.void] - [Primitive boolean /signature.boolean /descriptor.boolean /reflection.boolean] - [Primitive byte /signature.byte /descriptor.byte /reflection.byte] - [Primitive short /signature.short /descriptor.short /reflection.short] - [Primitive int /signature.int /descriptor.int /reflection.int] - [Primitive long /signature.long /descriptor.long /reflection.long] - [Primitive float /signature.float /descriptor.float /reflection.float] - [Primitive double /signature.double /descriptor.double /reflection.double] - [Primitive char /signature.char /descriptor.char /reflection.char] - ) - - (def: .public (array type) - (-> (Type Value) (Type Array)) - (:abstraction - [(/signature.array (..signature type)) - (/descriptor.array (..descriptor type)) - (/reflection.array (..reflection type))])) - - (def: .public (class name parameters) - (-> External (List (Type Parameter)) (Type Class)) - (:abstraction - [(/signature.class name (list\each ..signature parameters)) - (/descriptor.class name) - (/reflection.class name)])) - - (def: .public (declaration name variables) - (-> External (List (Type Var)) (Type Declaration)) - (:abstraction - [(/signature.declaration name (list\each ..signature variables)) - (/descriptor.declaration name) - (/reflection.declaration name)])) - - (def: .public (as_class type) - (-> (Type Declaration) (Type Class)) - (:abstraction + [(Signature category) + (Descriptor category) + (Reflection category)] + + [(type: .public Argument + [Text (Type Value)]) + + (type: .public (Typed a) + [(Type Value) a]) + + (type: .public Constraint + (Record + [#name Text + #super_class (Type Class) + #super_interfaces (List (Type Class))])) + + (template [<name> <style>] + [(def: .public (<name> type) + (All (_ category) (-> (Type category) (<style> category))) + (let [[signature descriptor reflection] (:representation type)] + <name>))] + + [signature Signature] + [descriptor Descriptor] + ) + + (def: .public (reflection type) + (All (_ category) + (-> (Type (<| Return' Value' category)) + (Reflection (<| Return' Value' category)))) (let [[signature descriptor reflection] (:representation type)] - [(/signature.as_class signature) - (/descriptor.as_class descriptor) - (/reflection.as_class reflection)]))) - - (def: .public wildcard - (Type Parameter) - (:abstraction - [/signature.wildcard - /descriptor.wildcard - /reflection.wildcard])) - - (def: .public (var name) - (-> Text (Type Var)) - (:abstraction - [(/signature.var name) - /descriptor.var - /reflection.var])) - - (def: .public (lower bound) - (-> (Type Class) (Type Parameter)) - (:abstraction - (let [[signature descriptor reflection] (:representation bound)] - [(/signature.lower signature) - (/descriptor.lower descriptor) - (/reflection.lower reflection)]))) - - (def: .public (upper bound) - (-> (Type Class) (Type Parameter)) - (:abstraction - (let [[signature descriptor reflection] (:representation bound)] - [(/signature.upper signature) - (/descriptor.upper descriptor) - (/reflection.upper reflection)]))) - - (def: .public (method [type_variables inputs output exceptions]) - (-> [(List (Type Var)) - (List (Type Value)) - (Type Return) - (List (Type Class))] - (Type Method)) - (:abstraction - [(/signature.method [(list\each ..signature type_variables) - (list\each ..signature inputs) - (..signature output) - (list\each ..signature exceptions)]) - (/descriptor.method [(list\each ..descriptor inputs) - (..descriptor output)]) - (:expected ..void)])) - - (implementation: .public equivalence - (All (_ category) (Equivalence (Type category))) - - (def: (= parameter subject) - (\ /signature.equivalence = - (..signature parameter) - (..signature subject)))) - - (implementation: .public hash - (All (_ category) (Hash (Type category))) - - (def: &equivalence ..equivalence) - (def: hash (|>> ..signature (\ /signature.hash hash)))) - - (def: .public (primitive? type) - (-> (Type Value) (Either (Type Object) - (Type Primitive))) - (if (`` (or (~~ (template [<type>] - [(\ ..equivalence = (: (Type Value) <type>) type)] - - [..boolean] - [..byte] - [..short] - [..int] - [..long] - [..float] - [..double] - [..char])))) - (|> type (:as (Type Primitive)) #.Right) - (|> type (:as (Type Object)) #.Left))) - - (def: .public (void? type) - (-> (Type Return) (Either (Type Value) - (Type Void))) - (if (`` (or (~~ (template [<type>] - [(\ ..equivalence = (: (Type Return) <type>) type)] - - [..void])))) - (|> type (:as (Type Void)) #.Right) - (|> type (:as (Type Value)) #.Left))) + reflection)) + + (template [<category> <name> <signature> <descriptor> <reflection>] + [(def: .public <name> + (Type <category>) + (:abstraction [<signature> <descriptor> <reflection>]))] + + [Void void /signature.void /descriptor.void /reflection.void] + [Primitive boolean /signature.boolean /descriptor.boolean /reflection.boolean] + [Primitive byte /signature.byte /descriptor.byte /reflection.byte] + [Primitive short /signature.short /descriptor.short /reflection.short] + [Primitive int /signature.int /descriptor.int /reflection.int] + [Primitive long /signature.long /descriptor.long /reflection.long] + [Primitive float /signature.float /descriptor.float /reflection.float] + [Primitive double /signature.double /descriptor.double /reflection.double] + [Primitive char /signature.char /descriptor.char /reflection.char] + ) + + (def: .public (array type) + (-> (Type Value) (Type Array)) + (:abstraction + [(/signature.array (..signature type)) + (/descriptor.array (..descriptor type)) + (/reflection.array (..reflection type))])) + + (def: .public (class name parameters) + (-> External (List (Type Parameter)) (Type Class)) + (:abstraction + [(/signature.class name (list\each ..signature parameters)) + (/descriptor.class name) + (/reflection.class name)])) + + (def: .public (declaration name variables) + (-> External (List (Type Var)) (Type Declaration)) + (:abstraction + [(/signature.declaration name (list\each ..signature variables)) + (/descriptor.declaration name) + (/reflection.declaration name)])) + + (def: .public (as_class type) + (-> (Type Declaration) (Type Class)) + (:abstraction + (let [[signature descriptor reflection] (:representation type)] + [(/signature.as_class signature) + (/descriptor.as_class descriptor) + (/reflection.as_class reflection)]))) + + (def: .public wildcard + (Type Parameter) + (:abstraction + [/signature.wildcard + /descriptor.wildcard + /reflection.wildcard])) + + (def: .public (var name) + (-> Text (Type Var)) + (:abstraction + [(/signature.var name) + /descriptor.var + /reflection.var])) + + (def: .public (lower bound) + (-> (Type Class) (Type Parameter)) + (:abstraction + (let [[signature descriptor reflection] (:representation bound)] + [(/signature.lower signature) + (/descriptor.lower descriptor) + (/reflection.lower reflection)]))) + + (def: .public (upper bound) + (-> (Type Class) (Type Parameter)) + (:abstraction + (let [[signature descriptor reflection] (:representation bound)] + [(/signature.upper signature) + (/descriptor.upper descriptor) + (/reflection.upper reflection)]))) + + (def: .public (method [type_variables inputs output exceptions]) + (-> [(List (Type Var)) + (List (Type Value)) + (Type Return) + (List (Type Class))] + (Type Method)) + (:abstraction + [(/signature.method [(list\each ..signature type_variables) + (list\each ..signature inputs) + (..signature output) + (list\each ..signature exceptions)]) + (/descriptor.method [(list\each ..descriptor inputs) + (..descriptor output)]) + (:expected ..void)])) + + (implementation: .public equivalence + (All (_ category) (Equivalence (Type category))) + + (def: (= parameter subject) + (\ /signature.equivalence = + (..signature parameter) + (..signature subject)))) + + (implementation: .public hash + (All (_ category) (Hash (Type category))) + + (def: &equivalence ..equivalence) + (def: hash (|>> ..signature (\ /signature.hash hash)))) + + (def: .public (primitive? type) + (-> (Type Value) (Either (Type Object) + (Type Primitive))) + (if (`` (or (~~ (template [<type>] + [(\ ..equivalence = (: (Type Value) <type>) type)] + + [..boolean] + [..byte] + [..short] + [..int] + [..long] + [..float] + [..double] + [..char])))) + (|> type (:as (Type Primitive)) #.Right) + (|> type (:as (Type Object)) #.Left))) + + (def: .public (void? type) + (-> (Type Return) (Either (Type Value) + (Type Void))) + (if (`` (or (~~ (template [<type>] + [(\ ..equivalence = (: (Type Return) <type>) type)] + + [..void])))) + (|> type (:as (Type Void)) #.Right) + (|> type (:as (Type Value)) #.Left)))] ) (def: .public (class? type) diff --git a/stdlib/source/library/lux/target/jvm/type/category.lux b/stdlib/source/library/lux/target/jvm/type/category.lux index b6096e241..2f7a2eed6 100644 --- a/stdlib/source/library/lux/target/jvm/type/category.lux +++ b/stdlib/source/library/lux/target/jvm/type/category.lux @@ -6,24 +6,24 @@ [type abstract]]]) -(abstract: .public Void' {} Any) -(abstract: .public (Value' kind) {} Any) -(abstract: .public (Return' kind) {} Any) -(abstract: .public Method {} Any) +(abstract: .public Void' Any []) +(abstract: .public (Value' kind) Any []) +(abstract: .public (Return' kind) Any []) +(abstract: .public Method Any []) (type: .public Return (<| Return' Any)) (type: .public Value (<| Return' Value' Any)) (type: .public Void (<| Return' Void')) -(abstract: .public (Object' brand) {} Any) +(abstract: .public (Object' brand) Any []) (type: .public Object (<| Return' Value' Object' Any)) -(abstract: .public (Parameter' brand) {} Any) +(abstract: .public (Parameter' brand) Any []) (type: .public Parameter (<| Return' Value' Object' Parameter' Any)) (template [<parents> <child>] [(with_expansions [<raw> (template.identifier [<child> "'"])] - (abstract: .public <raw> {} Any) + (abstract: .public <raw> Any []) (type: .public <child> (`` (<| Return' Value' (~~ (template.spliced <parents>)) <raw>))))] @@ -33,4 +33,4 @@ [[Object'] Array] ) -(abstract: .public Declaration {} Any) +(abstract: .public Declaration Any []) diff --git a/stdlib/source/library/lux/target/jvm/type/descriptor.lux b/stdlib/source/library/lux/target/jvm/type/descriptor.lux index 85d659e2c..7d7d4e7fe 100644 --- a/stdlib/source/library/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/library/lux/target/jvm/type/descriptor.lux @@ -22,105 +22,103 @@ ["[1][0]" name {"+" [Internal External]}]]]]) (abstract: .public (Descriptor category) - {} - Text - (def: .public descriptor - (-> (Descriptor Any) Text) - (|>> :representation)) - - (template [<sigil> <category> <name>] - [(def: .public <name> - (Descriptor <category>) - (:abstraction <sigil>))] - - ["V" Void void] - ["Z" Primitive boolean] - ["B" Primitive byte] - ["S" Primitive short] - ["I" Primitive int] - ["J" Primitive long] - ["F" Primitive float] - ["D" Primitive double] - ["C" Primitive char] - ) - - (def: .public class_prefix "L") - (def: .public class_suffix ";") - - (def: .public class - (-> External (Descriptor Class)) - (|>> ///name.internal - ///name.read - (text.enclosed [..class_prefix ..class_suffix]) - :abstraction)) - - (def: .public (declaration name) - (-> External (Descriptor Declaration)) - (:transmutation (..class name))) - - (def: .public as_class - (-> (Descriptor Declaration) (Descriptor Class)) - (|>> :transmutation)) - - (template [<name> <category>] - [(def: .public <name> - (Descriptor <category>) - (:transmutation - (..class "java.lang.Object")))] - - [var Var] - [wildcard Parameter] - ) - - (def: .public (lower descriptor) - (-> (Descriptor Class) (Descriptor Parameter)) - ..wildcard) - - (def: .public upper - (-> (Descriptor Class) (Descriptor Parameter)) - (|>> :transmutation)) - - (def: .public array_prefix "[") - - (def: .public array - (-> (Descriptor Value) - (Descriptor Array)) - (|>> :representation - (format ..array_prefix) - :abstraction)) - - (def: .public (method [inputs output]) - (-> [(List (Descriptor Value)) - (Descriptor Return)] - (Descriptor Method)) - (:abstraction - (format (|> inputs - (list\each ..descriptor) - text.together - (text.enclosed ["(" ")"])) - (:representation output)))) - - (implementation: .public equivalence - (All (_ category) (Equivalence (Descriptor category))) - - (def: (= parameter subject) - (text\= (:representation parameter) (:representation subject)))) - - (def: .public class_name - (-> (Descriptor Object) Internal) - (let [prefix_size (text.size ..class_prefix) - suffix_size (text.size ..class_suffix)] - (function (_ descriptor) - (let [repr (:representation descriptor)] - (if (text.starts_with? ..array_prefix repr) - (///name.internal repr) - (|> repr - (text.clip prefix_size - (|> (text.size repr) - (n.- prefix_size) - (n.- suffix_size))) - (\ maybe.monad each ///name.internal) - maybe.trusted)))))) + [(def: .public descriptor + (-> (Descriptor Any) Text) + (|>> :representation)) + + (template [<sigil> <category> <name>] + [(def: .public <name> + (Descriptor <category>) + (:abstraction <sigil>))] + + ["V" Void void] + ["Z" Primitive boolean] + ["B" Primitive byte] + ["S" Primitive short] + ["I" Primitive int] + ["J" Primitive long] + ["F" Primitive float] + ["D" Primitive double] + ["C" Primitive char] + ) + + (def: .public class_prefix "L") + (def: .public class_suffix ";") + + (def: .public class + (-> External (Descriptor Class)) + (|>> ///name.internal + ///name.read + (text.enclosed [..class_prefix ..class_suffix]) + :abstraction)) + + (def: .public (declaration name) + (-> External (Descriptor Declaration)) + (:transmutation (..class name))) + + (def: .public as_class + (-> (Descriptor Declaration) (Descriptor Class)) + (|>> :transmutation)) + + (template [<name> <category>] + [(def: .public <name> + (Descriptor <category>) + (:transmutation + (..class "java.lang.Object")))] + + [var Var] + [wildcard Parameter] + ) + + (def: .public (lower descriptor) + (-> (Descriptor Class) (Descriptor Parameter)) + ..wildcard) + + (def: .public upper + (-> (Descriptor Class) (Descriptor Parameter)) + (|>> :transmutation)) + + (def: .public array_prefix "[") + + (def: .public array + (-> (Descriptor Value) + (Descriptor Array)) + (|>> :representation + (format ..array_prefix) + :abstraction)) + + (def: .public (method [inputs output]) + (-> [(List (Descriptor Value)) + (Descriptor Return)] + (Descriptor Method)) + (:abstraction + (format (|> inputs + (list\each ..descriptor) + text.together + (text.enclosed ["(" ")"])) + (:representation output)))) + + (implementation: .public equivalence + (All (_ category) (Equivalence (Descriptor category))) + + (def: (= parameter subject) + (text\= (:representation parameter) (:representation subject)))) + + (def: .public class_name + (-> (Descriptor Object) Internal) + (let [prefix_size (text.size ..class_prefix) + suffix_size (text.size ..class_suffix)] + (function (_ descriptor) + (let [repr (:representation descriptor)] + (if (text.starts_with? ..array_prefix repr) + (///name.internal repr) + (|> repr + (text.clip prefix_size + (|> (text.size repr) + (n.- prefix_size) + (n.- suffix_size))) + (\ maybe.monad each ///name.internal) + maybe.trusted))))))] ) diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index 38569af4b..0c340843c 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -30,7 +30,7 @@ ["[1][0]" name]]]]) (template [<name>] - [(abstract: .public (<name> class) {} Any)] + [(abstract: .public (<name> class) Any [])] [Lower] [Upper] ) diff --git a/stdlib/source/library/lux/target/jvm/type/reflection.lux b/stdlib/source/library/lux/target/jvm/type/reflection.lux index 510505c85..ce31cbbcc 100644 --- a/stdlib/source/library/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/type/reflection.lux @@ -16,91 +16,89 @@ ["[1][0]" name {"+" [External]}]]]]) (abstract: .public (Reflection category) - {} - Text - (def: .public reflection - (-> (Reflection Any) Text) - (|>> :representation)) + [(def: .public reflection + (-> (Reflection Any) Text) + (|>> :representation)) - (implementation: .public equivalence - (All (_ category) (Equivalence (Reflection category))) - - (def: (= parameter subject) - (text\= (:representation parameter) (:representation subject)))) + (implementation: .public equivalence + (All (_ category) (Equivalence (Reflection category))) + + (def: (= parameter subject) + (text\= (:representation parameter) (:representation subject)))) - (template [<category> <name> <reflection>] - [(def: .public <name> - (Reflection <category>) - (:abstraction <reflection>))] + (template [<category> <name> <reflection>] + [(def: .public <name> + (Reflection <category>) + (:abstraction <reflection>))] - [Void void "void"] - [Primitive boolean "boolean"] - [Primitive byte "byte"] - [Primitive short "short"] - [Primitive int "int"] - [Primitive long "long"] - [Primitive float "float"] - [Primitive double "double"] - [Primitive char "char"] - ) + [Void void "void"] + [Primitive boolean "boolean"] + [Primitive byte "byte"] + [Primitive short "short"] + [Primitive int "int"] + [Primitive long "long"] + [Primitive float "float"] + [Primitive double "double"] + [Primitive char "char"] + ) - (def: .public class - (-> External (Reflection Class)) - (|>> :abstraction)) + (def: .public class + (-> External (Reflection Class)) + (|>> :abstraction)) - (def: .public (declaration name) - (-> External (Reflection Declaration)) - (:transmutation (..class name))) + (def: .public (declaration name) + (-> External (Reflection Declaration)) + (:transmutation (..class name))) - (def: .public as_class - (-> (Reflection Declaration) (Reflection Class)) - (|>> :transmutation)) + (def: .public as_class + (-> (Reflection Declaration) (Reflection Class)) + (|>> :transmutation)) - (def: .public (array element) - (-> (Reflection Value) (Reflection Array)) - (let [element' (:representation element) - elementR (`` (cond (text.starts_with? //descriptor.array_prefix element') - element' - - (~~ (template [<primitive> <descriptor>] - [(\ ..equivalence = <primitive> element) - (//descriptor.descriptor <descriptor>)] + (def: .public (array element) + (-> (Reflection Value) (Reflection Array)) + (let [element' (:representation element) + elementR (`` (cond (text.starts_with? //descriptor.array_prefix element') + element' + + (~~ (template [<primitive> <descriptor>] + [(\ ..equivalence = <primitive> element) + (//descriptor.descriptor <descriptor>)] - [..boolean //descriptor.boolean] - [..byte //descriptor.byte] - [..short //descriptor.short] - [..int //descriptor.int] - [..long //descriptor.long] - [..float //descriptor.float] - [..double //descriptor.double] - [..char //descriptor.char])) + [..boolean //descriptor.boolean] + [..byte //descriptor.byte] + [..short //descriptor.short] + [..int //descriptor.int] + [..long //descriptor.long] + [..float //descriptor.float] + [..double //descriptor.double] + [..char //descriptor.char])) - (|> element' - //descriptor.class - //descriptor.descriptor - (text.replaced //name.internal_separator - //name.external_separator))))] - (|> elementR - (format //descriptor.array_prefix) - :abstraction))) + (|> element' + //descriptor.class + //descriptor.descriptor + (text.replaced //name.internal_separator + //name.external_separator))))] + (|> elementR + (format //descriptor.array_prefix) + :abstraction))) - (template [<name> <category>] - [(def: .public <name> - (Reflection <category>) - (:transmutation - (..class "java.lang.Object")))] + (template [<name> <category>] + [(def: .public <name> + (Reflection <category>) + (:transmutation + (..class "java.lang.Object")))] - [var Var] - [wildcard Parameter] - ) + [var Var] + [wildcard Parameter] + ) - (def: .public (lower reflection) - (-> (Reflection Class) (Reflection Parameter)) - ..wildcard) + (def: .public (lower reflection) + (-> (Reflection Class) (Reflection Parameter)) + ..wildcard) - (def: .public upper - (-> (Reflection Class) (Reflection Parameter)) - (|>> :transmutation)) + (def: .public upper + (-> (Reflection Class) (Reflection Parameter)) + (|>> :transmutation))] ) diff --git a/stdlib/source/library/lux/target/jvm/type/signature.lux b/stdlib/source/library/lux/target/jvm/type/signature.lux index 124e3e550..86663ce49 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -19,145 +19,143 @@ ["[1][0]" name {"+" [External]}]]]]) (abstract: .public (Signature category) - {} - Text - (def: .public signature - (-> (Signature Any) Text) - (|>> :representation)) - - (template [<category> <name> <descriptor>] - [(def: .public <name> - (Signature <category>) - (:abstraction (//descriptor.descriptor <descriptor>)))] - - [Void void //descriptor.void] - [Primitive boolean //descriptor.boolean] - [Primitive byte //descriptor.byte] - [Primitive short //descriptor.short] - [Primitive int //descriptor.int] - [Primitive long //descriptor.long] - [Primitive float //descriptor.float] - [Primitive double //descriptor.double] - [Primitive char //descriptor.char] - ) - - (def: .public array - (-> (Signature Value) (Signature Array)) - (|>> :representation - (format //descriptor.array_prefix) - :abstraction)) - - (def: .public wildcard - (Signature Parameter) - (:abstraction "*")) - - (def: .public var_prefix "T") - - (def: .public var - (-> Text (Signature Var)) - (|>> (text.enclosed [..var_prefix //descriptor.class_suffix]) - :abstraction)) - - (def: .public var_name - (-> (Signature Var) Text) - (|>> :representation - (text.replaced ..var_prefix "") - (text.replaced //descriptor.class_suffix ""))) - - (def: .public lower_prefix "-") - (def: .public upper_prefix "+") - - (template [<name> <prefix>] - [(def: .public <name> - (-> (Signature Class) (Signature Parameter)) - (|>> :representation (format <prefix>) :abstraction))] - - [lower ..lower_prefix] - [upper ..upper_prefix] - ) - - (template [<char> <name>] - [(def: .public <name> - <char>)] - - ["<" parameters_start] - [">" parameters_end] - ) - - (def: .public (class name parameters) - (-> External (List (Signature Parameter)) (Signature Class)) - (:abstraction - (format //descriptor.class_prefix - (|> name ///name.internal ///name.read) - (case parameters - #.End - "" - - _ - (format ..parameters_start - (|> parameters - (list\each ..signature) - text.together) - ..parameters_end)) - //descriptor.class_suffix))) - - (def: .public (declaration name variables) - (-> External (List (Signature Var)) (Signature Declaration)) - (:transmutation (..class name variables))) - - (def: .public as_class - (-> (Signature Declaration) (Signature Class)) - (|>> :transmutation)) - - (def: .public arguments_start "(") - (def: .public arguments_end ")") - - (def: .public exception_prefix "^") - - (def: class_bound - (|> (..class "java.lang.Object" (list)) - ..signature - (format ":"))) - - (def: .public (method [type_variables inputs output exceptions]) - (-> [(List (Signature Var)) - (List (Signature Value)) - (Signature Return) - (List (Signature Class))] - (Signature Method)) - (:abstraction - (format (case type_variables - #.End - "" - _ - (|> type_variables - (list\each (|>> ..var_name - (text.suffix ..class_bound))) - text.together - (text.enclosed [..parameters_start - ..parameters_end]))) - (|> inputs - (list\each ..signature) - text.together - (text.enclosed [..arguments_start - ..arguments_end])) - (:representation output) - (|> exceptions - (list\each (|>> :representation (format ..exception_prefix))) - text.together)))) - - (implementation: .public equivalence - (All (_ category) (Equivalence (Signature category))) - - (def: (= parameter subject) - (text\= (:representation parameter) - (:representation subject)))) - - (implementation: .public hash - (All (_ category) (Hash (Signature category))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation text\hash))) + [(def: .public signature + (-> (Signature Any) Text) + (|>> :representation)) + + (template [<category> <name> <descriptor>] + [(def: .public <name> + (Signature <category>) + (:abstraction (//descriptor.descriptor <descriptor>)))] + + [Void void //descriptor.void] + [Primitive boolean //descriptor.boolean] + [Primitive byte //descriptor.byte] + [Primitive short //descriptor.short] + [Primitive int //descriptor.int] + [Primitive long //descriptor.long] + [Primitive float //descriptor.float] + [Primitive double //descriptor.double] + [Primitive char //descriptor.char] + ) + + (def: .public array + (-> (Signature Value) (Signature Array)) + (|>> :representation + (format //descriptor.array_prefix) + :abstraction)) + + (def: .public wildcard + (Signature Parameter) + (:abstraction "*")) + + (def: .public var_prefix "T") + + (def: .public var + (-> Text (Signature Var)) + (|>> (text.enclosed [..var_prefix //descriptor.class_suffix]) + :abstraction)) + + (def: .public var_name + (-> (Signature Var) Text) + (|>> :representation + (text.replaced ..var_prefix "") + (text.replaced //descriptor.class_suffix ""))) + + (def: .public lower_prefix "-") + (def: .public upper_prefix "+") + + (template [<name> <prefix>] + [(def: .public <name> + (-> (Signature Class) (Signature Parameter)) + (|>> :representation (format <prefix>) :abstraction))] + + [lower ..lower_prefix] + [upper ..upper_prefix] + ) + + (template [<char> <name>] + [(def: .public <name> + <char>)] + + ["<" parameters_start] + [">" parameters_end] + ) + + (def: .public (class name parameters) + (-> External (List (Signature Parameter)) (Signature Class)) + (:abstraction + (format //descriptor.class_prefix + (|> name ///name.internal ///name.read) + (case parameters + #.End + "" + + _ + (format ..parameters_start + (|> parameters + (list\each ..signature) + text.together) + ..parameters_end)) + //descriptor.class_suffix))) + + (def: .public (declaration name variables) + (-> External (List (Signature Var)) (Signature Declaration)) + (:transmutation (..class name variables))) + + (def: .public as_class + (-> (Signature Declaration) (Signature Class)) + (|>> :transmutation)) + + (def: .public arguments_start "(") + (def: .public arguments_end ")") + + (def: .public exception_prefix "^") + + (def: class_bound + (|> (..class "java.lang.Object" (list)) + ..signature + (format ":"))) + + (def: .public (method [type_variables inputs output exceptions]) + (-> [(List (Signature Var)) + (List (Signature Value)) + (Signature Return) + (List (Signature Class))] + (Signature Method)) + (:abstraction + (format (case type_variables + #.End + "" + _ + (|> type_variables + (list\each (|>> ..var_name + (text.suffix ..class_bound))) + text.together + (text.enclosed [..parameters_start + ..parameters_end]))) + (|> inputs + (list\each ..signature) + text.together + (text.enclosed [..arguments_start + ..arguments_end])) + (:representation output) + (|> exceptions + (list\each (|>> :representation (format ..exception_prefix))) + text.together)))) + + (implementation: .public equivalence + (All (_ category) (Equivalence (Signature category))) + + (def: (= parameter subject) + (text\= (:representation parameter) + (:representation subject)))) + + (implementation: .public hash + (All (_ category) (Hash (Signature category))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation text\hash)))] ) diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux index 4097a3433..bf36d301e 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -36,332 +36,330 @@ (def: input_separator ", ") (abstract: .public (Code brand) - {} - Text - (implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) {} Any) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: <brand> {} Any) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Literal [Computation' Expression' Code]] - [Var [Location' Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [Label [Code]] - ) - - (def: .public nil - Literal - (:abstraction "nil")) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "false" - #1 "true") - :abstraction)) - - (def: .public int - (-> Int Literal) - ... Integers must be turned into hexadecimal to avoid quirks in how Lua parses integers. - ... In particular, the number -9223372036854775808 will be incorrectly parsed as a float by Lua. - (.let [to_hex (\ n.hex encoded)] - (|>> .nat - to_hex - (format "0x") - :abstraction))) - - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "(1.0/0.0)" [])] - - [(f.= f.negative_infinity)] - [(new> "(-1.0/0.0)" [])] - - [(f.= f.not_a_number)] - [(new> "(0.0/0.0)" [])] - - ... else - [%.frac (text.replaced "+" "")]) - :abstraction)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe (text.enclosed' text.double_quote) :abstraction)) - - (def: .public multi - (-> (List Expression) Literal) - (|>> (list\each ..code) + [(implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any []) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: <brand> Any []) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [Label [Code]] + ) + + (def: .public nil + Literal + (:abstraction "nil")) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") + :abstraction)) + + (def: .public int + (-> Int Literal) + ... Integers must be turned into hexadecimal to avoid quirks in how Lua parses integers. + ... In particular, the number -9223372036854775808 will be incorrectly parsed as a float by Lua. + (.let [to_hex (\ n.hex encoded)] + (|>> .nat + to_hex + (format "0x") + :abstraction))) + + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "(1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(new> "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(new> "(0.0/0.0)" [])] + + ... else + [%.frac (text.replaced "+" "")]) + :abstraction)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe (text.enclosed' text.double_quote) :abstraction)) + + (def: .public multi + (-> (List Expression) Literal) + (|>> (list\each ..code) + (text.interposed ..input_separator) + :abstraction)) + + (def: .public array + (-> (List Expression) Literal) + (|>> (list\each ..code) + (text.interposed ..input_separator) + (text.enclosed ["{" "}"]) + :abstraction)) + + (def: .public table + (-> (List [Text Expression]) Literal) + (|>> (list\each (.function (_ [key value]) + (format key " = " (:representation value)))) + (text.interposed ..input_separator) + (text.enclosed ["{" "}"]) + :abstraction)) + + (def: .public (item idx array) + (-> Expression Expression Access) + (:abstraction (format (:representation array) "[" (:representation idx) "]"))) + + (def: .public (the field table) + (-> Text Expression Computation) + (:abstraction (format (:representation table) "." field))) + + (def: .public length + (-> Expression Computation) + (|>> :representation + (text.enclosed ["#(" ")"]) + :abstraction)) + + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (|> args + (list\each ..code) (text.interposed ..input_separator) + (text.enclosed ["(" ")"]) + (format (:representation func)) :abstraction)) - (def: .public array - (-> (List Expression) Literal) - (|>> (list\each ..code) + (def: .public (do method args table) + (-> Text (List Expression) Expression Computation) + (|> args + (list\each ..code) (text.interposed ..input_separator) - (text.enclosed ["{" "}"]) + (text.enclosed ["(" ")"]) + (format (:representation table) ":" method) :abstraction)) - (def: .public table - (-> (List [Text Expression]) Literal) - (|>> (list\each (.function (_ [key value]) - (format key " = " (:representation value)))) - (text.interposed ..input_separator) - (text.enclosed ["{" "}"]) - :abstraction)) - - (def: .public (item idx array) - (-> Expression Expression Access) - (:abstraction (format (:representation array) "[" (:representation idx) "]"))) - - (def: .public (the field table) - (-> Text Expression Computation) - (:abstraction (format (:representation table) "." field))) - - (def: .public length - (-> Expression Computation) - (|>> :representation - (text.enclosed ["#(" ")"]) + (template [<op> <name>] + [(def: .public (<name> parameter subject) + (-> Expression Expression Expression) + (:abstraction (format "(" + (:representation subject) + " " <op> " " + (:representation parameter) + ")")))] + + ["==" =] + ["<" <] + ["<=" <=] + [">" >] + [">=" >=] + ["+" +] + ["-" -] + ["*" *] + ["^" ^] + ["/" /] + ["//" //] + ["%" %] + [".." concat] + + ["or" or] + ["and" and] + ["|" bit_or] + ["&" bit_and] + ["~" bit_xor] + + ["<<" bit_shl] + [">>" bit_shr] + ) + + (template [<name> <unary>] + [(def: .public (<name> subject) + (-> Expression Expression) + (:abstraction (format "(" <unary> " " (:representation subject) ")")))] + + [not "not"] + [opposite "-"] + ) + + (template [<name> <type>] + [(def: .public <name> + (-> Text <type>) + (|>> :abstraction))] + + [var Var] + [label Label] + ) + + (def: .public statement + (-> Expression Statement) + (|>> :representation :abstraction)) + + (def: .public (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (def: locations + (-> (List Location) Text) + (|>> (list\each ..code) + (text.interposed ..input_separator))) + + (def: .public (local vars) + (-> (List Var) Statement) + (:abstraction (format "local " (..locations vars)))) + + (def: .public (set vars value) + (-> (List Location) Expression Statement) + (:abstraction (format (..locations vars) " = " (:representation value)))) + + (def: .public (let vars value) + (-> (List Var) Expression Statement) + (:abstraction (format "local " (..locations vars) " = " (:representation value)))) + + (def: .public (local/1 var value) + (-> Var Expression Statement) + (:abstraction (format "local " (:representation var) " = " (:representation value)))) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (:abstraction (format "if " (:representation test) + text.new_line "then" (..nested (:representation then!)) + text.new_line "else" (..nested (:representation else!)) + text.new_line "end"))) + + (def: .public (when test then!) + (-> Expression Statement Statement) + (:abstraction (format "if " (:representation test) + text.new_line "then" (..nested (:representation then!)) + text.new_line "end"))) + + (def: .public (while test body!) + (-> Expression Statement Statement) + (:abstraction + (format "while " (:representation test) " do" + (..nested (:representation body!)) + text.new_line "end"))) + + (def: .public (repeat until body!) + (-> Expression Statement Statement) + (:abstraction + (format "repeat" + (..nested (:representation body!)) + text.new_line "until " (:representation until)))) + + (def: .public (for_in vars source body!) + (-> (List Var) Expression Statement Statement) + (:abstraction + (format "for " (|> vars + (list\each ..code) + (text.interposed ..input_separator)) + " in " (:representation source) " do" + (..nested (:representation body!)) + text.new_line "end"))) + + (def: .public (for_step var from to step body!) + (-> Var Expression Expression Expression Statement + Statement) + (:abstraction + (format "for " (:representation var) + " = " (:representation from) + ..input_separator (:representation to) + ..input_separator (:representation step) " do" + (..nested (:representation body!)) + text.new_line "end"))) + + (def: .public (return value) + (-> Expression Statement) + (:abstraction (format "return " (:representation value)))) + + (def: .public (closure args body!) + (-> (List Var) Statement Expression) + (|> (format "function " (|> args + ..locations + (text.enclosed ["(" ")"])) + (..nested (:representation body!)) + text.new_line "end") + (text.enclosed ["(" ")"]) :abstraction)) - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (|> args - (list\each ..code) - (text.interposed ..input_separator) - (text.enclosed ["(" ")"]) - (format (:representation func)) - :abstraction)) - - (def: .public (do method args table) - (-> Text (List Expression) Expression Computation) - (|> args - (list\each ..code) - (text.interposed ..input_separator) - (text.enclosed ["(" ")"]) - (format (:representation table) ":" method) - :abstraction)) - - (template [<op> <name>] - [(def: .public (<name> parameter subject) - (-> Expression Expression Expression) - (:abstraction (format "(" - (:representation subject) - " " <op> " " - (:representation parameter) - ")")))] - - ["==" =] - ["<" <] - ["<=" <=] - [">" >] - [">=" >=] - ["+" +] - ["-" -] - ["*" *] - ["^" ^] - ["/" /] - ["//" //] - ["%" %] - [".." concat] - - ["or" or] - ["and" and] - ["|" bit_or] - ["&" bit_and] - ["~" bit_xor] - - ["<<" bit_shl] - [">>" bit_shr] - ) - - (template [<name> <unary>] - [(def: .public (<name> subject) - (-> Expression Expression) - (:abstraction (format "(" <unary> " " (:representation subject) ")")))] - - [not "not"] - [opposite "-"] - ) - - (template [<name> <type>] - [(def: .public <name> - (-> Text <type>) - (|>> :abstraction))] - - [var Var] - [label Label] - ) - - (def: .public statement - (-> Expression Statement) - (|>> :representation :abstraction)) - - (def: .public (then pre! post!) - (-> Statement Statement Statement) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (def: locations - (-> (List Location) Text) - (|>> (list\each ..code) - (text.interposed ..input_separator))) - - (def: .public (local vars) - (-> (List Var) Statement) - (:abstraction (format "local " (..locations vars)))) - - (def: .public (set vars value) - (-> (List Location) Expression Statement) - (:abstraction (format (..locations vars) " = " (:representation value)))) - - (def: .public (let vars value) - (-> (List Var) Expression Statement) - (:abstraction (format "local " (..locations vars) " = " (:representation value)))) - - (def: .public (local/1 var value) - (-> Var Expression Statement) - (:abstraction (format "local " (:representation var) " = " (:representation value)))) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (:abstraction (format "if " (:representation test) - text.new_line "then" (..nested (:representation then!)) - text.new_line "else" (..nested (:representation else!)) - text.new_line "end"))) - - (def: .public (when test then!) - (-> Expression Statement Statement) - (:abstraction (format "if " (:representation test) - text.new_line "then" (..nested (:representation then!)) - text.new_line "end"))) - - (def: .public (while test body!) - (-> Expression Statement Statement) - (:abstraction - (format "while " (:representation test) " do" - (..nested (:representation body!)) - text.new_line "end"))) - - (def: .public (repeat until body!) - (-> Expression Statement Statement) - (:abstraction - (format "repeat" - (..nested (:representation body!)) - text.new_line "until " (:representation until)))) - - (def: .public (for_in vars source body!) - (-> (List Var) Expression Statement Statement) - (:abstraction - (format "for " (|> vars - (list\each ..code) - (text.interposed ..input_separator)) - " in " (:representation source) " do" - (..nested (:representation body!)) - text.new_line "end"))) - - (def: .public (for_step var from to step body!) - (-> Var Expression Expression Expression Statement - Statement) - (:abstraction - (format "for " (:representation var) - " = " (:representation from) - ..input_separator (:representation to) - ..input_separator (:representation step) " do" - (..nested (:representation body!)) - text.new_line "end"))) - - (def: .public (return value) - (-> Expression Statement) - (:abstraction (format "return " (:representation value)))) - - (def: .public (closure args body!) - (-> (List Var) Statement Expression) - (|> (format "function " (|> args - ..locations - (text.enclosed ["(" ")"])) - (..nested (:representation body!)) - text.new_line "end") - (text.enclosed ["(" ")"]) - :abstraction)) - - (template [<name> <code>] - [(def: .public (<name> name args body!) - (-> Var (List Var) Statement Statement) - (:abstraction - (format <code> " " (:representation name) - (|> args - ..locations - (text.enclosed ["(" ")"])) - (..nested (:representation body!)) - text.new_line "end")))] - - [function "function"] - [local_function "local function"] - ) - - (def: .public break - Statement - (:abstraction "break")) - - (def: .public (set_label label) - (-> Label Statement) - (:abstraction (format "::" (:representation label) "::"))) - - (def: .public (go_to label) - (-> Label Statement) - (:abstraction (format "goto " (:representation label)))) + (template [<name> <code>] + [(def: .public (<name> name args body!) + (-> Var (List Var) Statement Statement) + (:abstraction + (format <code> " " (:representation name) + (|> args + ..locations + (text.enclosed ["(" ")"])) + (..nested (:representation body!)) + text.new_line "end")))] + + [function "function"] + [local_function "local function"] + ) + + (def: .public break + Statement + (:abstraction "break")) + + (def: .public (set_label label) + (-> Label Statement) + (:abstraction (format "::" (:representation label) "::"))) + + (def: .public (go_to label) + (-> Label Statement) + (:abstraction (format "goto " (:representation label))))] ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index ff6afe19f..dd205862f 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -44,497 +44,495 @@ (text.enclosed ["(" ")"])) (abstract: .public (Code brand) - {} - Text - (implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) {} Any) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: .public <brand> {} Any) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Literal [Computation' Expression' Code]] - [Var [Location' Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [Constant [Location' Computation' Expression' Code]] - [Global [Location' Computation' Expression' Code]] - [Label [Code]] - ) - - (type: .public Argument - (Record - [#reference? Bit - #var Var])) - - (def: .public ; - (-> Expression Statement) - (|>> :representation - (text.suffix ..statement_suffix) + [(implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any []) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: .public <brand> Any []) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [Constant [Location' Computation' Expression' Code]] + [Global [Location' Computation' Expression' Code]] + [Label [Code]] + ) + + (type: .public Argument + (Record + [#reference? Bit + #var Var])) + + (def: .public ; + (-> Expression Statement) + (|>> :representation + (text.suffix ..statement_suffix) + :abstraction)) + + (def: .public var + (-> Text Var) + (|>> (format "$") :abstraction)) + + (template [<name> <type>] + [(def: .public <name> + (-> Text <type>) + (|>> :abstraction))] + + [constant Constant] + [label Label] + ) + + (def: .public (set_label label) + (-> Label Statement) + (:abstraction (format (:representation label) ":"))) + + (def: .public (go_to label) + (-> Label Statement) + (:abstraction + (format "goto " (:representation label) ..statement_suffix))) + + (def: .public null + Literal + (:abstraction "NULL")) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") + :abstraction)) + + (def: .public int + (-> Int Literal) + (.let [to_hex (\ n.hex encoded)] + (|>> .nat + to_hex + (format "0x") + :abstraction))) + + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "+INF" [])] + + [(f.= f.negative_infinity)] + [(new> "-INF" [])] + + [(f.= f.not_a_number)] + [(new> "NAN" [])] + + ... else + [%.frac]) + :abstraction)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + ["$" "\$"] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed [text.double_quote text.double_quote]) + :abstraction)) + + (def: arguments + (-> (List Expression) Text) + (|>> (list\each ..code) (text.interposed ..input_separator) ..group)) + + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (|> (format (:representation func) (..arguments args)) :abstraction)) - (def: .public var - (-> Text Var) - (|>> (format "$") :abstraction)) + ... TODO: Remove when no longer using JPHP. + (def: .public (apply/*' args func) + (-> (List Expression) Expression Computation) + (apply/* (list& func args) (..constant "call_user_func"))) + + (def: parameters + (-> (List Argument) Text) + (|>> (list\each (function (_ [reference? var]) + (.if reference? + (format "&" (:representation var)) + (:representation var)))) + (text.interposed ..input_separator) + ..group)) + + (template [<name> <reference?>] + [(def: .public <name> + (-> Var Argument) + (|>> [<reference?>]))] + + [parameter #0] + [reference #1] + ) + + (def: .public (closure uses arguments body!) + (-> (List Argument) (List Argument) Statement Literal) + (let [uses (case uses + #.End + "" + + _ + (format "use " (..parameters uses)))] + (|> (format "function " (..parameters arguments) + " " uses " " + (..block (:representation body!))) + ..group + :abstraction))) - (template [<name> <type>] - [(def: .public <name> - (-> Text <type>) - (|>> :abstraction))] + (syntax: (arity_inputs [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> (-- arity) + (enum.range n.enum 0) + (list\each (|>> %.nat code.local_identifier)))))) + + (syntax: (arity_types [arity <code>.nat]) + (in (list.repeated arity (` ..Expression)))) + + (template [<arity> <function>+] + [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) + <inputs> (arity_inputs <arity>) + <types> (arity_types <arity>) + <definitions> (template.spliced <function>+)] + (def: .public (<apply> function [<inputs>]) + (-> Expression [<types>] Computation) + (..apply/* (.list <inputs>) function)) + + (template [<function>] + [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) + (<apply> (..constant <function>))))] + + <definitions>))] + + [0 + [["func_num_args"] + ["func_get_args"] + ["time"] + ["phpversion"]]] + + [1 + [["isset"] + ["var_dump"] + ["is_null"] + ["empty"] + ["count"] + ["array_pop"] + ["array_reverse"] + ["intval"] + ["floatval"] + ["strval"] + ["ord"] + ["chr"] + ["print"] + ["exit"] + ["iconv_strlen"] ["strlen"] + ["log"] + ["ceil"] + ["floor"] + ["is_nan"]]] + + [2 + [["intdiv"] + ["fmod"] + ["number_format"] + ["array_key_exists"] + ["call_user_func_array"] + ["array_slice"] + ["array_push"] + ["pack"] + ["unpack"] + ["iconv_strpos"] ["strpos"] + ["pow"] + ["max"]]] + + [3 + [["array_fill"] + ["array_slice"] + ["array_splice"] + ["iconv"] + ["iconv_strpos"] ["strpos"] + ["iconv_substr"] ["substr"]]] + ) + + (def: .public (key_value key value) + (-> Expression Expression Expression) + (:abstraction (format (:representation key) " => " (:representation value)))) + + (def: .public (array/* values) + (-> (List Expression) Literal) + (|> values + (list\each ..code) + (text.interposed ..input_separator) + ..group + (format "array") + :abstraction)) - [constant Constant] - [label Label] - ) + (def: .public (array_merge/+ required optionals) + (-> Expression (List Expression) Computation) + (..apply/* (list& required optionals) (..constant "array_merge"))) - (def: .public (set_label label) - (-> Label Statement) - (:abstraction (format (:representation label) ":"))) + (def: .public (array/** kvs) + (-> (List [Expression Expression]) Literal) + (|> kvs + (list\each (function (_ [key value]) + (format (:representation key) " => " (:representation value)))) + (text.interposed ..input_separator) + ..group + (format "array") + :abstraction)) - (def: .public (go_to label) - (-> Label Statement) - (:abstraction - (format "goto " (:representation label) ..statement_suffix))) + (def: .public (new constructor inputs) + (-> Constant (List Expression) Computation) + (|> (format "new " (:representation constructor) (arguments inputs)) + :abstraction)) - (def: .public null - Literal - (:abstraction "NULL")) + (def: .public (the field object) + (-> Text Expression Computation) + (|> (format (:representation object) "->" field) + :abstraction)) - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "false" - #1 "true") + (def: .public (do method inputs object) + (-> Text (List Expression) Expression Computation) + (|> (format (:representation (..the method object)) + (..arguments inputs)) :abstraction)) - (def: .public int - (-> Int Literal) - (.let [to_hex (\ n.hex encoded)] - (|>> .nat - to_hex - (format "0x") - :abstraction))) + (def: .public (item idx array) + (-> Expression Expression Access) + (|> (format (:representation array) "[" (:representation idx) "]") + :abstraction)) - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "+INF" [])] - - [(f.= f.negative_infinity)] - [(new> "-INF" [])] - - [(f.= f.not_a_number)] - [(new> "NAN" [])] - - ... else - [%.frac]) + (def: .public (global name) + (-> Text Global) + (|> (..var "GLOBALS") (..item (..string name)) :transmutation)) + + (def: .public (? test then else) + (-> Expression Expression Expression Computation) + (|> (format (..group (:representation test)) " ? " + (..group (:representation then)) " : " + (..group (:representation else))) + ..group :abstraction)) - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - ["$" "\$"] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed [text.double_quote text.double_quote]) + (template [<name> <op>] + [(def: .public (<name> parameter subject) + (-> Expression Expression Computation) + (|> (format (:representation subject) " " <op> " " (:representation parameter)) + ..group + :abstraction))] + + [or "||"] + [and "&&"] + [== "=="] + [=== "==="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [% "%"] + [bit_or "|"] + [bit_and "&"] + [bit_xor "^"] + [bit_shl "<<"] + [bit_shr ">>"] + [concat "."] + ) + + (template [<unary> <name>] + [(def: .public <name> + (-> Computation Computation) + (|>> :representation (format <unary>) :abstraction))] + + ["!" not] + ["~" bit_not] + ["-" opposite] + ) + + (def: .public (set var value) + (-> Location Expression Computation) + (|> (format (:representation var) " = " (:representation value)) + ..group :abstraction)) - (def: arguments - (-> (List Expression) Text) - (|>> (list\each ..code) (text.interposed ..input_separator) ..group)) - - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (|> (format (:representation func) (..arguments args)) - :abstraction)) - - ... TODO: Remove when no longer using JPHP. - (def: .public (apply/*' args func) - (-> (List Expression) Expression Computation) - (apply/* (list& func args) (..constant "call_user_func"))) - - (def: parameters - (-> (List Argument) Text) - (|>> (list\each (function (_ [reference? var]) - (.if reference? - (format "&" (:representation var)) - (:representation var)))) - (text.interposed ..input_separator) - ..group)) - - (template [<name> <reference?>] - [(def: .public <name> - (-> Var Argument) - (|>> [<reference?>]))] - - [parameter #0] - [reference #1] - ) - - (def: .public (closure uses arguments body!) - (-> (List Argument) (List Argument) Statement Literal) - (let [uses (case uses - #.End - "" - - _ - (format "use " (..parameters uses)))] - (|> (format "function " (..parameters arguments) - " " uses " " - (..block (:representation body!))) - ..group - :abstraction))) - - (syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> (-- arity) - (enum.range n.enum 0) - (list\each (|>> %.nat code.local_identifier)))))) - - (syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) - - (template [<arity> <function>+] - [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) - <inputs> (arity_inputs <arity>) - <types> (arity_types <arity>) - <definitions> (template.spliced <function>+)] - (def: .public (<apply> function [<inputs>]) - (-> Expression [<types>] Computation) - (..apply/* (.list <inputs>) function)) - - (template [<function>] - [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) - (<apply> (..constant <function>))))] - - <definitions>))] - - [0 - [["func_num_args"] - ["func_get_args"] - ["time"] - ["phpversion"]]] - - [1 - [["isset"] - ["var_dump"] - ["is_null"] - ["empty"] - ["count"] - ["array_pop"] - ["array_reverse"] - ["intval"] - ["floatval"] - ["strval"] - ["ord"] - ["chr"] - ["print"] - ["exit"] - ["iconv_strlen"] ["strlen"] - ["log"] - ["ceil"] - ["floor"] - ["is_nan"]]] - - [2 - [["intdiv"] - ["fmod"] - ["number_format"] - ["array_key_exists"] - ["call_user_func_array"] - ["array_slice"] - ["array_push"] - ["pack"] - ["unpack"] - ["iconv_strpos"] ["strpos"] - ["pow"] - ["max"]]] - - [3 - [["array_fill"] - ["array_slice"] - ["array_splice"] - ["iconv"] - ["iconv_strpos"] ["strpos"] - ["iconv_substr"] ["substr"]]] - ) - - (def: .public (key_value key value) - (-> Expression Expression Expression) - (:abstraction (format (:representation key) " => " (:representation value)))) - - (def: .public (array/* values) - (-> (List Expression) Literal) - (|> values - (list\each ..code) - (text.interposed ..input_separator) - ..group - (format "array") - :abstraction)) - - (def: .public (array_merge/+ required optionals) - (-> Expression (List Expression) Computation) - (..apply/* (list& required optionals) (..constant "array_merge"))) - - (def: .public (array/** kvs) - (-> (List [Expression Expression]) Literal) - (|> kvs - (list\each (function (_ [key value]) - (format (:representation key) " => " (:representation value)))) - (text.interposed ..input_separator) - ..group - (format "array") - :abstraction)) - - (def: .public (new constructor inputs) - (-> Constant (List Expression) Computation) - (|> (format "new " (:representation constructor) (arguments inputs)) - :abstraction)) - - (def: .public (the field object) - (-> Text Expression Computation) - (|> (format (:representation object) "->" field) - :abstraction)) - - (def: .public (do method inputs object) - (-> Text (List Expression) Expression Computation) - (|> (format (:representation (..the method object)) - (..arguments inputs)) - :abstraction)) - - (def: .public (item idx array) - (-> Expression Expression Access) - (|> (format (:representation array) "[" (:representation idx) "]") - :abstraction)) - - (def: .public (global name) - (-> Text Global) - (|> (..var "GLOBALS") (..item (..string name)) :transmutation)) - - (def: .public (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (..group (:representation test)) " ? " - (..group (:representation then)) " : " - (..group (:representation else))) - ..group - :abstraction)) - - (template [<name> <op>] - [(def: .public (<name> parameter subject) - (-> Expression Expression Computation) - (|> (format (:representation subject) " " <op> " " (:representation parameter)) - ..group - :abstraction))] - - [or "||"] - [and "&&"] - [== "=="] - [=== "==="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [% "%"] - [bit_or "|"] - [bit_and "&"] - [bit_xor "^"] - [bit_shl "<<"] - [bit_shr ">>"] - [concat "."] - ) - - (template [<unary> <name>] - [(def: .public <name> - (-> Computation Computation) - (|>> :representation (format <unary>) :abstraction))] - - ["!" not] - ["~" bit_not] - ["-" opposite] - ) - - (def: .public (set var value) - (-> Location Expression Computation) - (|> (format (:representation var) " = " (:representation value)) - ..group - :abstraction)) - - (def: .public (set! var value) - (-> Location Expression Statement) - (:abstraction (format (:representation var) " = " (:representation value) ";"))) - - (def: .public (set? var) - (-> Var Computation) - (..apply/1 [var] (..constant "isset"))) - - (template [<name> <modifier>] - [(def: .public <name> - (-> Var Statement) - (|>> :representation (format <modifier> " ") (text.suffix ..statement_suffix) :abstraction))] - - [define_global "global"] - ) - - (template [<name> <modifier> <location>] - [(def: .public (<name> location value) - (-> <location> Expression Statement) - (:abstraction (format <modifier> " " (:representation location) - " = " (:representation value) - ..statement_suffix)))] - - [define_static "static" Var] - [define_constant "const" Constant] - ) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (:abstraction - (format "if" (..group (:representation test)) " " - (..block (:representation then!)) - " else " - (..block (:representation else!))))) - - (def: .public (when test then!) - (-> Expression Statement Statement) - (:abstraction - (format "if" (..group (:representation test)) " " - (..block (:representation then!))))) - - (def: .public (then pre! post!) - (-> Statement Statement Statement) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (def: .public (while test body!) - (-> Expression Statement Statement) - (:abstraction - (format "while" (..group (:representation test)) " " - (..block (:representation body!))))) - - (def: .public (do_while test body!) - (-> Expression Statement Statement) - (:abstraction - (format "do " (..block (:representation body!)) - " while" (..group (:representation test)) - ..statement_suffix))) - - (def: .public (for_each array value body!) - (-> Expression Var Statement Statement) - (:abstraction - (format "foreach(" (:representation array) - " as " (:representation value) - ") " (..block (:representation body!))))) - - (type: .public Except - (Record - [#class Constant - #exception Var - #handler Statement])) - - (def: (catch except) - (-> Except Text) - (let [declaration (format (:representation (value@ #class except)) - " " (:representation (value@ #exception except)))] - (format "catch" (..group declaration) " " - (..block (:representation (value@ #handler except)))))) - - (def: .public (try body! excepts) - (-> Statement (List Except) Statement) - (:abstraction - (format "try " (..block (:representation body!)) - text.new_line - (|> excepts - (list\each catch) - (text.interposed text.new_line))))) - - (template [<name> <keyword>] - [(def: .public <name> - (-> Expression Statement) - (|>> :representation (format <keyword> " ") (text.suffix ..statement_suffix) :abstraction))] - - [throw "throw"] - [return "return"] - [echo "echo"] - ) - - (def: .public (define name value) - (-> Constant Expression Expression) - (..apply/2 (..constant "define") - [(|> name :representation ..string) - value])) - - (def: .public (define_function name arguments body!) - (-> Constant (List Argument) Statement Statement) - (:abstraction - (format "function " (:representation name) - (..parameters arguments) - " " - (..block (:representation body!))))) - - (template [<name> <keyword>] - [(def: .public <name> - Statement - (|> <keyword> - (text.suffix ..statement_suffix) - :abstraction))] - - [break "break"] - [continue "continue"] - ) - - (def: .public splat - (-> Expression Expression) - (|>> :representation (format "...") :abstraction)) + (def: .public (set! var value) + (-> Location Expression Statement) + (:abstraction (format (:representation var) " = " (:representation value) ";"))) + + (def: .public (set? var) + (-> Var Computation) + (..apply/1 [var] (..constant "isset"))) + + (template [<name> <modifier>] + [(def: .public <name> + (-> Var Statement) + (|>> :representation (format <modifier> " ") (text.suffix ..statement_suffix) :abstraction))] + + [define_global "global"] + ) + + (template [<name> <modifier> <location>] + [(def: .public (<name> location value) + (-> <location> Expression Statement) + (:abstraction (format <modifier> " " (:representation location) + " = " (:representation value) + ..statement_suffix)))] + + [define_static "static" Var] + [define_constant "const" Constant] + ) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (:abstraction + (format "if" (..group (:representation test)) " " + (..block (:representation then!)) + " else " + (..block (:representation else!))))) + + (def: .public (when test then!) + (-> Expression Statement Statement) + (:abstraction + (format "if" (..group (:representation test)) " " + (..block (:representation then!))))) + + (def: .public (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (def: .public (while test body!) + (-> Expression Statement Statement) + (:abstraction + (format "while" (..group (:representation test)) " " + (..block (:representation body!))))) + + (def: .public (do_while test body!) + (-> Expression Statement Statement) + (:abstraction + (format "do " (..block (:representation body!)) + " while" (..group (:representation test)) + ..statement_suffix))) + + (def: .public (for_each array value body!) + (-> Expression Var Statement Statement) + (:abstraction + (format "foreach(" (:representation array) + " as " (:representation value) + ") " (..block (:representation body!))))) + + (type: .public Except + (Record + [#class Constant + #exception Var + #handler Statement])) + + (def: (catch except) + (-> Except Text) + (let [declaration (format (:representation (value@ #class except)) + " " (:representation (value@ #exception except)))] + (format "catch" (..group declaration) " " + (..block (:representation (value@ #handler except)))))) + + (def: .public (try body! excepts) + (-> Statement (List Except) Statement) + (:abstraction + (format "try " (..block (:representation body!)) + text.new_line + (|> excepts + (list\each catch) + (text.interposed text.new_line))))) + + (template [<name> <keyword>] + [(def: .public <name> + (-> Expression Statement) + (|>> :representation (format <keyword> " ") (text.suffix ..statement_suffix) :abstraction))] + + [throw "throw"] + [return "return"] + [echo "echo"] + ) + + (def: .public (define name value) + (-> Constant Expression Expression) + (..apply/2 (..constant "define") + [(|> name :representation ..string) + value])) + + (def: .public (define_function name arguments body!) + (-> Constant (List Argument) Statement Statement) + (:abstraction + (format "function " (:representation name) + (..parameters arguments) + " " + (..block (:representation body!))))) + + (template [<name> <keyword>] + [(def: .public <name> + Statement + (|> <keyword> + (text.suffix ..statement_suffix) + :abstraction))] + + [break "break"] + [continue "continue"] + ) + + (def: .public splat + (-> Expression Expression) + (|>> :representation (format "...") :abstraction))] ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 038641b6e..4988e4d78 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -48,407 +48,405 @@ (text.replaced text.new_line nested_new_line))))) (abstract: .public (Code brand) - {} - Text - (implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: (<brand> brand) {} Any)) - (`` (type: .public (<type> brand) - (<super> (<brand> brand)))))] - - [Expression Code] - [Computation Expression] - [Location Computation] - [Var Location] - [Statement Code] - ) - - (template [<type> <super>] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (`` (abstract: <brand> {} Any)) - (`` (type: .public <type> (<super> <brand>))))] - - [Literal Computation] - [Access Location] - [Loop Statement] - [Label Code] - ) - - (template [<var> <brand>] - [(abstract: .public <brand> {} Any) - - (type: .public <var> (Var <brand>))] - - [SVar Single] - [PVar Poly] - [KVar Keyword] - ) - - (def: .public var - (-> Text SVar) - (|>> :abstraction)) - - (template [<name> <brand> <prefix>] - [(def: .public <name> - (-> SVar (Var <brand>)) - (|>> :representation (format <prefix>) :abstraction))] - - [poly Poly "*"] - [keyword Keyword "**"] - ) - - (def: .public none - Literal - (:abstraction "None")) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "False" - #1 "True") - :abstraction)) - - (def: .public int - (-> Int Literal) - (|>> %.int :abstraction)) - - (def: .public (long value) - (-> Int Literal) - (:abstraction (format (%.int value) "L"))) - - (def: .public float - (-> Frac Literal) - (`` (|>> (cond> (~~ (template [<test> <python>] - [[<test>] - [(new> (format "float(" text.double_quote <python> text.double_quote ")") [])]] - - [(f.= f.positive_infinity) "inf"] - [(f.= f.negative_infinity) "-inf"] - [f.not_a_number? "nan"] - )) - - ... else - [%.frac]) - :abstraction))) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Literal) - (|>> ..safe - (text.enclosed [text.double_quote text.double_quote]) - :abstraction)) - - (def: .public unicode - (-> Text Literal) - (|>> ..string - :representation - (format "u") - :abstraction)) - - (def: (composite_literal left_delimiter right_delimiter entry_serializer) - (All (_ a) - (-> Text Text (-> a Text) - (-> (List a) Literal))) - (function (_ entries) - (<| :abstraction - ... ..expression - (format left_delimiter - (|> entries - (list\each entry_serializer) - (text.interposed ", ")) - right_delimiter)))) - - (template [<name> <pre> <post>] - [(def: .public <name> - (-> (List (Expression Any)) Literal) - (composite_literal <pre> <post> ..code))] - - [tuple "(" ")"] - [list "[" "]"] - ) - - (def: .public (slice from to list) - (-> (Expression Any) (Expression Any) (Expression Any) Access) - (<| :abstraction - ... ..expression - (format (:representation list) "[" (:representation from) ":" (:representation to) "]"))) - - (def: .public (slice_from from list) - (-> (Expression Any) (Expression Any) Access) - (<| :abstraction - ... ..expression - (format (:representation list) "[" (:representation from) ":]"))) - - (def: .public dict - (-> (List [(Expression Any) (Expression Any)]) (Computation Any)) - (composite_literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v))))) - - (def: .public (apply/* func args) - (-> (Expression Any) (List (Expression Any)) (Computation Any)) - (<| :abstraction - ... ..expression - (format (:representation func) "(" (text.interposed ", " (list\each ..code args)) ")"))) - - (template [<name> <brand> <prefix>] - [(def: (<name> var) - (-> (Expression Any) Text) - (format <prefix> (:representation var)))] - - [splat_poly Poly "*"] - [splat_keyword Keyword "**"] - ) - - (template [<name> <splat>] - [(def: .public (<name> args extra func) - (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any)) + [(implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: (<brand> brand) Any [])) + (`` (type: .public (<type> brand) + (<super> (<brand> brand)))))] + + [Expression Code] + [Computation Expression] + [Location Computation] + [Var Location] + [Statement Code] + ) + + (template [<type> <super>] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (`` (abstract: <brand> Any [])) + (`` (type: .public <type> (<super> <brand>))))] + + [Literal Computation] + [Access Location] + [Loop Statement] + [Label Code] + ) + + (template [<var> <brand>] + [(abstract: .public <brand> Any []) + + (type: .public <var> (Var <brand>))] + + [SVar Single] + [PVar Poly] + [KVar Keyword] + ) + + (def: .public var + (-> Text SVar) + (|>> :abstraction)) + + (template [<name> <brand> <prefix>] + [(def: .public <name> + (-> SVar (Var <brand>)) + (|>> :representation (format <prefix>) :abstraction))] + + [poly Poly "*"] + [keyword Keyword "**"] + ) + + (def: .public none + Literal + (:abstraction "None")) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "False" + #1 "True") + :abstraction)) + + (def: .public int + (-> Int Literal) + (|>> %.int :abstraction)) + + (def: .public (long value) + (-> Int Literal) + (:abstraction (format (%.int value) "L"))) + + (def: .public float + (-> Frac Literal) + (`` (|>> (cond> (~~ (template [<test> <python>] + [[<test>] + [(new> (format "float(" text.double_quote <python> text.double_quote ")") [])]] + + [(f.= f.positive_infinity) "inf"] + [(f.= f.negative_infinity) "-inf"] + [f.not_a_number? "nan"] + )) + + ... else + [%.frac]) + :abstraction))) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Literal) + (|>> ..safe + (text.enclosed [text.double_quote text.double_quote]) + :abstraction)) + + (def: .public unicode + (-> Text Literal) + (|>> ..string + :representation + (format "u") + :abstraction)) + + (def: (composite_literal left_delimiter right_delimiter entry_serializer) + (All (_ a) + (-> Text Text (-> a Text) + (-> (List a) Literal))) + (function (_ entries) (<| :abstraction ... ..expression - (format (:representation func) - (format "(" (|> args - (list\each (function (_ arg) (format (:representation arg) ", "))) - text.together) - (<splat> extra) ")"))))] - - [apply_poly splat_poly] - [apply_keyword splat_keyword] - ) - - (def: .public (the name object) - (-> Text (Expression Any) (Computation Any)) - (:abstraction (format (:representation object) "." name))) - - (def: .public (do method args object) - (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) - (..apply/* (..the method object) args)) - - (template [<name> <apply>] - [(def: .public (<name> args extra method) - (-> (List (Expression Any)) (Expression Any) Text - (-> (Expression Any) (Computation Any))) - (|>> (..the method) (<apply> args extra)))] - - [do_poly apply_poly] - [do_keyword apply_keyword] - ) - - (def: .public (item idx array) - (-> (Expression Any) (Expression Any) Location) - (:abstraction (format (:representation array) "[" (:representation idx) "]"))) - - (def: .public (? test then else) - (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) - (<| :abstraction - ..expression - (format (:representation then) " if " (:representation test) " else " (:representation else)))) - - (template [<name> <op>] - [(def: .public (<name> param subject) - (-> (Expression Any) (Expression Any) (Computation Any)) - (<| :abstraction - ..expression - (format (:representation subject) " " <op> " " (:representation param))))] - - [is "is"] - [= "=="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [// "//"] - [% "%"] - [** "**"] - [bit_or "|"] - [bit_and "&"] - [bit_xor "^"] - [bit_shl "<<"] - [bit_shr ">>"] - - [or "or"] - [and "and"] - ) - - (template [<name> <unary>] - [(def: .public (<name> subject) - (-> (Expression Any) (Computation Any)) - (<| :abstraction - ... ..expression - (format <unary> " " (:representation subject))))] - - [not "not"] - [opposite "-"] - ) - - (def: .public (lambda arguments body) - (-> (List (Var Any)) (Expression Any) (Computation Any)) - (<| :abstraction - ..expression - (format "lambda " (|> arguments (list\each ..code) (text.interposed ", ")) ": " - (:representation body)))) - - (def: .public (set vars value) - (-> (List (Location Any)) (Expression Any) (Statement Any)) - (:abstraction - (format (|> vars (list\each ..code) (text.interposed ", ")) - " = " - (:representation value)))) - - (def: .public (delete where) - (-> (Location Any) (Statement Any)) - (:abstraction (format "del " (:representation where)))) - - (def: .public (if test then! else!) - (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any)) - (:abstraction - (format "if " (:representation test) ":" - (..nested (:representation then!)) - text.new_line "else:" - (..nested (:representation else!))))) - - (def: .public (when test then!) - (-> (Expression Any) (Statement Any) (Statement Any)) - (:abstraction - (format "if " (:representation test) ":" - (..nested (:representation then!))))) - - (def: .public (then pre! post!) - (-> (Statement Any) (Statement Any) (Statement Any)) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (template [<keyword> <0>] - [(def: .public <0> - (Statement Any) - (:abstraction <keyword>))] - - ["break" break] - ["continue" continue] - ) - - (def: .public (while test body! else!) - (-> (Expression Any) (Statement Any) (Maybe (Statement Any)) Loop) - (:abstraction - (format "while " (:representation test) ":" - (..nested (:representation body!)) - (case else! - (#.Some else!) - (format text.new_line "else:" - (..nested (:representation else!))) - - #.None - "")))) - - (def: .public (for_in var inputs body!) - (-> SVar (Expression Any) (Statement Any) Loop) - (:abstraction - (format "for " (:representation var) " in " (:representation inputs) ":" - (..nested (:representation body!))))) - - (def: .public statement - (-> (Expression Any) (Statement Any)) - (|>> :transmutation)) - - (def: .public pass - (Statement Any) - (:abstraction "pass")) - - (type: .public Except - (Record - [#classes (List SVar) - #exception SVar - #handler (Statement Any)])) - - (def: .public (try body! excepts) - (-> (Statement Any) (List Except) (Statement Any)) - (:abstraction - (format "try:" - (..nested (:representation body!)) - (|> excepts - (list\each (function (_ [classes exception catch!]) - (format text.new_line "except (" (text.interposed ", " (list\each ..code classes)) - ") as " (:representation exception) ":" - (..nested (:representation catch!))))) - text.together)))) - - (template [<name> <keyword> <pre>] - [(def: .public (<name> value) - (-> (Expression Any) (Statement Any)) + (format left_delimiter + (|> entries + (list\each entry_serializer) + (text.interposed ", ")) + right_delimiter)))) + + (template [<name> <pre> <post>] + [(def: .public <name> + (-> (List (Expression Any)) Literal) + (composite_literal <pre> <post> ..code))] + + [tuple "(" ")"] + [list "[" "]"] + ) + + (def: .public (slice from to list) + (-> (Expression Any) (Expression Any) (Expression Any) Access) + (<| :abstraction + ... ..expression + (format (:representation list) "[" (:representation from) ":" (:representation to) "]"))) + + (def: .public (slice_from from list) + (-> (Expression Any) (Expression Any) Access) + (<| :abstraction + ... ..expression + (format (:representation list) "[" (:representation from) ":]"))) + + (def: .public dict + (-> (List [(Expression Any) (Expression Any)]) (Computation Any)) + (composite_literal "{" "}" (.function (_ [k v]) (format (:representation k) " : " (:representation v))))) + + (def: .public (apply/* func args) + (-> (Expression Any) (List (Expression Any)) (Computation Any)) + (<| :abstraction + ... ..expression + (format (:representation func) "(" (text.interposed ", " (list\each ..code args)) ")"))) + + (template [<name> <brand> <prefix>] + [(def: (<name> var) + (-> (Expression Any) Text) + (format <prefix> (:representation var)))] + + [splat_poly Poly "*"] + [splat_keyword Keyword "**"] + ) + + (template [<name> <splat>] + [(def: .public (<name> args extra func) + (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any)) + (<| :abstraction + ... ..expression + (format (:representation func) + (format "(" (|> args + (list\each (function (_ arg) (format (:representation arg) ", "))) + text.together) + (<splat> extra) ")"))))] + + [apply_poly splat_poly] + [apply_keyword splat_keyword] + ) + + (def: .public (the name object) + (-> Text (Expression Any) (Computation Any)) + (:abstraction (format (:representation object) "." name))) + + (def: .public (do method args object) + (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) + (..apply/* (..the method object) args)) + + (template [<name> <apply>] + [(def: .public (<name> args extra method) + (-> (List (Expression Any)) (Expression Any) Text + (-> (Expression Any) (Computation Any))) + (|>> (..the method) (<apply> args extra)))] + + [do_poly apply_poly] + [do_keyword apply_keyword] + ) + + (def: .public (item idx array) + (-> (Expression Any) (Expression Any) Location) + (:abstraction (format (:representation array) "[" (:representation idx) "]"))) + + (def: .public (? test then else) + (-> (Expression Any) (Expression Any) (Expression Any) (Computation Any)) + (<| :abstraction + ..expression + (format (:representation then) " if " (:representation test) " else " (:representation else)))) + + (template [<name> <op>] + [(def: .public (<name> param subject) + (-> (Expression Any) (Expression Any) (Computation Any)) + (<| :abstraction + ..expression + (format (:representation subject) " " <op> " " (:representation param))))] + + [is "is"] + [= "=="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [// "//"] + [% "%"] + [** "**"] + [bit_or "|"] + [bit_and "&"] + [bit_xor "^"] + [bit_shl "<<"] + [bit_shr ">>"] + + [or "or"] + [and "and"] + ) + + (template [<name> <unary>] + [(def: .public (<name> subject) + (-> (Expression Any) (Computation Any)) + (<| :abstraction + ... ..expression + (format <unary> " " (:representation subject))))] + + [not "not"] + [opposite "-"] + ) + + (def: .public (lambda arguments body) + (-> (List (Var Any)) (Expression Any) (Computation Any)) + (<| :abstraction + ..expression + (format "lambda " (|> arguments (list\each ..code) (text.interposed ", ")) ": " + (:representation body)))) + + (def: .public (set vars value) + (-> (List (Location Any)) (Expression Any) (Statement Any)) + (:abstraction + (format (|> vars (list\each ..code) (text.interposed ", ")) + " = " + (:representation value)))) + + (def: .public (delete where) + (-> (Location Any) (Statement Any)) + (:abstraction (format "del " (:representation where)))) + + (def: .public (if test then! else!) + (-> (Expression Any) (Statement Any) (Statement Any) (Statement Any)) + (:abstraction + (format "if " (:representation test) ":" + (..nested (:representation then!)) + text.new_line "else:" + (..nested (:representation else!))))) + + (def: .public (when test then!) + (-> (Expression Any) (Statement Any) (Statement Any)) + (:abstraction + (format "if " (:representation test) ":" + (..nested (:representation then!))))) + + (def: .public (then pre! post!) + (-> (Statement Any) (Statement Any) (Statement Any)) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (template [<keyword> <0>] + [(def: .public <0> + (Statement Any) + (:abstraction <keyword>))] + + ["break" break] + ["continue" continue] + ) + + (def: .public (while test body! else!) + (-> (Expression Any) (Statement Any) (Maybe (Statement Any)) Loop) + (:abstraction + (format "while " (:representation test) ":" + (..nested (:representation body!)) + (case else! + (#.Some else!) + (format text.new_line "else:" + (..nested (:representation else!))) + + #.None + "")))) + + (def: .public (for_in var inputs body!) + (-> SVar (Expression Any) (Statement Any) Loop) + (:abstraction + (format "for " (:representation var) " in " (:representation inputs) ":" + (..nested (:representation body!))))) + + (def: .public statement + (-> (Expression Any) (Statement Any)) + (|>> :transmutation)) + + (def: .public pass + (Statement Any) + (:abstraction "pass")) + + (type: .public Except + (Record + [#classes (List SVar) + #exception SVar + #handler (Statement Any)])) + + (def: .public (try body! excepts) + (-> (Statement Any) (List Except) (Statement Any)) + (:abstraction + (format "try:" + (..nested (:representation body!)) + (|> excepts + (list\each (function (_ [classes exception catch!]) + (format text.new_line "except (" (text.interposed ", " (list\each ..code classes)) + ") as " (:representation exception) ":" + (..nested (:representation catch!))))) + text.together)))) + + (template [<name> <keyword> <pre>] + [(def: .public (<name> value) + (-> (Expression Any) (Statement Any)) + (:abstraction + (format <keyword> (<pre> (:representation value)))))] + + [raise "raise " |>] + [return "return " |>] + [print "print" ..expression] + ) + + (def: .public (exec code globals) + (-> (Expression Any) (Maybe (Expression Any)) (Statement Any)) + (let [extra (case globals + (#.Some globals) + (.list globals) + + #.None + (.list))] (:abstraction - (format <keyword> (<pre> (:representation value)))))] - - [raise "raise " |>] - [return "return " |>] - [print "print" ..expression] - ) - - (def: .public (exec code globals) - (-> (Expression Any) (Maybe (Expression Any)) (Statement Any)) - (let [extra (case globals - (#.Some globals) - (.list globals) - - #.None - (.list))] - (:abstraction - (format "exec" (:representation (..tuple (list& code extra))))))) - - (def: .public (def name args body) - (-> SVar (List (Ex (_ k) (Var k))) (Statement Any) (Statement Any)) - (:abstraction - (format "def " (:representation name) - "(" (|> args (list\each ..code) (text.interposed ", ")) "):" - (..nested (:representation body))))) - - (def: .public (import module_name) - (-> Text (Statement Any)) - (:abstraction (format "import " module_name))) - - (def: .public (comment commentary on) - (All (_ brand) (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..safe commentary) text.new_line - (:representation on)))) + (format "exec" (:representation (..tuple (list& code extra))))))) + + (def: .public (def name args body) + (-> SVar (List (Ex (_ k) (Var k))) (Statement Any) (Statement Any)) + (:abstraction + (format "def " (:representation name) + "(" (|> args (list\each ..code) (text.interposed ", ")) "):" + (..nested (:representation body))))) + + (def: .public (import module_name) + (-> Text (Statement Any)) + (:abstraction (format "import " module_name))) + + (def: .public (comment commentary on) + (All (_ brand) (-> Text (Code brand) (Code brand))) + (:abstraction (format "# " (..safe commentary) text.new_line + (:representation on))))] ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index 3e7e5e63e..323b8c4bb 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -25,364 +25,362 @@ (abstract: .public (Code kind) Text - {} - - (template [<type> <super>+] - [(with_expansions [<kind> (template.identifier [<type> "'"])] - (abstract: .public (<kind> kind) Any) - (`` (type: .public <type> (|> Any <kind> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<kind> (template.identifier [<type> "'"])] - (abstract: .public (<kind> kind) Any) - (`` (type: .public (<type> <brand>) (|> <brand> <kind> (~~ (template.spliced <super>+))))))] - - [Var [Expression' Code]] - ) - - (template [<var> <kind>] - [(abstract: .public <kind> Any) - (type: .public <var> (Var <kind>))] - - [SVar Single] - [PVar Poly] - ) - - (def: .public var - (-> Text SVar) - (|>> :abstraction)) - - (def: .public var_args - PVar - (:abstraction "...")) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (def: (self_contained code) - (-> Text Expression) - (:abstraction - (format "(" code ")"))) - - (def: nested_new_line - (format text.new_line text.tab)) - - (def: nested - (-> Text Text) - (|>> (text.replaced text.new_line ..nested_new_line) - (format ..nested_new_line))) - - (def: (_block expression) - (-> Text Text) - (format "{" (nested expression) text.new_line "}")) - - (def: .public (block expression) - (-> Expression Expression) - (:abstraction - (format "{" - (..nested (:representation expression)) - text.new_line "}"))) - - (template [<name> <r>] - [(def: .public <name> - Expression - (:abstraction <r>))] - - [null "NULL"] - [n/a "NA"] - ) - - (template [<name>] - [(def: .public <name> Expression n/a)] - - [not_available] - [not_applicable] - [no_answer] - ) - - (def: .public bool - (-> Bit Expression) - (|>> (case> #0 "FALSE" - #1 "TRUE") - :abstraction)) - - (def: .public int - (-> Int Expression) - (|>> %.int :abstraction)) - - (def: .public float - (-> Frac Expression) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "1.0/0.0" [])] - - [(f.= f.negative_infinity)] - [(new> "-1.0/0.0" [])] - - [(f.= f.not_a_number)] - [(new> "0.0/0.0" [])] - - ... else - [%.frac]) - ..self_contained)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - ["|" "\|"] - [text.alarm "\a"] - [text.back_space "\b"] - [text.tab "\t"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Expression) - (|>> ..safe %.text :abstraction)) - - (def: .public (slice from to list) - (-> Expression Expression Expression Expression) - (..self_contained - (format (:representation list) - "[" (:representation from) ":" (:representation to) "]"))) - - (def: .public (slice_from from list) - (-> Expression Expression Expression) - (..self_contained - (format (:representation list) - "[-1" ":-" (:representation from) "]"))) - - (def: .public (apply args func) - (-> (List Expression) Expression Expression) - (let [func (:representation func) - spacing (|> " " - (list.repeated (text.size func)) - text.together)] - (:abstraction - (format func "(" - (|> args - (list\each ..code) - (text.interposed (format "," text.new_line)) - ..nested) - ")")))) - - (template [<name> <function>] - [(def: .public (<name> members) - (-> (List Expression) Expression) - (..apply members (..var <function>)))] - - [vector "c"] - [list "list"] - ) - - (def: .public named_list - (-> (List [Text Expression]) Expression) - (|>> (list\each (.function (_ [key value]) - (:abstraction (format key "=" (:representation value))))) - ..list)) - - (def: .public (apply_kw args kw_args func) - (-> (List Expression) (List [Text Expression]) Expression Expression) - (..self_contained - (format (:representation func) - (format "(" - (text.interposed "," (list\each ..code args)) "," - (text.interposed "," (list\each (.function (_ [key val]) - (format key "=" (:representation val))) - kw_args)) - ")")))) - - (syntax: (arity_inputs [arity <code>.nat]) - (in (case arity - 0 (.list) - _ (|> arity - list.indices - (list\each (|>> %.nat code.local_identifier)))))) - - (syntax: (arity_types [arity <code>.nat]) - (in (list.repeated arity (` ..Expression)))) - - (template [<arity> <function>+] - [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) - <inputs> (arity_inputs <arity>) - <types> (arity_types <arity>) - <definitions> (template.spliced <function>+)] - (def: .public (<apply> function [<inputs>]) - (-> Expression [<types>] Expression) - (..apply (.list <inputs>) function)) - - (template [<function>] - [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) - (-> [<types>] Expression) - (<apply> (..var <function>))))] - - <definitions>))] - - [0 - [["commandArgs"]]] - [1 - [["intToUtf8"]]] - [2 - [["paste"]]] - ) - - (def: .public as::integer - (-> Expression Expression) - (..apply/1 (..var "as.integer"))) - - (def: .public (item idx list) - (-> Expression Expression Expression) - (..self_contained - (format (:representation list) "[[" (:representation idx) "]]"))) - - (def: .public (if test then else) - (-> Expression Expression Expression Expression) - (:abstraction - (format "if(" (:representation test) ")" - " " (.._block (:representation then)) - " else " (.._block (:representation else))))) - - (def: .public (when test then) - (-> Expression Expression Expression) - (:abstraction - (format "if(" (:representation test) ") {" - (.._block (:representation then)) - text.new_line "}"))) - - (def: .public (cond clauses else) - (-> (List [Expression Expression]) Expression Expression) - (list\mix (.function (_ [test then] next) - (if test then next)) - else - (list.reversed clauses))) - - (template [<name> <op>] - [(def: .public (<name> param subject) - (-> Expression Expression Expression) + [(template [<type> <super>+] + [(with_expansions [<kind> (template.identifier [<type> "'"])] + (abstract: .public (<kind> kind) Any []) + (`` (type: .public <type> (|> Any <kind> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<kind> (template.identifier [<type> "'"])] + (abstract: .public (<kind> kind) Any []) + (`` (type: .public (<type> <brand>) (|> <brand> <kind> (~~ (template.spliced <super>+))))))] + + [Var [Expression' Code]] + ) + + (template [<var> <kind>] + [(abstract: .public <kind> Any []) + (type: .public <var> (Var <kind>))] + + [SVar Single] + [PVar Poly] + ) + + (def: .public var + (-> Text SVar) + (|>> :abstraction)) + + (def: .public var_args + PVar + (:abstraction "...")) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (def: (self_contained code) + (-> Text Expression) + (:abstraction + (format "(" code ")"))) + + (def: nested_new_line + (format text.new_line text.tab)) + + (def: nested + (-> Text Text) + (|>> (text.replaced text.new_line ..nested_new_line) + (format ..nested_new_line))) + + (def: (_block expression) + (-> Text Text) + (format "{" (nested expression) text.new_line "}")) + + (def: .public (block expression) + (-> Expression Expression) + (:abstraction + (format "{" + (..nested (:representation expression)) + text.new_line "}"))) + + (template [<name> <r>] + [(def: .public <name> + Expression + (:abstraction <r>))] + + [null "NULL"] + [n/a "NA"] + ) + + (template [<name>] + [(def: .public <name> Expression n/a)] + + [not_available] + [not_applicable] + [no_answer] + ) + + (def: .public bool + (-> Bit Expression) + (|>> (case> #0 "FALSE" + #1 "TRUE") + :abstraction)) + + (def: .public int + (-> Int Expression) + (|>> %.int :abstraction)) + + (def: .public float + (-> Frac Expression) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "1.0/0.0" [])] + + [(f.= f.negative_infinity)] + [(new> "-1.0/0.0" [])] + + [(f.= f.not_a_number)] + [(new> "0.0/0.0" [])] + + ... else + [%.frac]) + ..self_contained)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + ["|" "\|"] + [text.alarm "\a"] + [text.back_space "\b"] + [text.tab "\t"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Expression) + (|>> ..safe %.text :abstraction)) + + (def: .public (slice from to list) + (-> Expression Expression Expression Expression) + (..self_contained + (format (:representation list) + "[" (:representation from) ":" (:representation to) "]"))) + + (def: .public (slice_from from list) + (-> Expression Expression Expression) + (..self_contained + (format (:representation list) + "[-1" ":-" (:representation from) "]"))) + + (def: .public (apply args func) + (-> (List Expression) Expression Expression) + (let [func (:representation func) + spacing (|> " " + (list.repeated (text.size func)) + text.together)] + (:abstraction + (format func "(" + (|> args + (list\each ..code) + (text.interposed (format "," text.new_line)) + ..nested) + ")")))) + + (template [<name> <function>] + [(def: .public (<name> members) + (-> (List Expression) Expression) + (..apply members (..var <function>)))] + + [vector "c"] + [list "list"] + ) + + (def: .public named_list + (-> (List [Text Expression]) Expression) + (|>> (list\each (.function (_ [key value]) + (:abstraction (format key "=" (:representation value))))) + ..list)) + + (def: .public (apply_kw args kw_args func) + (-> (List Expression) (List [Text Expression]) Expression Expression) + (..self_contained + (format (:representation func) + (format "(" + (text.interposed "," (list\each ..code args)) "," + (text.interposed "," (list\each (.function (_ [key val]) + (format key "=" (:representation val))) + kw_args)) + ")")))) + + (syntax: (arity_inputs [arity <code>.nat]) + (in (case arity + 0 (.list) + _ (|> arity + list.indices + (list\each (|>> %.nat code.local_identifier)))))) + + (syntax: (arity_types [arity <code>.nat]) + (in (list.repeated arity (` ..Expression)))) + + (template [<arity> <function>+] + [(with_expansions [<apply> (template.identifier ["apply/" <arity>]) + <inputs> (arity_inputs <arity>) + <types> (arity_types <arity>) + <definitions> (template.spliced <function>+)] + (def: .public (<apply> function [<inputs>]) + (-> Expression [<types>] Expression) + (..apply (.list <inputs>) function)) + + (template [<function>] + [(`` (def: .public (~~ (template.identifier [<function> "/" <arity>])) + (-> [<types>] Expression) + (<apply> (..var <function>))))] + + <definitions>))] + + [0 + [["commandArgs"]]] + [1 + [["intToUtf8"]]] + [2 + [["paste"]]] + ) + + (def: .public as::integer + (-> Expression Expression) + (..apply/1 (..var "as.integer"))) + + (def: .public (item idx list) + (-> Expression Expression Expression) + (..self_contained + (format (:representation list) "[[" (:representation idx) "]]"))) + + (def: .public (if test then else) + (-> Expression Expression Expression Expression) + (:abstraction + (format "if(" (:representation test) ")" + " " (.._block (:representation then)) + " else " (.._block (:representation else))))) + + (def: .public (when test then) + (-> Expression Expression Expression) + (:abstraction + (format "if(" (:representation test) ") {" + (.._block (:representation then)) + text.new_line "}"))) + + (def: .public (cond clauses else) + (-> (List [Expression Expression]) Expression Expression) + (list\mix (.function (_ [test then] next) + (if test then next)) + else + (list.reversed clauses))) + + (template [<name> <op>] + [(def: .public (<name> param subject) + (-> Expression Expression Expression) + (..self_contained + (format (:representation subject) + " " <op> " " + (:representation param))))] + + [= "=="] + [< "<"] + [<= "<="] + [> ">"] + [>= ">="] + [+ "+"] + [- "-"] + [* "*"] + [/ "/"] + [%% "%%"] + [** "**"] + [or "||"] + [and "&&"] + ) + + (template [<name> <func>] + [(def: .public (<name> param subject) + (-> Expression Expression Expression) + (..apply (.list subject param) (..var <func>)))] + + [bit_or "bitwOr"] + [bit_and "bitwAnd"] + [bit_xor "bitwXor"] + [bit_shl "bitwShiftL"] + [bit_ushr "bitwShiftR"] + ) + + (def: .public (bit_not subject) + (-> Expression Expression) + (..apply (.list subject) (..var "bitwNot"))) + + (template [<name> <op>] + [(def: .public <name> + (-> Expression Expression) + (|>> :representation (format <op>) ..self_contained))] + + [not "!"] + [negate "-"] + ) + + (def: .public (length list) + (-> Expression Expression) + (..apply (.list list) (..var "length"))) + + (def: .public (range from to) + (-> Expression Expression Expression) + (..self_contained + (format (:representation from) ":" (:representation to)))) + + (def: .public (function inputs body) + (-> (List (Ex (_ k) (Var k))) Expression Expression) + (let [args (|> inputs (list\each ..code) (text.interposed ", "))] (..self_contained - (format (:representation subject) - " " <op> " " - (:representation param))))] - - [= "=="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [%% "%%"] - [** "**"] - [or "||"] - [and "&&"] - ) - - (template [<name> <func>] - [(def: .public (<name> param subject) - (-> Expression Expression Expression) - (..apply (.list subject param) (..var <func>)))] - - [bit_or "bitwOr"] - [bit_and "bitwAnd"] - [bit_xor "bitwXor"] - [bit_shl "bitwShiftL"] - [bit_ushr "bitwShiftR"] - ) - - (def: .public (bit_not subject) - (-> Expression Expression) - (..apply (.list subject) (..var "bitwNot"))) - - (template [<name> <op>] - [(def: .public <name> - (-> Expression Expression) - (|>> :representation (format <op>) ..self_contained))] - - [not "!"] - [negate "-"] - ) - - (def: .public (length list) - (-> Expression Expression) - (..apply (.list list) (..var "length"))) - - (def: .public (range from to) - (-> Expression Expression Expression) - (..self_contained - (format (:representation from) ":" (:representation to)))) - - (def: .public (function inputs body) - (-> (List (Ex (_ k) (Var k))) Expression Expression) - (let [args (|> inputs (list\each ..code) (text.interposed ", "))] - (..self_contained - (format "function(" args ") " - (.._block (:representation body)))))) - - (def: .public (try body warning error finally) - (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression) - (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text) - (.function (_ parameter value preparation) - (|> value - (maybe\each (|>> :representation preparation (format ", " parameter " = "))) - (maybe.else ""))))] - (..self_contained - (format "tryCatch(" - (.._block (:representation body)) - (optional "warning" warning function.identity) - (optional "error" error function.identity) - (optional "finally" finally .._block) - ")")))) - - (def: .public (while test body) - (-> Expression Expression Expression) - (..self_contained - (format "while (" (:representation test) ") " - (.._block (:representation body))))) - - (def: .public (for_in var inputs body) - (-> SVar Expression Expression Expression) - (..self_contained - (format "for (" (:representation var) " in " (:representation inputs) ")" - (.._block (:representation body))))) - - (template [<name> <keyword>] - [(def: .public (<name> message) - (-> Expression Expression) - (..apply (.list message) (..var <keyword>)))] - - [stop "stop"] - [print "print"] - ) - - (def: .public (set! var value) - (-> SVar Expression Expression) - (..self_contained - (format (:representation var) " <- " (:representation value)))) - - (def: .public (set_item! idx value list) - (-> Expression Expression SVar Expression) - (..self_contained - (format (:representation list) "[[" (:representation idx) "]] <- " (:representation value)))) - - (def: .public (then pre post) - (-> Expression Expression Expression) - (:abstraction - (format (:representation pre) - text.new_line - (:representation post)))) + (format "function(" args ") " + (.._block (:representation body)))))) + + (def: .public (try body warning error finally) + (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression) + (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text) + (.function (_ parameter value preparation) + (|> value + (maybe\each (|>> :representation preparation (format ", " parameter " = "))) + (maybe.else ""))))] + (..self_contained + (format "tryCatch(" + (.._block (:representation body)) + (optional "warning" warning function.identity) + (optional "error" error function.identity) + (optional "finally" finally .._block) + ")")))) + + (def: .public (while test body) + (-> Expression Expression Expression) + (..self_contained + (format "while (" (:representation test) ") " + (.._block (:representation body))))) + + (def: .public (for_in var inputs body) + (-> SVar Expression Expression Expression) + (..self_contained + (format "for (" (:representation var) " in " (:representation inputs) ")" + (.._block (:representation body))))) + + (template [<name> <keyword>] + [(def: .public (<name> message) + (-> Expression Expression) + (..apply (.list message) (..var <keyword>)))] + + [stop "stop"] + [print "print"] + ) + + (def: .public (set! var value) + (-> SVar Expression Expression) + (..self_contained + (format (:representation var) " <- " (:representation value)))) + + (def: .public (set_item! idx value list) + (-> Expression Expression SVar Expression) + (..self_contained + (format (:representation list) "[[" (:representation idx) "]] <- " (:representation value)))) + + (def: .public (then pre post) + (-> Expression Expression Expression) + (:abstraction + (format (:representation pre) + text.new_line + (:representation post))))] ) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index fdb76ac76..acc560f31 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -36,391 +36,389 @@ (text.replaced text.new_line nested_new_line)))) (abstract: .public (Code brand) - {} - Text - (implementation: .public code_equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public code_hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..code_equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: (<brand> brand) {} Any) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] - - [Expression [Code]] - [Computation [Expression' Code]] - [Location [Computation' Expression' Code]] - [Var [Location' Computation' Expression' Code]] - [LVar [Var' Location' Computation' Expression' Code]] - [Statement [Code]] - ) - - (template [<type> <super>+] - [(with_expansions [<brand> (template.identifier [<type> "'"])] - (abstract: <brand> {} Any) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] - - [Literal [Computation' Expression' Code]] - [Access [Location' Computation' Expression' Code]] - [GVar [Var' Location' Computation' Expression' Code]] - [IVar [Var' Location' Computation' Expression' Code]] - [SVar [Var' Location' Computation' Expression' Code]] - [LVar* [LVar' Var' Location' Computation' Expression' Code]] - [LVar** [LVar' Var' Location' Computation' Expression' Code]] - ) - - (template [<var> <prefix> <constructor>] - [(def: .public <constructor> - (-> Text <var>) - (|>> (format <prefix>) :abstraction))] - - [GVar "$" global] - [IVar "@" instance] - [SVar "@@" static] - ) - - (def: .public local - (-> Text LVar) - (|>> :abstraction)) - - (template [<var> <prefix> <modifier> <unpacker>] - [(template [<name> <input> <output>] - [(def: .public <name> - (-> <input> <output>) - (|>> :representation (format <prefix>) :abstraction))] - - [<modifier> LVar <var>] - [<unpacker> Expression Computation] - )] - - [LVar* "*" variadic splat] - [LVar** "**" variadic_kv double_splat] - ) - - (template [<ruby_name> <lux_name>] - [(def: .public <lux_name> - (..global <ruby_name>))] - - ["@" latest_error] - ["_" last_string_read] - ["." last_line_number_read] - ["&" last_string_matched] - ["~" last_regexp_match] - ["=" case_insensitivity_flag] - ["/" input_record_separator] - ["\" output_record_separator] - ["0" script_name] - ["$" process_id] - ["?" exit_status] - ) - - (template [<ruby_name> <lux_name>] - [(def: .public <lux_name> - (..local <ruby_name>))] - - ["ARGV" command_line_arguments] - ) - - (def: .public nil - Literal - (:abstraction "nil")) - - (def: .public bool - (-> Bit Literal) - (|>> (case> #0 "false" - #1 "true") + [(implementation: .public code_equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public code_hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..code_equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: (<brand> brand) Any []) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+))))))] + + [Expression [Code]] + [Computation [Expression' Code]] + [Location [Computation' Expression' Code]] + [Var [Location' Computation' Expression' Code]] + [LVar [Var' Location' Computation' Expression' Code]] + [Statement [Code]] + ) + + (template [<type> <super>+] + [(with_expansions [<brand> (template.identifier [<type> "'"])] + (abstract: <brand> Any []) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+))))))] + + [Literal [Computation' Expression' Code]] + [Access [Location' Computation' Expression' Code]] + [GVar [Var' Location' Computation' Expression' Code]] + [IVar [Var' Location' Computation' Expression' Code]] + [SVar [Var' Location' Computation' Expression' Code]] + [LVar* [LVar' Var' Location' Computation' Expression' Code]] + [LVar** [LVar' Var' Location' Computation' Expression' Code]] + ) + + (template [<var> <prefix> <constructor>] + [(def: .public <constructor> + (-> Text <var>) + (|>> (format <prefix>) :abstraction))] + + [GVar "$" global] + [IVar "@" instance] + [SVar "@@" static] + ) + + (def: .public local + (-> Text LVar) + (|>> :abstraction)) + + (template [<var> <prefix> <modifier> <unpacker>] + [(template [<name> <input> <output>] + [(def: .public <name> + (-> <input> <output>) + (|>> :representation (format <prefix>) :abstraction))] + + [<modifier> LVar <var>] + [<unpacker> Expression Computation] + )] + + [LVar* "*" variadic splat] + [LVar** "**" variadic_kv double_splat] + ) + + (template [<ruby_name> <lux_name>] + [(def: .public <lux_name> + (..global <ruby_name>))] + + ["@" latest_error] + ["_" last_string_read] + ["." last_line_number_read] + ["&" last_string_matched] + ["~" last_regexp_match] + ["=" case_insensitivity_flag] + ["/" input_record_separator] + ["\" output_record_separator] + ["0" script_name] + ["$" process_id] + ["?" exit_status] + ) + + (template [<ruby_name> <lux_name>] + [(def: .public <lux_name> + (..local <ruby_name>))] + + ["ARGV" command_line_arguments] + ) + + (def: .public nil + Literal + (:abstraction "nil")) + + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") + :abstraction)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + [text.tab "\t"] + [text.vertical_tab "\v"] + [text.null "\0"] + [text.back_space "\b"] + [text.form_feed "\f"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (template [<format> <name> <type> <prep>] + [(def: .public <name> + (-> <type> Literal) + (|>> <prep> <format> :abstraction))] + + [%.int int Int (<|)] + [%.text string Text ..safe] + [(<|) symbol Text (format ":")] + ) + + (def: .public float + (-> Frac Literal) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "(+1.0/0.0)" [])] + + [(f.= f.negative_infinity)] + [(new> "(-1.0/0.0)" [])] + + [(f.= f.not_a_number)] + [(new> "(+0.0/-0.0)" [])] + + ... else + [%.frac]) + :abstraction)) + + (def: .public (array_range from to array) + (-> Expression Expression Expression Computation) + (|> (format (:representation from) ".." (:representation to)) + (text.enclosed ["[" "]"]) + (format (:representation array)) :abstraction)) - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - [text.tab "\t"] - [text.vertical_tab "\v"] - [text.null "\0"] - [text.back_space "\b"] - [text.form_feed "\f"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (template [<format> <name> <type> <prep>] - [(def: .public <name> - (-> <type> Literal) - (|>> <prep> <format> :abstraction))] - - [%.int int Int (<|)] - [%.text string Text ..safe] - [(<|) symbol Text (format ":")] - ) - - (def: .public float - (-> Frac Literal) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "(+1.0/0.0)" [])] - - [(f.= f.negative_infinity)] - [(new> "(-1.0/0.0)" [])] - - [(f.= f.not_a_number)] - [(new> "(+0.0/-0.0)" [])] - - ... else - [%.frac]) + (def: .public array + (-> (List Expression) Literal) + (|>> (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed ["[" "]"]) + :abstraction)) + + (def: .public hash + (-> (List [Expression Expression]) Literal) + (|>> (list\each (.function (_ [k v]) + (format (:representation k) " => " (:representation v)))) + (text.interposed ..input_separator) + (text.enclosed ["{" "}"]) + :abstraction)) + + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (|> args + (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed ["(" ")"]) + (format (:representation func)) :abstraction)) - (def: .public (array_range from to array) - (-> Expression Expression Expression Computation) - (|> (format (:representation from) ".." (:representation to)) - (text.enclosed ["[" "]"]) - (format (:representation array)) - :abstraction)) - - (def: .public array - (-> (List Expression) Literal) - (|>> (list\each (|>> :representation)) + (def: .public (apply_lambda/* args lambda) + (-> (List Expression) Expression Computation) + (|> args + (list\each (|>> :representation)) (text.interposed ..input_separator) (text.enclosed ["[" "]"]) + (format (:representation lambda)) :abstraction)) - (def: .public hash - (-> (List [Expression Expression]) Literal) - (|>> (list\each (.function (_ [k v]) - (format (:representation k) " => " (:representation v)))) - (text.interposed ..input_separator) - (text.enclosed ["{" "}"]) + (def: .public (the field object) + (-> Text Expression Access) + (:abstraction (format (:representation object) "." field))) + + (def: .public (item idx array) + (-> Expression Expression Access) + (|> (:representation idx) + (text.enclosed ["[" "]"]) + (format (:representation array)) :abstraction)) - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (|> args - (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed ["(" ")"]) - (format (:representation func)) - :abstraction)) - - (def: .public (apply_lambda/* args lambda) - (-> (List Expression) Expression Computation) - (|> args - (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed ["[" "]"]) - (format (:representation lambda)) - :abstraction)) - - (def: .public (the field object) - (-> Text Expression Access) - (:abstraction (format (:representation object) "." field))) - - (def: .public (item idx array) - (-> Expression Expression Access) - (|> (:representation idx) - (text.enclosed ["[" "]"]) - (format (:representation array)) - :abstraction)) - - (def: .public (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (:representation test) " ? " - (:representation then) " : " - (:representation else)) - (text.enclosed ["(" ")"]) - :abstraction)) - - (def: .public statement - (-> Expression Statement) - (|>> :representation - (text.suffix ..statement_suffix) + (def: .public (? test then else) + (-> Expression Expression Expression Computation) + (|> (format (:representation test) " ? " + (:representation then) " : " + (:representation else)) + (text.enclosed ["(" ")"]) :abstraction)) - (def: .public (then pre! post!) - (-> Statement Statement Statement) - (:abstraction - (format (:representation pre!) - text.new_line - (:representation post!)))) - - (def: .public (set vars value) - (-> (List Location) Expression Statement) - (:abstraction - (format (|> vars - (list\each (|>> :representation)) - (text.interposed ..input_separator)) - " = " (:representation value) ..statement_suffix))) - - (def: (block content) - (-> Text Text) - (format content - text.new_line "end" ..statement_suffix)) - - (def: .public (if test then! else!) - (-> Expression Statement Statement Statement) - (<| :abstraction - ..block - (format "if " (:representation test) - (..nested (:representation then!)) - text.new_line "else" - (..nested (:representation else!))))) - - (template [<name> <block>] - [(def: .public (<name> test then!) - (-> Expression Statement Statement) - (<| :abstraction - ..block - (format <block> " " (:representation test) - (..nested (:representation then!)))))] - - [when "if"] - [while "while"] - ) - - (def: .public (for_in var array iteration!) - (-> LVar Expression Statement Statement) - (<| :abstraction - ..block - (format "for " (:representation var) - " in " (:representation array) - " do " - (..nested (:representation iteration!))))) - - (type: .public Rescue - (Record - [#classes (List Text) - #exception LVar - #rescue Statement])) - - (def: .public (begin body! rescues) - (-> Statement (List Rescue) Statement) - (<| :abstraction - ..block - (format "begin" (..nested (:representation body!)) - (|> rescues - (list\each (.function (_ [classes exception rescue]) - (format text.new_line "rescue " (text.interposed ..input_separator classes) - " => " (:representation exception) - (..nested (:representation rescue))))) - (text.interposed text.new_line))))) - - (def: .public (catch expectation body!) - (-> Expression Statement Statement) - (<| :abstraction - ..block - (format "catch(" (:representation expectation) ") do" - (..nested (:representation body!))))) - - (def: .public (return value) - (-> Expression Statement) - (:abstraction (format "return " (:representation value) ..statement_suffix))) - - (def: .public (raise message) - (-> Expression Computation) - (:abstraction (format "raise " (:representation message)))) - - (template [<name> <keyword>] - [(def: .public <name> - Statement - (|> <keyword> - (text.suffix ..statement_suffix) - :abstraction))] - - [next "next"] - [redo "redo"] - [break "break"] - ) - - (def: .public (function name args body!) - (-> LVar (List LVar) Statement Statement) - (<| :abstraction - ..block - (format "def " (:representation name) - (|> args - (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed ["(" ")"])) - (..nested (:representation body!))))) - - (def: .public (lambda name args body!) - (-> (Maybe LVar) (List Var) Statement Literal) - (let [proc (|> (format (|> args - (list\each (|>> :representation)) - (text.interposed ..input_separator) - (text.enclosed' "|")) - (..nested (:representation body!))) - (text.enclosed ["{" "}"]) - (format "lambda "))] - (|> (case name - #.None - proc - - (#.Some name) - (format (:representation name) " = " proc)) - (text.enclosed ["(" ")"]) - :abstraction))) - - (template [<op> <name>] - [(def: .public (<name> parameter subject) - (-> Expression Expression Computation) - (:abstraction (format "(" (:representation subject) " " <op> " " (:representation parameter) ")")))] - - ["==" =] - [ "<" <] - ["<=" <=] - [ ">" >] - [">=" >=] - - [ "+" +] - [ "-" -] - [ "*" *] - [ "/" /] - [ "%" %] - ["**" pow] - - ["||" or] - ["&&" and] - [ "|" bit_or] - [ "&" bit_and] - [ "^" bit_xor] - - ["<<" bit_shl] - [">>" bit_shr] - ) - - (template [<unary> <name>] - [(def: .public (<name> subject) - (-> Expression Computation) - (:abstraction (format "(" <unary> (:representation subject) ")")))] - - ["!" not] - ["-" opposite] - ) - - (def: .public (comment commentary on) - (All (_ brand) (-> Text (Code brand) (Code brand))) - (:abstraction (format "# " (..safe commentary) text.new_line - (:representation on)))) + (def: .public statement + (-> Expression Statement) + (|>> :representation + (text.suffix ..statement_suffix) + :abstraction)) + + (def: .public (then pre! post!) + (-> Statement Statement Statement) + (:abstraction + (format (:representation pre!) + text.new_line + (:representation post!)))) + + (def: .public (set vars value) + (-> (List Location) Expression Statement) + (:abstraction + (format (|> vars + (list\each (|>> :representation)) + (text.interposed ..input_separator)) + " = " (:representation value) ..statement_suffix))) + + (def: (block content) + (-> Text Text) + (format content + text.new_line "end" ..statement_suffix)) + + (def: .public (if test then! else!) + (-> Expression Statement Statement Statement) + (<| :abstraction + ..block + (format "if " (:representation test) + (..nested (:representation then!)) + text.new_line "else" + (..nested (:representation else!))))) + + (template [<name> <block>] + [(def: .public (<name> test then!) + (-> Expression Statement Statement) + (<| :abstraction + ..block + (format <block> " " (:representation test) + (..nested (:representation then!)))))] + + [when "if"] + [while "while"] + ) + + (def: .public (for_in var array iteration!) + (-> LVar Expression Statement Statement) + (<| :abstraction + ..block + (format "for " (:representation var) + " in " (:representation array) + " do " + (..nested (:representation iteration!))))) + + (type: .public Rescue + (Record + [#classes (List Text) + #exception LVar + #rescue Statement])) + + (def: .public (begin body! rescues) + (-> Statement (List Rescue) Statement) + (<| :abstraction + ..block + (format "begin" (..nested (:representation body!)) + (|> rescues + (list\each (.function (_ [classes exception rescue]) + (format text.new_line "rescue " (text.interposed ..input_separator classes) + " => " (:representation exception) + (..nested (:representation rescue))))) + (text.interposed text.new_line))))) + + (def: .public (catch expectation body!) + (-> Expression Statement Statement) + (<| :abstraction + ..block + (format "catch(" (:representation expectation) ") do" + (..nested (:representation body!))))) + + (def: .public (return value) + (-> Expression Statement) + (:abstraction (format "return " (:representation value) ..statement_suffix))) + + (def: .public (raise message) + (-> Expression Computation) + (:abstraction (format "raise " (:representation message)))) + + (template [<name> <keyword>] + [(def: .public <name> + Statement + (|> <keyword> + (text.suffix ..statement_suffix) + :abstraction))] + + [next "next"] + [redo "redo"] + [break "break"] + ) + + (def: .public (function name args body!) + (-> LVar (List LVar) Statement Statement) + (<| :abstraction + ..block + (format "def " (:representation name) + (|> args + (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed ["(" ")"])) + (..nested (:representation body!))))) + + (def: .public (lambda name args body!) + (-> (Maybe LVar) (List Var) Statement Literal) + (let [proc (|> (format (|> args + (list\each (|>> :representation)) + (text.interposed ..input_separator) + (text.enclosed' "|")) + (..nested (:representation body!))) + (text.enclosed ["{" "}"]) + (format "lambda "))] + (|> (case name + #.None + proc + + (#.Some name) + (format (:representation name) " = " proc)) + (text.enclosed ["(" ")"]) + :abstraction))) + + (template [<op> <name>] + [(def: .public (<name> parameter subject) + (-> Expression Expression Computation) + (:abstraction (format "(" (:representation subject) " " <op> " " (:representation parameter) ")")))] + + ["==" =] + [ "<" <] + ["<=" <=] + [ ">" >] + [">=" >=] + + [ "+" +] + [ "-" -] + [ "*" *] + [ "/" /] + [ "%" %] + ["**" pow] + + ["||" or] + ["&&" and] + [ "|" bit_or] + [ "&" bit_and] + [ "^" bit_xor] + + ["<<" bit_shl] + [">>" bit_shr] + ) + + (template [<unary> <name>] + [(def: .public (<name> subject) + (-> Expression Computation) + (:abstraction (format "(" <unary> (:representation subject) ")")))] + + ["!" not] + ["-" opposite] + ) + + (def: .public (comment commentary on) + (All (_ brand) (-> Text (Code brand) (Code brand))) + (:abstraction (format "# " (..safe commentary) text.new_line + (:representation on))))] ) (def: .public (do method args object) diff --git a/stdlib/source/library/lux/target/scheme.lux b/stdlib/source/library/lux/target/scheme.lux index 89bea0ca8..285d934ad 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -27,357 +27,355 @@ (text.replaced text.new_line nested_new_line))) (abstract: .public (Code k) - {} - Text - (implementation: .public equivalence - (All (_ brand) (Equivalence (Code brand))) - - (def: (= reference subject) - (\ text.equivalence = (:representation reference) (:representation subject)))) - - (implementation: .public hash - (All (_ brand) (Hash (Code brand))) - - (def: &equivalence ..equivalence) - (def: hash (|>> :representation (\ text.hash hash)))) - - (template [<type> <brand> <super>+] - [(abstract: .public (<brand> brand) {} Any) - (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+)))))] - - [Expression Expression' [Code]] - ) - - (template [<type> <brand> <super>+] - [(abstract: .public <brand> {} Any) - (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+)))))] - - [Var Var' [Expression' Code]] - [Computation Computation' [Expression' Code]] - ) - - (type: .public Arguments - (Record - [#mandatory (List Var) - #rest (Maybe Var)])) - - (def: .public manual - (-> Text Code) - (|>> :abstraction)) - - (def: .public code - (-> (Code Any) Text) - (|>> :representation)) - - (def: .public var - (-> Text Var) - (|>> :abstraction)) - - (def: (arguments [mandatory rest]) - (-> Arguments (Code Any)) - (case rest - (#.Some rest) - (case mandatory - #.End - rest - - _ - (|> (format " . " (:representation rest)) - (format (|> mandatory - (list\each ..code) - (text.interposed " "))) - (text.enclosed ["(" ")"]) - :abstraction)) - - #.None - (|> mandatory - (list\each ..code) - (text.interposed " ") - (text.enclosed ["(" ")"]) - :abstraction))) - - (def: .public nil - Computation - (:abstraction "'()")) - - (def: .public bool - (-> Bit Computation) - (|>> (case> #0 "#f" - #1 "#t") - :abstraction)) - - (def: .public int - (-> Int Computation) - (|>> %.int :abstraction)) - - (def: .public float - (-> Frac Computation) - (|>> (cond> [(f.= f.positive_infinity)] - [(new> "+inf.0" [])] - - [(f.= f.negative_infinity)] - [(new> "-inf.0" [])] - - [f.not_a_number?] - [(new> "+nan.0" [])] - - ... else - [%.frac]) - :abstraction)) - - (def: .public positive_infinity Computation (..float f.positive_infinity)) - (def: .public negative_infinity Computation (..float f.negative_infinity)) - (def: .public not_a_number Computation (..float f.not_a_number)) - - (def: safe - (-> Text Text) - (`` (|>> (~~ (template [<find> <replace>] - [(text.replaced <find> <replace>)] - - ["\" "\\"] - ["|" "\|"] - [text.alarm "\a"] - [text.back_space "\b"] - [text.tab "\t"] - [text.new_line "\n"] - [text.carriage_return "\r"] - [text.double_quote (format "\" text.double_quote)] - )) - ))) - - (def: .public string - (-> Text Computation) - (|>> ..safe %.text :abstraction)) - - (def: .public symbol - (-> Text Computation) - (|>> (format "'") :abstraction)) - - (def: form - (-> (List (Code Any)) Code) - (.let [nested_new_line (format text.new_line text.tab)] - (|>> (case> #.End - (:abstraction "()") - - (#.Item head tail) - (|> tail - (list\each (|>> :representation ..nested)) - (#.Item (:representation head)) - (text.interposed nested_new_line) - (text.enclosed ["(" ")"]) - :abstraction))))) - - (def: .public (apply/* args func) - (-> (List Expression) Expression Computation) - (..form (#.Item func args))) - - (template [<name> <function>] - [(def: .public (<name> members) - (-> (List Expression) Computation) - (..apply/* members (..var <function>)))] - - [vector/* "vector"] - [list/* "list"] - ) - - (def: .public apply/0 - (-> Expression Computation) - (..apply/* (list))) - - (template [<lux_name> <scheme_name>] - [(def: .public <lux_name> - (apply/0 (..var <scheme_name>)))] - - [newline/0 "newline"] - ) - - (template [<apply> <arg>+ <type>+ <function>+] - [(`` (def: .public (<apply> procedure) - (-> Expression (~~ (template.spliced <type>+)) Computation) - (function (_ (~~ (template.spliced <arg>+))) - (..apply/* (list (~~ (template.spliced <arg>+))) procedure)))) - - (`` (template [<definition> <function>] - [(def: .public <definition> (<apply> (..var <function>)))] - - (~~ (template.spliced <function>+))))] - - [apply/1 [_0] [Expression] - [[exact/1 "exact"] - [integer->char/1 "integer->char"] - [char->integer/1 "char->integer"] - [number->string/1 "number->string"] - [string->number/1 "string->number"] - [floor/1 "floor"] - [truncate/1 "truncate"] - [string/1 "string"] - [string?/1 "string?"] - [length/1 "length"] - [values/1 "values"] - [null?/1 "null?"] - [car/1 "car"] - [cdr/1 "cdr"] - [raise/1 "raise"] - [error_object_message/1 "error-object-message"] - [make_vector/1 "make-vector"] - [vector_length/1 "vector-length"] - [not/1 "not"] - [string_hash/1 "string-hash"] - [reverse/1 "reverse"] - [display/1 "display"] - [exit/1 "exit"] - [string_length/1 "string-length"] - [load_relative/1 "load-relative"]]] - - [apply/2 [_0 _1] [Expression Expression] - [[append/2 "append"] - [cons/2 "cons"] - [make_vector/2 "make-vector"] - ... [vector_ref/2 "vector-ref"] - [list_tail/2 "list-tail"] - [map/2 "map"] - [string_ref/2 "string-ref"] - [string_append/2 "string-append"] - [make_string/2 "make-string"]]] - - [apply/3 [_0 _1 _2] [Expression Expression Expression] - [[substring/3 "substring"] - [vector_set!/3 "vector-set!"] - [string_contains/3 "string-contains"]]] - - [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression] - [[vector_copy!/5 "vector-copy!"]]] - ) - - ... TODO: define "vector_ref/2" like a normal apply/2 function. - ... "vector_ref/2" as an 'invoke' is problematic, since it only works - ... in Kawa. - ... However, the way Kawa defines "vector-ref" causes trouble, - ... because it does a runtime type-check which throws an error when - ... it checks against custom values/objects/classes made for - ... JVM<->Scheme interop. - ... There are 2 ways to deal with this: - ... 0. To fork Kawa, and get rid of the type-check so the normal - ... "vector-ref" can be used instead. - ... 1. To carry on, and then, when it's time to compile the compiler - ... itself into Scheme, switch from 'invoke' to normal 'vector-ref'. - ... Either way, the 'invoke' needs to go away. - (def: .public (vector_ref/2 vector index) - (-> Expression Expression Computation) - (..form (list (..var "invoke") vector (..symbol "getRaw") index))) - - (template [<lux_name> <scheme_name>] - [(def: .public (<lux_name> param subject) - (-> Expression Expression Computation) - (..apply/2 (..var <scheme_name>) subject param))] - - [=/2 "="] - [eq?/2 "eq?"] - [eqv?/2 "eqv?"] - [</2 "<"] - [<=/2 "<="] - [>/2 ">"] - [>=/2 ">="] - [string=?/2 "string=?"] - [string<?/2 "string<?"] - [+/2 "+"] - [-/2 "-"] - [//2 "/"] - [*/2 "*"] - [expt/2 "expt"] - [remainder/2 "remainder"] - [quotient/2 "quotient"] - [mod/2 "mod"] - [arithmetic_shift/2 "arithmetic-shift"] - [bitwise_and/2 "bitwise-and"] - [bitwise_ior/2 "bitwise-ior"] - [bitwise_xor/2 "bitwise-xor"] - ) - - (template [<lux_name> <scheme_name>] - [(def: .public <lux_name> - (-> (List Expression) Computation) - (|>> (list& (..var <scheme_name>)) ..form))] - - [or "or"] - [and "and"] - ) - - (template [<lux_name> <scheme_name> <var> <pre>] - [(def: .public (<lux_name> bindings body) - (-> (List [<var> Expression]) Expression Computation) - (..form (list (..var <scheme_name>) - (|> bindings - (list\each (function (_ [binding/name binding/value]) - (..form (list (|> binding/name <pre>) - binding/value)))) - ..form) - body)))] - - [let "let" Var (<|)] - [let* "let*" Var (<|)] - [letrec "letrec" Var (<|)] - [let_values "let-values" Arguments ..arguments] - [let*_values "let*-values" Arguments ..arguments] - [letrec_values "letrec-values" Arguments ..arguments] - ) - - (def: .public (if test then else) - (-> Expression Expression Expression Computation) - (..form (list (..var "if") test then else))) - - (def: .public (when test then) - (-> Expression Expression Computation) - (..form (list (..var "when") test then))) - - (def: .public (lambda arguments body) - (-> Arguments Expression Computation) - (..form (list (..var "lambda") - (..arguments arguments) - body))) - - (def: .public (define_function name arguments body) - (-> Var Arguments Expression Computation) - (..form (list (..var "define") - (|> arguments - (revised@ #mandatory (|>> (#.Item name))) - ..arguments) - body))) - - (def: .public (define_constant name value) - (-> Var Expression Computation) - (..form (list (..var "define") name value))) - - (def: .public begin - (-> (List Expression) Computation) - (|>> (#.Item (..var "begin")) ..form)) - - (def: .public (set! name value) - (-> Var Expression Computation) - (..form (list (..var "set!") name value))) - - (def: .public (with_exception_handler handler body) - (-> Expression Expression Computation) - (..form (list (..var "with-exception-handler") handler body))) - - (def: .public (call_with_current_continuation body) - (-> Expression Computation) - (..form (list (..var "call-with-current-continuation") body))) - - (def: .public (guard variable clauses else body) - (-> Var (List [Expression Expression]) (Maybe Expression) Expression Computation) - (..form (list (..var "guard") - (..form (|> (case else - #.None - (list) - - (#.Some else) - (list (..form (list (..var "else") else)))) - (list\composite (list\each (function (_ [when then]) - (..form (list when then))) - clauses)) - (list& variable))) - body))) + [(implementation: .public equivalence + (All (_ brand) (Equivalence (Code brand))) + + (def: (= reference subject) + (\ text.equivalence = (:representation reference) (:representation subject)))) + + (implementation: .public hash + (All (_ brand) (Hash (Code brand))) + + (def: &equivalence ..equivalence) + (def: hash (|>> :representation (\ text.hash hash)))) + + (template [<type> <brand> <super>+] + [(abstract: .public (<brand> brand) Any []) + (`` (type: .public <type> (|> Any <brand> (~~ (template.spliced <super>+)))))] + + [Expression Expression' [Code]] + ) + + (template [<type> <brand> <super>+] + [(abstract: .public <brand> Any []) + (`` (type: .public <type> (|> <brand> (~~ (template.spliced <super>+)))))] + + [Var Var' [Expression' Code]] + [Computation Computation' [Expression' Code]] + ) + + (type: .public Arguments + (Record + [#mandatory (List Var) + #rest (Maybe Var)])) + + (def: .public manual + (-> Text Code) + (|>> :abstraction)) + + (def: .public code + (-> (Code Any) Text) + (|>> :representation)) + + (def: .public var + (-> Text Var) + (|>> :abstraction)) + + (def: (arguments [mandatory rest]) + (-> Arguments (Code Any)) + (case rest + (#.Some rest) + (case mandatory + #.End + rest + + _ + (|> (format " . " (:representation rest)) + (format (|> mandatory + (list\each ..code) + (text.interposed " "))) + (text.enclosed ["(" ")"]) + :abstraction)) + + #.None + (|> mandatory + (list\each ..code) + (text.interposed " ") + (text.enclosed ["(" ")"]) + :abstraction))) + + (def: .public nil + Computation + (:abstraction "'()")) + + (def: .public bool + (-> Bit Computation) + (|>> (case> #0 "#f" + #1 "#t") + :abstraction)) + + (def: .public int + (-> Int Computation) + (|>> %.int :abstraction)) + + (def: .public float + (-> Frac Computation) + (|>> (cond> [(f.= f.positive_infinity)] + [(new> "+inf.0" [])] + + [(f.= f.negative_infinity)] + [(new> "-inf.0" [])] + + [f.not_a_number?] + [(new> "+nan.0" [])] + + ... else + [%.frac]) + :abstraction)) + + (def: .public positive_infinity Computation (..float f.positive_infinity)) + (def: .public negative_infinity Computation (..float f.negative_infinity)) + (def: .public not_a_number Computation (..float f.not_a_number)) + + (def: safe + (-> Text Text) + (`` (|>> (~~ (template [<find> <replace>] + [(text.replaced <find> <replace>)] + + ["\" "\\"] + ["|" "\|"] + [text.alarm "\a"] + [text.back_space "\b"] + [text.tab "\t"] + [text.new_line "\n"] + [text.carriage_return "\r"] + [text.double_quote (format "\" text.double_quote)] + )) + ))) + + (def: .public string + (-> Text Computation) + (|>> ..safe %.text :abstraction)) + + (def: .public symbol + (-> Text Computation) + (|>> (format "'") :abstraction)) + + (def: form + (-> (List (Code Any)) Code) + (.let [nested_new_line (format text.new_line text.tab)] + (|>> (case> #.End + (:abstraction "()") + + (#.Item head tail) + (|> tail + (list\each (|>> :representation ..nested)) + (#.Item (:representation head)) + (text.interposed nested_new_line) + (text.enclosed ["(" ")"]) + :abstraction))))) + + (def: .public (apply/* args func) + (-> (List Expression) Expression Computation) + (..form (#.Item func args))) + + (template [<name> <function>] + [(def: .public (<name> members) + (-> (List Expression) Computation) + (..apply/* members (..var <function>)))] + + [vector/* "vector"] + [list/* "list"] + ) + + (def: .public apply/0 + (-> Expression Computation) + (..apply/* (list))) + + (template [<lux_name> <scheme_name>] + [(def: .public <lux_name> + (apply/0 (..var <scheme_name>)))] + + [newline/0 "newline"] + ) + + (template [<apply> <arg>+ <type>+ <function>+] + [(`` (def: .public (<apply> procedure) + (-> Expression (~~ (template.spliced <type>+)) Computation) + (function (_ (~~ (template.spliced <arg>+))) + (..apply/* (list (~~ (template.spliced <arg>+))) procedure)))) + + (`` (template [<definition> <function>] + [(def: .public <definition> (<apply> (..var <function>)))] + + (~~ (template.spliced <function>+))))] + + [apply/1 [_0] [Expression] + [[exact/1 "exact"] + [integer->char/1 "integer->char"] + [char->integer/1 "char->integer"] + [number->string/1 "number->string"] + [string->number/1 "string->number"] + [floor/1 "floor"] + [truncate/1 "truncate"] + [string/1 "string"] + [string?/1 "string?"] + [length/1 "length"] + [values/1 "values"] + [null?/1 "null?"] + [car/1 "car"] + [cdr/1 "cdr"] + [raise/1 "raise"] + [error_object_message/1 "error-object-message"] + [make_vector/1 "make-vector"] + [vector_length/1 "vector-length"] + [not/1 "not"] + [string_hash/1 "string-hash"] + [reverse/1 "reverse"] + [display/1 "display"] + [exit/1 "exit"] + [string_length/1 "string-length"] + [load_relative/1 "load-relative"]]] + + [apply/2 [_0 _1] [Expression Expression] + [[append/2 "append"] + [cons/2 "cons"] + [make_vector/2 "make-vector"] + ... [vector_ref/2 "vector-ref"] + [list_tail/2 "list-tail"] + [map/2 "map"] + [string_ref/2 "string-ref"] + [string_append/2 "string-append"] + [make_string/2 "make-string"]]] + + [apply/3 [_0 _1 _2] [Expression Expression Expression] + [[substring/3 "substring"] + [vector_set!/3 "vector-set!"] + [string_contains/3 "string-contains"]]] + + [apply/5 [_0 _1 _2 _3 _4] [Expression Expression Expression Expression Expression] + [[vector_copy!/5 "vector-copy!"]]] + ) + + ... TODO: define "vector_ref/2" like a normal apply/2 function. + ... "vector_ref/2" as an 'invoke' is problematic, since it only works + ... in Kawa. + ... However, the way Kawa defines "vector-ref" causes trouble, + ... because it does a runtime type-check which throws an error when + ... it checks against custom values/objects/classes made for + ... JVM<->Scheme interop. + ... There are 2 ways to deal with this: + ... 0. To fork Kawa, and get rid of the type-check so the normal + ... "vector-ref" can be used instead. + ... 1. To carry on, and then, when it's time to compile the compiler + ... itself into Scheme, switch from 'invoke' to normal 'vector-ref'. + ... Either way, the 'invoke' needs to go away. + (def: .public (vector_ref/2 vector index) + (-> Expression Expression Computation) + (..form (list (..var "invoke") vector (..symbol "getRaw") index))) + + (template [<lux_name> <scheme_name>] + [(def: .public (<lux_name> param subject) + (-> Expression Expression Computation) + (..apply/2 (..var <scheme_name>) subject param))] + + [=/2 "="] + [eq?/2 "eq?"] + [eqv?/2 "eqv?"] + [</2 "<"] + [<=/2 "<="] + [>/2 ">"] + [>=/2 ">="] + [string=?/2 "string=?"] + [string<?/2 "string<?"] + [+/2 "+"] + [-/2 "-"] + [//2 "/"] + [*/2 "*"] + [expt/2 "expt"] + [remainder/2 "remainder"] + [quotient/2 "quotient"] + [mod/2 "mod"] + [arithmetic_shift/2 "arithmetic-shift"] + [bitwise_and/2 "bitwise-and"] + [bitwise_ior/2 "bitwise-ior"] + [bitwise_xor/2 "bitwise-xor"] + ) + + (template [<lux_name> <scheme_name>] + [(def: .public <lux_name> + (-> (List Expression) Computation) + (|>> (list& (..var <scheme_name>)) ..form))] + + [or "or"] + [and "and"] + ) + + (template [<lux_name> <scheme_name> <var> <pre>] + [(def: .public (<lux_name> bindings body) + (-> (List [<var> Expression]) Expression Computation) + (..form (list (..var <scheme_name>) + (|> bindings + (list\each (function (_ [binding/name binding/value]) + (..form (list (|> binding/name <pre>) + binding/value)))) + ..form) + body)))] + + [let "let" Var (<|)] + [let* "let*" Var (<|)] + [letrec "letrec" Var (<|)] + [let_values "let-values" Arguments ..arguments] + [let*_values "let*-values" Arguments ..arguments] + [letrec_values "letrec-values" Arguments ..arguments] + ) + + (def: .public (if test then else) + (-> Expression Expression Expression Computation) + (..form (list (..var "if") test then else))) + + (def: .public (when test then) + (-> Expression Expression Computation) + (..form (list (..var "when") test then))) + + (def: .public (lambda arguments body) + (-> Arguments Expression Computation) + (..form (list (..var "lambda") + (..arguments arguments) + body))) + + (def: .public (define_function name arguments body) + (-> Var Arguments Expression Computation) + (..form (list (..var "define") + (|> arguments + (revised@ #mandatory (|>> (#.Item name))) + ..arguments) + body))) + + (def: .public (define_constant name value) + (-> Var Expression Computation) + (..form (list (..var "define") name value))) + + (def: .public begin + (-> (List Expression) Computation) + (|>> (#.Item (..var "begin")) ..form)) + + (def: .public (set! name value) + (-> Var Expression Computation) + (..form (list (..var "set!") name value))) + + (def: .public (with_exception_handler handler body) + (-> Expression Expression Computation) + (..form (list (..var "with-exception-handler") handler body))) + + (def: .public (call_with_current_continuation body) + (-> Expression Computation) + (..form (list (..var "call-with-current-continuation") body))) + + (def: .public (guard variable clauses else body) + (-> Var (List [Expression Expression]) (Maybe Expression) Expression Computation) + (..form (list (..var "guard") + (..form (|> (case else + #.None + (list) + + (#.Some else) + (list (..form (list (..var "else") else)))) + (list\composite (list\each (function (_ [when then]) + (..form (list when then))) + clauses)) + (list& variable))) + body)))] ) diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index 6e0c41380..1cb95dc1f 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -77,74 +77,72 @@ ) (abstract: .public Time - {} - Nat - (def: .public midnight - Time - (:abstraction 0)) - - (def: .public (of_millis milli_seconds) - (-> Nat (Try Time)) - (if (n.< ..limit milli_seconds) - (#try.Success (:abstraction milli_seconds)) - (exception.except ..time_exceeds_a_day [milli_seconds]))) - - (def: .public millis - (-> Time Nat) - (|>> :representation)) - - (implementation: .public equivalence - (Equivalence Time) - - (def: (= param subject) - (n.= (:representation param) (:representation subject)))) - - (implementation: .public order - (Order Time) - - (def: &equivalence ..equivalence) - - (def: (< param subject) - (n.< (:representation param) (:representation subject)))) - - (`` (implementation: .public enum - (Enum Time) - - (def: &order ..order) - - (def: succ - (|>> :representation ++ (n.% ..limit) :abstraction)) - - (def: pred - (|>> :representation - (case> 0 ..limit - millis millis) - -- - :abstraction)))) - - (def: .public parser - (Parser Time) - (let [millis (: (-> Duration Nat) - (|>> duration.millis .nat)) - hour (millis duration.hour) - minute (millis duration.minute) - second (millis duration.second) - millis (millis duration.milli_second)] - (do [! <>.monad] - [utc_hour ..hour_parser - _ (<text>.this ..separator) - utc_minute ..minute_parser - _ (<text>.this ..separator) - utc_second ..second_parser - utc_millis ..millis_parser] - (in (:abstraction - ($_ n.+ - (n.* utc_hour hour) - (n.* utc_minute minute) - (n.* utc_second second) - (n.* utc_millis millis))))))) + [(def: .public midnight + Time + (:abstraction 0)) + + (def: .public (of_millis milli_seconds) + (-> Nat (Try Time)) + (if (n.< ..limit milli_seconds) + (#try.Success (:abstraction milli_seconds)) + (exception.except ..time_exceeds_a_day [milli_seconds]))) + + (def: .public millis + (-> Time Nat) + (|>> :representation)) + + (implementation: .public equivalence + (Equivalence Time) + + (def: (= param subject) + (n.= (:representation param) (:representation subject)))) + + (implementation: .public order + (Order Time) + + (def: &equivalence ..equivalence) + + (def: (< param subject) + (n.< (:representation param) (:representation subject)))) + + (`` (implementation: .public enum + (Enum Time) + + (def: &order ..order) + + (def: succ + (|>> :representation ++ (n.% ..limit) :abstraction)) + + (def: pred + (|>> :representation + (case> 0 ..limit + millis millis) + -- + :abstraction)))) + + (def: .public parser + (Parser Time) + (let [millis (: (-> Duration Nat) + (|>> duration.millis .nat)) + hour (millis duration.hour) + minute (millis duration.minute) + second (millis duration.second) + millis (millis duration.milli_second)] + (do [! <>.monad] + [utc_hour ..hour_parser + _ (<text>.this ..separator) + utc_minute ..minute_parser + _ (<text>.this ..separator) + utc_second ..second_parser + utc_millis ..millis_parser] + (in (:abstraction + ($_ n.+ + (n.* utc_hour hour) + (n.* utc_minute minute) + (n.* utc_second second) + (n.* utc_millis millis)))))))] ) (def: (padded value) diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux index 450ab5b0b..74f0d2b8c 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -68,77 +68,75 @@ "-") (abstract: .public Date - {} - (Record [#year Year #month Month #day Nat]) - (def: .public (date year month day_of_month) - (-> Year Month Nat (Try Date)) - (if (..invalid_day? year month day_of_month) - (exception.except ..invalid_day [year month day_of_month]) - (#try.Success - (:abstraction - [#year year - #month month - #day day_of_month])))) - - (def: .public epoch - Date - (try.trusted - (..date //year.epoch - #//month.January - ..minimum_day))) - - (template [<name> <type> <field>] - [(def: .public <name> - (-> Date <type>) - (|>> :representation (value@ <field>)))] - - [year Year #year] - [month Month #month] - [day_of_month Nat #day] - ) - - (implementation: .public equivalence - (Equivalence Date) - - (def: (= reference sample) - (let [reference (:representation reference) - sample (:representation sample)] - (and (\ //year.equivalence = + [(def: .public (date year month day_of_month) + (-> Year Month Nat (Try Date)) + (if (..invalid_day? year month day_of_month) + (exception.except ..invalid_day [year month day_of_month]) + (#try.Success + (:abstraction + [#year year + #month month + #day day_of_month])))) + + (def: .public epoch + Date + (try.trusted + (..date //year.epoch + #//month.January + ..minimum_day))) + + (template [<name> <type> <field>] + [(def: .public <name> + (-> Date <type>) + (|>> :representation (value@ <field>)))] + + [year Year #year] + [month Month #month] + [day_of_month Nat #day] + ) + + (implementation: .public equivalence + (Equivalence Date) + + (def: (= reference sample) + (let [reference (:representation reference) + sample (:representation sample)] + (and (\ //year.equivalence = + (value@ #year reference) + (value@ #year sample)) + (\ //month.equivalence = + (value@ #month reference) + (value@ #month sample)) + (n.= (value@ #day reference) + (value@ #day sample)))))) + + (implementation: .public order + (Order Date) + + (def: &equivalence ..equivalence) + + (def: (< reference sample) + (let [reference (:representation reference) + sample (:representation sample)] + (or (\ //year.order < (value@ #year reference) (value@ #year sample)) - (\ //month.equivalence = - (value@ #month reference) - (value@ #month sample)) - (n.= (value@ #day reference) - (value@ #day sample)))))) - - (implementation: .public order - (Order Date) - - (def: &equivalence ..equivalence) - - (def: (< reference sample) - (let [reference (:representation reference) - sample (:representation sample)] - (or (\ //year.order < - (value@ #year reference) - (value@ #year sample)) - (and (\ //year.equivalence = - (value@ #year reference) - (value@ #year sample)) - (or (\ //month.order < - (value@ #month reference) - (value@ #month sample)) - (and (\ //month.order = - (value@ #month reference) - (value@ #month sample)) - (n.< (value@ #day reference) - (value@ #day sample))))))))) + (and (\ //year.equivalence = + (value@ #year reference) + (value@ #year sample)) + (or (\ //month.order < + (value@ #month reference) + (value@ #month sample)) + (and (\ //month.order = + (value@ #month reference) + (value@ #month sample)) + (n.< (value@ #day reference) + (value@ #day sample)))))))))] ) (def: section_parser diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux index 769d38e62..2361a23f8 100644 --- a/stdlib/source/library/lux/time/duration.lux +++ b/stdlib/source/library/lux/time/duration.lux @@ -24,66 +24,64 @@ ["[1][0]" year]]) (abstract: .public Duration - {} - Int - (def: .public of_millis - (-> Int Duration) - (|>> :abstraction)) - - (def: .public millis - (-> Duration Int) - (|>> :representation)) - - (template [<op> <name>] - [(def: .public (<name> param subject) - (-> Duration Duration Duration) - (:abstraction (<op> (:representation param) (:representation subject))))] - - [i.+ merged] - [i.% framed] - ) - - (template [<op> <name>] - [(def: .public (<name> scalar) - (-> Nat Duration Duration) - (|>> :representation (<op> (.int scalar)) :abstraction))] - - [i.* up] - [i./ down] - ) - - (def: .public inverse - (-> Duration Duration) - (|>> :representation (i.* -1) :abstraction)) - - (def: .public (ticks param subject) - (-> Duration Duration Int) - (i./ (:representation param) (:representation subject))) - - (implementation: .public equivalence - (Equivalence Duration) - - (def: (= param subject) - (i.= (:representation param) (:representation subject)))) - - (implementation: .public order - (Order Duration) - - (def: &equivalence ..equivalence) - (def: (< param subject) - (i.< (:representation param) (:representation subject)))) - - (template [<op> <name>] - [(def: .public <name> - (-> Duration Bit) - (|>> :representation (<op> +0)))] - - [i.> positive?] - [i.< negative?] - [i.= neutral?] - ) + [(def: .public of_millis + (-> Int Duration) + (|>> :abstraction)) + + (def: .public millis + (-> Duration Int) + (|>> :representation)) + + (template [<op> <name>] + [(def: .public (<name> param subject) + (-> Duration Duration Duration) + (:abstraction (<op> (:representation param) (:representation subject))))] + + [i.+ merged] + [i.% framed] + ) + + (template [<op> <name>] + [(def: .public (<name> scalar) + (-> Nat Duration Duration) + (|>> :representation (<op> (.int scalar)) :abstraction))] + + [i.* up] + [i./ down] + ) + + (def: .public inverse + (-> Duration Duration) + (|>> :representation (i.* -1) :abstraction)) + + (def: .public (ticks param subject) + (-> Duration Duration Int) + (i./ (:representation param) (:representation subject))) + + (implementation: .public equivalence + (Equivalence Duration) + + (def: (= param subject) + (i.= (:representation param) (:representation subject)))) + + (implementation: .public order + (Order Duration) + + (def: &equivalence ..equivalence) + (def: (< param subject) + (i.< (:representation param) (:representation subject)))) + + (template [<op> <name>] + [(def: .public <name> + (-> Duration Bit) + (|>> :representation (<op> +0)))] + + [i.> positive?] + [i.< negative?] + [i.= neutral?] + )] ) (def: .public empty diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index 7c0ecdc7f..696b204b0 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -33,57 +33,55 @@ ["[0]" date {"+" [Date]}]]) (abstract: .public Instant - {} - Int - (def: .public of_millis - (-> Int Instant) - (|>> :abstraction)) - - (def: .public millis - (-> Instant Int) - (|>> :representation)) - - (def: .public (span from to) - (-> Instant Instant Duration) - (duration.of_millis (i.- (:representation from) (:representation to)))) - - (def: .public (after duration instant) - (-> Duration Instant Instant) - (:abstraction (i.+ (duration.millis duration) (:representation instant)))) - - (def: .public (relative instant) - (-> Instant Duration) - (|> instant :representation duration.of_millis)) - - (def: .public (absolute offset) - (-> Duration Instant) - (|> offset duration.millis :abstraction)) - - (implementation: .public equivalence - (Equivalence Instant) - - (def: (= param subject) - (\ i.equivalence = (:representation param) (:representation subject)))) - - (implementation: .public order - (Order Instant) - - (def: &equivalence ..equivalence) - (def: (< param subject) - (\ i.order < (:representation param) (:representation subject)))) - - (`` (implementation: .public enum - (Enum Instant) - - (def: &order ..order) - (~~ (template [<name>] - [(def: <name> - (|>> :representation (\ i.enum <name>) :abstraction))] - - [succ] [pred] - )))) + [(def: .public of_millis + (-> Int Instant) + (|>> :abstraction)) + + (def: .public millis + (-> Instant Int) + (|>> :representation)) + + (def: .public (span from to) + (-> Instant Instant Duration) + (duration.of_millis (i.- (:representation from) (:representation to)))) + + (def: .public (after duration instant) + (-> Duration Instant Instant) + (:abstraction (i.+ (duration.millis duration) (:representation instant)))) + + (def: .public (relative instant) + (-> Instant Duration) + (|> instant :representation duration.of_millis)) + + (def: .public (absolute offset) + (-> Duration Instant) + (|> offset duration.millis :abstraction)) + + (implementation: .public equivalence + (Equivalence Instant) + + (def: (= param subject) + (\ i.equivalence = (:representation param) (:representation subject)))) + + (implementation: .public order + (Order Instant) + + (def: &equivalence ..equivalence) + (def: (< param subject) + (\ i.order < (:representation param) (:representation subject)))) + + (`` (implementation: .public enum + (Enum Instant) + + (def: &order ..order) + (~~ (template [<name>] + [(def: <name> + (|>> :representation (\ i.enum <name>) :abstraction))] + + [succ] [pred] + ))))] ) (def: .public epoch diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux index 76fdd859d..5a621bac3 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -36,23 +36,21 @@ ... https://en.wikipedia.org/wiki/Gregorian_calendar (abstract: .public Year - {} - Int - (def: .public (year value) - (-> Int (Try Year)) - (case value - +0 (exception.except ..there_is_no_year_0 []) - _ (#try.Success (:abstraction (..internal value))))) + [(def: .public (year value) + (-> Int (Try Year)) + (case value + +0 (exception.except ..there_is_no_year_0 []) + _ (#try.Success (:abstraction (..internal value))))) - (def: .public value - (-> Year Int) - (|>> :representation ..external)) + (def: .public value + (-> Year Int) + (|>> :representation ..external)) - (def: .public epoch - Year - (:abstraction +1970)) + (def: .public epoch + Year + (:abstraction +1970))] ) (def: .public days diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index 96a8683de..d57f4a08b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -75,213 +75,211 @@ "") (abstract: .public Archive - {} - (Record [#next ID #resolver (Dictionary Module [ID (Maybe [Descriptor (Document Any) Output])])]) - (def: next - (-> Archive ID) - (|>> :representation (value@ #next))) - - (def: .public empty - Archive - (:abstraction [#next 0 - #resolver (dictionary.empty text.hash)])) - - (def: .public (id module archive) - (-> Module Archive (Try ID)) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - (#.Some [id _]) - (#try.Success id) - - #.None - (exception.except ..unknown_document [module - (dictionary.keys resolver)])))) - - (def: .public (reserve module archive) - (-> Module Archive (Try [ID Archive])) - (let [(^slots [#..next #..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - (#.Some _) - (exception.except ..module_has_already_been_reserved [module]) - - #.None - (#try.Success [next - (|> archive + [(def: next + (-> Archive ID) + (|>> :representation (value@ #next))) + + (def: .public empty + Archive + (:abstraction [#next 0 + #resolver (dictionary.empty text.hash)])) + + (def: .public (id module archive) + (-> Module Archive (Try ID)) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + (#.Some [id _]) + (#try.Success id) + + #.None + (exception.except ..unknown_document [module + (dictionary.keys resolver)])))) + + (def: .public (reserve module archive) + (-> Module Archive (Try [ID Archive])) + (let [(^slots [#..next #..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + (#.Some _) + (exception.except ..module_has_already_been_reserved [module]) + + #.None + (#try.Success [next + (|> archive + :representation + (revised@ #..resolver (dictionary.has module [next #.None])) + (revised@ #..next ++) + :abstraction)])))) + + (def: .public (has module [descriptor document output] archive) + (-> Module [Descriptor (Document Any) Output] Archive (Try Archive)) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + (#.Some [id #.None]) + (#try.Success (|> archive :representation - (revised@ #..resolver (dictionary.has module [next #.None])) - (revised@ #..next ++) - :abstraction)])))) - - (def: .public (has module [descriptor document output] archive) - (-> Module [Descriptor (Document Any) Output] Archive (Try Archive)) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - (#.Some [id #.None]) - (#try.Success (|> archive - :representation - (revised@ #..resolver (dictionary.has module [id (#.Some [descriptor document output])])) - :abstraction)) - - (#.Some [id (#.Some [existing_descriptor existing_document existing_output])]) - (if (same? document existing_document) - ... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... - (#try.Success archive) - (exception.except ..cannot_replace_document [module existing_document document])) - - #.None - (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) - - (def: .public (find module archive) - (-> Module Archive (Try [Descriptor (Document Any) Output])) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - (#.Some [id (#.Some entry)]) - (#try.Success entry) - - (#.Some [id #.None]) - (exception.except ..module_is_only_reserved [module]) - - #.None - (exception.except ..unknown_document [module - (dictionary.keys resolver)])))) - - (def: .public (archived? archive module) - (-> Archive Module Bit) - (case (..find module archive) - (#try.Success _) - bit.yes - - (#try.Failure _) - bit.no)) - - (def: .public archived - (-> Archive (List Module)) - (|>> :representation - (value@ #resolver) - dictionary.entries - (list.all (function (_ [module [id descriptor+document]]) - (case descriptor+document - (#.Some _) (#.Some module) - #.None #.None))))) - - (def: .public (reserved? archive module) - (-> Archive Module Bit) - (let [(^slots [#..resolver]) (:representation archive)] - (case (dictionary.value module resolver) - (#.Some [id _]) - bit.yes - - #.None - bit.no))) - - (def: .public reserved - (-> Archive (List Module)) - (|>> :representation - (value@ #resolver) - dictionary.keys)) - - (def: .public reservations - (-> Archive (List [Module ID])) - (|>> :representation - (value@ #resolver) - dictionary.entries - (list\each (function (_ [module [id _]]) - [module id])))) - - (def: .public (merged additions archive) - (-> Archive Archive Archive) - (let [[+next +resolver] (:representation additions)] - (|> archive - :representation - (revised@ #next (n.max +next)) - (revised@ #resolver (function (_ resolver) - (list\mix (function (_ [module [id entry]] resolver) - (case entry - (#.Some _) - (dictionary.has module [id entry] resolver) - - #.None - resolver)) - resolver - (dictionary.entries +resolver)))) - :abstraction))) - - (type: Reservation - [Module ID]) - - (type: Frozen - [Version ID (List Reservation)]) - - (def: reader - (Parser ..Frozen) - ($_ <>.and - <binary>.nat - <binary>.nat - (<binary>.list (<>.and <binary>.text <binary>.nat)))) - - (def: writer - (Writer ..Frozen) - ($_ binary.and - binary.nat - binary.nat - (binary.list (binary.and binary.text binary.nat)))) - - (def: .public (export version archive) - (-> Version Archive Binary) - (let [(^slots [#..next #..resolver]) (:representation archive)] - (|> resolver + (revised@ #..resolver (dictionary.has module [id (#.Some [descriptor document output])])) + :abstraction)) + + (#.Some [id (#.Some [existing_descriptor existing_document existing_output])]) + (if (same? document existing_document) + ... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... + (#try.Success archive) + (exception.except ..cannot_replace_document [module existing_document document])) + + #.None + (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) + + (def: .public (find module archive) + (-> Module Archive (Try [Descriptor (Document Any) Output])) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + (#.Some [id (#.Some entry)]) + (#try.Success entry) + + (#.Some [id #.None]) + (exception.except ..module_is_only_reserved [module]) + + #.None + (exception.except ..unknown_document [module + (dictionary.keys resolver)])))) + + (def: .public (archived? archive module) + (-> Archive Module Bit) + (case (..find module archive) + (#try.Success _) + bit.yes + + (#try.Failure _) + bit.no)) + + (def: .public archived + (-> Archive (List Module)) + (|>> :representation + (value@ #resolver) dictionary.entries (list.all (function (_ [module [id descriptor+document]]) (case descriptor+document - (#.Some _) (#.Some [module id]) - #.None #.None))) - [version next] - (binary.result ..writer)))) - - (exception: .public (version_mismatch {expected Version} {actual Version}) - (exception.report - ["Expected" (%.nat expected)] - ["Actual" (%.nat actual)])) - - (exception: .public corrupt_data) - - (def: (correct_modules? reservations) - (-> (List Reservation) Bit) - (n.= (list.size reservations) - (|> reservations - (list\each product.left) - (set.of_list text.hash) - set.size))) - - (def: (correct_ids? reservations) - (-> (List Reservation) Bit) - (n.= (list.size reservations) - (|> reservations - (list\each product.right) - (set.of_list n.hash) - set.size))) - - (def: (correct_reservations? reservations) - (-> (List Reservation) Bit) - (and (correct_modules? reservations) - (correct_ids? reservations))) - - (def: .public (import expected binary) - (-> Version Binary (Try Archive)) - (do try.monad - [[actual next reservations] (<binary>.result ..reader binary) - _ (exception.assertion ..version_mismatch [expected actual] - (n\= expected actual)) - _ (exception.assertion ..corrupt_data [] - (correct_reservations? reservations))] - (in (:abstraction - [#next next - #resolver (list\mix (function (_ [module id] archive) - (dictionary.has module [id #.None] archive)) - (value@ #resolver (:representation ..empty)) - reservations)])))) + (#.Some _) (#.Some module) + #.None #.None))))) + + (def: .public (reserved? archive module) + (-> Archive Module Bit) + (let [(^slots [#..resolver]) (:representation archive)] + (case (dictionary.value module resolver) + (#.Some [id _]) + bit.yes + + #.None + bit.no))) + + (def: .public reserved + (-> Archive (List Module)) + (|>> :representation + (value@ #resolver) + dictionary.keys)) + + (def: .public reservations + (-> Archive (List [Module ID])) + (|>> :representation + (value@ #resolver) + dictionary.entries + (list\each (function (_ [module [id _]]) + [module id])))) + + (def: .public (merged additions archive) + (-> Archive Archive Archive) + (let [[+next +resolver] (:representation additions)] + (|> archive + :representation + (revised@ #next (n.max +next)) + (revised@ #resolver (function (_ resolver) + (list\mix (function (_ [module [id entry]] resolver) + (case entry + (#.Some _) + (dictionary.has module [id entry] resolver) + + #.None + resolver)) + resolver + (dictionary.entries +resolver)))) + :abstraction))) + + (type: Reservation + [Module ID]) + + (type: Frozen + [Version ID (List Reservation)]) + + (def: reader + (Parser ..Frozen) + ($_ <>.and + <binary>.nat + <binary>.nat + (<binary>.list (<>.and <binary>.text <binary>.nat)))) + + (def: writer + (Writer ..Frozen) + ($_ binary.and + binary.nat + binary.nat + (binary.list (binary.and binary.text binary.nat)))) + + (def: .public (export version archive) + (-> Version Archive Binary) + (let [(^slots [#..next #..resolver]) (:representation archive)] + (|> resolver + dictionary.entries + (list.all (function (_ [module [id descriptor+document]]) + (case descriptor+document + (#.Some _) (#.Some [module id]) + #.None #.None))) + [version next] + (binary.result ..writer)))) + + (exception: .public (version_mismatch {expected Version} {actual Version}) + (exception.report + ["Expected" (%.nat expected)] + ["Actual" (%.nat actual)])) + + (exception: .public corrupt_data) + + (def: (correct_modules? reservations) + (-> (List Reservation) Bit) + (n.= (list.size reservations) + (|> reservations + (list\each product.left) + (set.of_list text.hash) + set.size))) + + (def: (correct_ids? reservations) + (-> (List Reservation) Bit) + (n.= (list.size reservations) + (|> reservations + (list\each product.right) + (set.of_list n.hash) + set.size))) + + (def: (correct_reservations? reservations) + (-> (List Reservation) Bit) + (and (correct_modules? reservations) + (correct_ids? reservations))) + + (def: .public (import expected binary) + (-> Version Binary (Try Archive)) + (do try.monad + [[actual next reservations] (<binary>.result ..reader binary) + _ (exception.assertion ..version_mismatch [expected actual] + (n\= expected actual)) + _ (exception.assertion ..corrupt_data [] + (correct_reservations? reservations))] + (in (:abstraction + [#next next + #resolver (list\mix (function (_ [module id] archive) + (dictionary.has module [id #.None] archive)) + (value@ #resolver (:representation ..empty)) + reservations)]))))] ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux index e0bb8536f..e3ad0fd89 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -40,129 +40,127 @@ #category Category])) (abstract: .public Registry - {} - (Record [#artifacts (Row Artifact) #resolver (Dictionary Text ID)]) - (def: .public empty - Registry - (:abstraction [#artifacts row.empty - #resolver (dictionary.empty text.hash)])) - - (def: .public artifacts - (-> Registry (Row Artifact)) - (|>> :representation (value@ #artifacts))) - - (def: next - (-> Registry ID) - (|>> ..artifacts row.size)) - - (def: .public (resource registry) - (-> Registry [ID Registry]) - (let [id (..next registry)] - [id - (|> registry - :representation - (revised@ #artifacts (row.suffix [#id id - #category #Anonymous])) - :abstraction)])) - - (template [<tag> <create> <fetch>] - [(def: .public (<create> name registry) - (-> Text Registry [ID Registry]) - (let [id (..next registry)] - [id - (|> registry - :representation - (revised@ #artifacts (row.suffix [#id id - #category (<tag> name)])) - (revised@ #resolver (dictionary.has name id)) - :abstraction)])) - - (def: .public (<fetch> registry) - (-> Registry (List Text)) - (|> registry - :representation - (value@ #artifacts) - row.list - (list.all (|>> (value@ #category) - (case> (<tag> name) (#.Some name) - _ #.None)))))] - - [#Definition definition definitions] - [#Analyser analyser analysers] - [#Synthesizer synthesizer synthesizers] - [#Generator generator generators] - [#Directive directive directives] - [#Custom custom customs] - ) - - (def: .public (remember name registry) - (-> Text Registry (Maybe ID)) - (|> (:representation registry) - (value@ #resolver) - (dictionary.value name))) - - (def: .public writer - (Writer Registry) - (let [category (: (Writer Category) - (function (_ value) - (case value - (^template [<nat> <tag> <writer>] - [(<tag> value) ((binary.and binary.nat <writer>) [<nat> value])]) - ([0 #Anonymous binary.any] - [1 #Definition binary.text] - [2 #Analyser binary.text] - [3 #Synthesizer binary.text] - [4 #Generator binary.text] - [5 #Directive binary.text] - [6 #Custom binary.text])))) - artifacts (: (Writer (Row Category)) - (binary.row/64 category))] - (|>> :representation - (value@ #artifacts) - (row\each (value@ #category)) - artifacts))) - - (exception: .public (invalid_category {tag Nat}) - (exception.report - ["Tag" (%.nat tag)])) - - (def: .public parser - (Parser Registry) - (let [category (: (Parser Category) - (do [! <>.monad] - [tag <binary>.nat] - (case tag - (^template [<nat> <tag> <parser>] - [<nat> (\ ! each (|>> <tag>) <parser>)]) - ([0 #Anonymous <binary>.any] - [1 #Definition <binary>.text] - [2 #Analyser <binary>.text] - [3 #Synthesizer <binary>.text] - [4 #Generator <binary>.text] - [5 #Directive <binary>.text] - [6 #Custom <binary>.text]) - - _ (<>.failure (exception.error ..invalid_category [tag])))))] - (|> (<binary>.row/64 category) - (\ <>.monad each (row\mix (function (_ artifact registry) - (product.right - (case artifact - #Anonymous - (..resource registry) - - (^template [<tag> <create>] - [(<tag> name) - (<create> name registry)]) - ([#Definition ..definition] - [#Analyser ..analyser] - [#Synthesizer ..synthesizer] - [#Generator ..generator] - [#Directive ..directive] - [#Custom ..custom]) - ))) - ..empty))))) + [(def: .public empty + Registry + (:abstraction [#artifacts row.empty + #resolver (dictionary.empty text.hash)])) + + (def: .public artifacts + (-> Registry (Row Artifact)) + (|>> :representation (value@ #artifacts))) + + (def: next + (-> Registry ID) + (|>> ..artifacts row.size)) + + (def: .public (resource registry) + (-> Registry [ID Registry]) + (let [id (..next registry)] + [id + (|> registry + :representation + (revised@ #artifacts (row.suffix [#id id + #category #Anonymous])) + :abstraction)])) + + (template [<tag> <create> <fetch>] + [(def: .public (<create> name registry) + (-> Text Registry [ID Registry]) + (let [id (..next registry)] + [id + (|> registry + :representation + (revised@ #artifacts (row.suffix [#id id + #category (<tag> name)])) + (revised@ #resolver (dictionary.has name id)) + :abstraction)])) + + (def: .public (<fetch> registry) + (-> Registry (List Text)) + (|> registry + :representation + (value@ #artifacts) + row.list + (list.all (|>> (value@ #category) + (case> (<tag> name) (#.Some name) + _ #.None)))))] + + [#Definition definition definitions] + [#Analyser analyser analysers] + [#Synthesizer synthesizer synthesizers] + [#Generator generator generators] + [#Directive directive directives] + [#Custom custom customs] + ) + + (def: .public (remember name registry) + (-> Text Registry (Maybe ID)) + (|> (:representation registry) + (value@ #resolver) + (dictionary.value name))) + + (def: .public writer + (Writer Registry) + (let [category (: (Writer Category) + (function (_ value) + (case value + (^template [<nat> <tag> <writer>] + [(<tag> value) ((binary.and binary.nat <writer>) [<nat> value])]) + ([0 #Anonymous binary.any] + [1 #Definition binary.text] + [2 #Analyser binary.text] + [3 #Synthesizer binary.text] + [4 #Generator binary.text] + [5 #Directive binary.text] + [6 #Custom binary.text])))) + artifacts (: (Writer (Row Category)) + (binary.row/64 category))] + (|>> :representation + (value@ #artifacts) + (row\each (value@ #category)) + artifacts))) + + (exception: .public (invalid_category {tag Nat}) + (exception.report + ["Tag" (%.nat tag)])) + + (def: .public parser + (Parser Registry) + (let [category (: (Parser Category) + (do [! <>.monad] + [tag <binary>.nat] + (case tag + (^template [<nat> <tag> <parser>] + [<nat> (\ ! each (|>> <tag>) <parser>)]) + ([0 #Anonymous <binary>.any] + [1 #Definition <binary>.text] + [2 #Analyser <binary>.text] + [3 #Synthesizer <binary>.text] + [4 #Generator <binary>.text] + [5 #Directive <binary>.text] + [6 #Custom <binary>.text]) + + _ (<>.failure (exception.error ..invalid_category [tag])))))] + (|> (<binary>.row/64 category) + (\ <>.monad each (row\mix (function (_ artifact registry) + (product.right + (case artifact + #Anonymous + (..resource registry) + + (^template [<tag> <create>] + [(<tag> name) + (<create> name registry)]) + ([#Definition ..definition] + [#Analyser ..analyser] + [#Synthesizer ..synthesizer] + [#Generator ..generator] + [#Directive ..directive] + [#Custom ..custom]) + ))) + ..empty)))))] ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux index 6e56f7f8b..ddb71ac93 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux @@ -26,50 +26,48 @@ ["Actual" (signature.description actual)])) (abstract: .public (Document d) - {} - (Record [#signature Signature #content d]) - (def: .public (read key document) - (All (_ d) (-> (Key d) (Document Any) (Try d))) - (let [[document//signature document//content] (:representation document)] - (if (\ signature.equivalence = - (key.signature key) - document//signature) - (#try.Success (:sharing [e] - (Key e) - key - - e - (:expected document//content))) - (exception.except ..invalid_signature [(key.signature key) - document//signature])))) + [(def: .public (read key document) + (All (_ d) (-> (Key d) (Document Any) (Try d))) + (let [[document//signature document//content] (:representation document)] + (if (\ signature.equivalence = + (key.signature key) + document//signature) + (#try.Success (:sharing [e] + (Key e) + key + + e + (:expected document//content))) + (exception.except ..invalid_signature [(key.signature key) + document//signature])))) - (def: .public (write key content) - (All (_ d) (-> (Key d) d (Document d))) - (:abstraction [#signature (key.signature key) - #content content])) + (def: .public (write key content) + (All (_ d) (-> (Key d) d (Document d))) + (:abstraction [#signature (key.signature key) + #content content])) - (def: .public (check key document) - (All (_ d) (-> (Key d) (Document Any) (Try (Document d)))) - (do try.monad - [_ (..read key document)] - (in (:expected document)))) + (def: .public (check key document) + (All (_ d) (-> (Key d) (Document Any) (Try (Document d)))) + (do try.monad + [_ (..read key document)] + (in (:expected document)))) - (def: .public signature - (-> (Document Any) Signature) - (|>> :representation (value@ #signature))) + (def: .public signature + (-> (Document Any) Signature) + (|>> :representation (value@ #signature))) - (def: .public (writer content) - (All (_ d) (-> (Writer d) (Writer (Document d)))) - (let [writer (binary.and signature.writer - content)] - (|>> :representation writer))) + (def: .public (writer content) + (All (_ d) (-> (Writer d) (Writer (Document d)))) + (let [writer (binary.and signature.writer + content)] + (|>> :representation writer))) - (def: .public parser - (All (_ d) (-> (Parser d) (Parser (Document d)))) - (|>> (<>.and signature.parser) - (\ <>.monad each (|>> :abstraction)))) + (def: .public parser + (All (_ d) (-> (Parser d) (Parser (Document d)))) + (|>> (<>.and signature.parser) + (\ <>.monad each (|>> :abstraction))))] ) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux index e6cac3246..b31b18353 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux @@ -7,15 +7,13 @@ [signature {"+" [Signature]}]]) (abstract: .public (Key k) - {} - Signature - (def: .public signature - (-> (Key Any) Signature) - (|>> :representation)) + [(def: .public signature + (-> (Key Any) Signature) + (|>> :representation)) - (def: .public (key signature sample) - (All (_ d) (-> Signature d (Key d))) - (:abstraction signature)) + (def: .public (key signature sample) + (All (_ d) (-> Signature d (Key d))) + (:abstraction signature))] ) diff --git a/stdlib/source/library/lux/type/abstract.lux b/stdlib/source/library/lux/type/abstract.lux index 15483af23..4452644e7 100644 --- a/stdlib/source/library/lux/type/abstract.lux +++ b/stdlib/source/library/lux/type/abstract.lux @@ -16,7 +16,7 @@ [macro ["[0]" code] [syntax {"+" [syntax:]} - ["|[0]|" annotations]]]]] + ["|[0]|" export]]]]] ["[0]" //]) (type: Stack @@ -211,22 +211,17 @@ (<>.and <code>.local_identifier (\ <>.monad in (list))))) (def: abstract - (Parser [Code [Text (List Text)] |annotations|.Annotations Code (List Code)]) - (let [private (: (Parser [[Text (List Text)] |annotations|.Annotations Code (List Code)]) - ($_ <>.and - ..declaration - |annotations|.parser - <code>.any - (<>.some <code>.any) - ))] - ($_ <>.either - (<>.and <code>.any private) - (<>.and (<>\in (` .private)) private) - ))) + (Parser [Code [Text (List Text)] Code (List Code)]) + (|export|.parser + ($_ <>.and + ..declaration + <code>.any + (<code>.tuple (<>.some <code>.any)) + ))) ... TODO: Make sure the generated code always gets optimized away. ... (This applies to uses of ":abstraction" and ":representation") -(syntax: .public (abstract: [[export_policy [name type_vars] annotations representation_type primitives] +(syntax: .public (abstract: [[export_policy [name type_vars] representation_type primitives] ..abstract]) (do meta.monad [current_module meta.current_module_name @@ -239,7 +234,6 @@ abstraction_declaration representation_declaration])] (in (list& (` (type: (~ export_policy) (~ abstraction_declaration) - (~ (|annotations|.format annotations)) (primitive (~ (code.text (abstraction_type_name [current_module name]))) [(~+ type_varsC)]))) (` (type: (~ representation_declaration) diff --git a/stdlib/source/library/lux/type/dynamic.lux b/stdlib/source/library/lux/type/dynamic.lux index 2f21ae4af..2ffccf010 100644 --- a/stdlib/source/library/lux/type/dynamic.lux +++ b/stdlib/source/library/lux/type/dynamic.lux @@ -21,35 +21,33 @@ ["Actual" (%.type actual)])) (abstract: .public Dynamic - {} - [Type Any] - (def: abstraction - (-> [Type Any] Dynamic) - (|>> :abstraction)) - - (def: representation - (-> Dynamic [Type Any]) - (|>> :representation)) + [(def: abstraction + (-> [Type Any] Dynamic) + (|>> :abstraction)) + + (def: representation + (-> Dynamic [Type Any]) + (|>> :representation)) - (syntax: .public (:dynamic [value <code>.any]) - (with_identifiers [g!value] - (in (list (` (let [(~ g!value) (~ value)] - ((~! ..abstraction) [(:of (~ g!value)) (~ g!value)]))))))) + (syntax: .public (:dynamic [value <code>.any]) + (with_identifiers [g!value] + (in (list (` (let [(~ g!value) (~ value)] + ((~! ..abstraction) [(:of (~ g!value)) (~ g!value)]))))))) - (syntax: .public (:static [type <code>.any - value <code>.any]) - (with_identifiers [g!type g!value] - (in (list (` (let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))] - (: ((~! try.Try) (~ type)) - (if (\ (~! type.equivalence) (~' =) - (.type (~ type)) (~ g!type)) - (#try.Success (:as (~ type) (~ g!value))) - ((~! exception.except) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) + (syntax: .public (:static [type <code>.any + value <code>.any]) + (with_identifiers [g!type g!value] + (in (list (` (let [[(~ g!type) (~ g!value)] ((~! ..representation) (~ value))] + (: ((~! try.Try) (~ type)) + (if (\ (~! type.equivalence) (~' =) + (.type (~ type)) (~ g!type)) + (#try.Success (:as (~ type) (~ g!value))) + ((~! exception.except) ..wrong_type [(.type (~ type)) (~ g!type)]))))))))) - (def: .public (format value) - (-> Dynamic (Try Text)) - (let [[type value] (:representation value)] - (debug.representation type value))) + (def: .public (format value) + (-> Dynamic (Try Text)) + (let [[type value] (:representation value)] + (debug.representation type value)))] ) diff --git a/stdlib/source/library/lux/type/quotient.lux b/stdlib/source/library/lux/type/quotient.lux index 5e052acf2..3d0700124 100644 --- a/stdlib/source/library/lux/type/quotient.lux +++ b/stdlib/source/library/lux/type/quotient.lux @@ -12,39 +12,35 @@ abstract]]]) (abstract: .public (Class t c %) - {} - (-> t c) - (def: .public class - (All (_ t c) - (Ex (_ %) - (-> (-> t c) (Class t c %)))) - (|>> :abstraction)) - - (abstract: .public (Quotient t c %) - {} - - (Record - [#value t - #label c]) - - (def: .public (quotient class value) - (All (_ t c %) - (-> (Class t c %) t - (Quotient t c %))) - (:abstraction [#value value - #label ((:representation Class class) value)])) - - (template [<name> <output> <slot>] - [(def: .public <name> - (All (_ t c %) (-> (Quotient t c %) <output>)) - (|>> :representation (value@ <slot>)))] - - [value t #value] - [label c #label] - ) - ) + [(def: .public class + (All (_ t c) + (Ex (_ %) + (-> (-> t c) (Class t c %)))) + (|>> :abstraction)) + + (abstract: .public (Quotient t c %) + (Record + [#value t + #label c]) + + [(def: .public (quotient class value) + (All (_ t c %) + (-> (Class t c %) t + (Quotient t c %))) + (:abstraction [#value value + #label ((:representation Class class) value)])) + + (template [<name> <output> <slot>] + [(def: .public <name> + (All (_ t c %) (-> (Quotient t c %) <output>)) + (|>> :representation (value@ <slot>)))] + + [value t #value] + [label c #label] + )] + )] ) (syntax: .public (type [class <code>.any]) diff --git a/stdlib/source/library/lux/type/refinement.lux b/stdlib/source/library/lux/type/refinement.lux index 379ac2b6a..3bbe82935 100644 --- a/stdlib/source/library/lux/type/refinement.lux +++ b/stdlib/source/library/lux/type/refinement.lux @@ -12,45 +12,43 @@ abstract]]]) (abstract: .public (Refined t %) - {} - (Record [#value t #predicate (Predicate t)]) - (type: .public (Refiner t %) - (-> t (Maybe (Refined t %)))) + [(type: .public (Refiner t %) + (-> t (Maybe (Refined t %)))) - (def: .public (refiner predicate) - (All (_ t) - (Ex (_ %) - (-> (Predicate t) (Refiner t %)))) - (function (_ value) - (if (predicate value) - (#.Some (:abstraction [#value value - #predicate predicate])) - #.None))) + (def: .public (refiner predicate) + (All (_ t) + (Ex (_ %) + (-> (Predicate t) (Refiner t %)))) + (function (_ value) + (if (predicate value) + (#.Some (:abstraction [#value value + #predicate predicate])) + #.None))) - (template [<name> <output> <slot>] - [(def: .public <name> - (All (_ t %) (-> (Refined t %) <output>)) - (|>> :representation (value@ <slot>)))] + (template [<name> <output> <slot>] + [(def: .public <name> + (All (_ t %) (-> (Refined t %) <output>)) + (|>> :representation (value@ <slot>)))] - [value t #value] - [predicate (Predicate t) #predicate] - ) + [value t #value] + [predicate (Predicate t) #predicate] + ) - (def: .public (lifted transform) - (All (_ t %) - (-> (-> t t) - (-> (Refined t %) (Maybe (Refined t %))))) - (function (_ refined) - (let [(^slots [#value #predicate]) (:representation refined) - value' (transform value)] - (if (predicate value') - (#.Some (:abstraction [#value value' - #predicate predicate])) - #.None)))) + (def: .public (lifted transform) + (All (_ t %) + (-> (-> t t) + (-> (Refined t %) (Maybe (Refined t %))))) + (function (_ refined) + (let [(^slots [#value #predicate]) (:representation refined) + value' (transform value)] + (if (predicate value') + (#.Some (:abstraction [#value value' + #predicate predicate])) + #.None))))] ) (def: .public (only refiner values) diff --git a/stdlib/source/library/lux/type/resource.lux b/stdlib/source/library/lux/type/resource.lux index 52813f686..5743ab70b 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -66,43 +66,39 @@ [output procedure] (in [keys output])))) -(abstract: .public Ordered {} Any) -(abstract: .public Commutative {} Any) +(abstract: .public Ordered Any []) +(abstract: .public Commutative Any []) (abstract: .public (Key mode key) - {} - Any - (template [<name> <mode>] - [(def: <name> - (Ex (_ k) (-> Any (Key <mode> k))) - (|>> :abstraction))] + [(template [<name> <mode>] + [(def: <name> + (Ex (_ k) (-> Any (Key <mode> k))) + (|>> :abstraction))] - [ordered_key Ordered] - [commutative_key Commutative] - )) + [ordered_key Ordered] + [commutative_key Commutative] + )]) (abstract: .public (Res key value) - {} - value - (template [<name> <mode> <key>] - [(def: .public (<name> monad value) - (All (_ ! v) (Ex (_ k) (-> (Monad !) v (Affine ! (Key <mode> k) (Res k v))))) - (function (_ keys) - (\ monad in [[(<key> []) keys] (:abstraction value)])))] - - [ordered Ordered ..ordered_key] - [commutative Commutative ..commutative_key] - ) - - (def: .public (read monad resource) - (All (_ ! v k m) - (-> (Monad !) (Res k v) (Relevant ! (Key m k) v))) - (function (_ [key keys]) - (\ monad in [keys (:representation resource)]))) + [(template [<name> <mode> <key>] + [(def: .public (<name> monad value) + (All (_ ! v) (Ex (_ k) (-> (Monad !) v (Affine ! (Key <mode> k) (Res k v))))) + (function (_ keys) + (\ monad in [[(<key> []) keys] (:abstraction value)])))] + + [ordered Ordered ..ordered_key] + [commutative Commutative ..commutative_key] + ) + + (def: .public (read monad resource) + (All (_ ! v k m) + (-> (Monad !) (Res k v) (Relevant ! (Key m k) v))) + (function (_ [key keys]) + (\ monad in [keys (:representation resource)])))] ) (exception: .public (index_cannot_be_repeated {index Nat}) diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index f5e8060a4..155ac3bbb 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -28,37 +28,35 @@ abstract]]]) (abstract: .public (Qty unit) - {} - Int - (def: in - (All (_ unit) (-> Int (Qty unit))) - (|>> :abstraction)) - - (def: out - (All (_ unit) (-> (Qty unit) Int)) - (|>> :representation)) - - (template [<name> <op>] - [(def: .public (<name> param subject) - (All (_ unit) (-> (Qty unit) (Qty unit) (Qty unit))) - (:abstraction (<op> (:representation param) - (:representation subject))))] - - [+ i.+] - [- i.-] - ) - - (template [<name> <op> <p> <s> <p*s>] - [(def: .public (<name> param subject) - (All (_ p s) (-> (Qty <p>) (Qty <s>) (Qty <p*s>))) - (:abstraction (<op> (:representation param) - (:representation subject))))] - - [* i.* p s [p s]] - [/ i./ p [p s] s] - ) + [(def: in + (All (_ unit) (-> Int (Qty unit))) + (|>> :abstraction)) + + (def: out + (All (_ unit) (-> (Qty unit) Int)) + (|>> :representation)) + + (template [<name> <op>] + [(def: .public (<name> param subject) + (All (_ unit) (-> (Qty unit) (Qty unit) (Qty unit))) + (:abstraction (<op> (:representation param) + (:representation subject))))] + + [+ i.+] + [- i.-] + ) + + (template [<name> <op> <p> <s> <p*s>] + [(def: .public (<name> param subject) + (All (_ p s) (-> (Qty <p>) (Qty <s>) (Qty <p*s>))) + (:abstraction (<op> (:representation param) + (:representation subject))))] + + [* i.* p s [p s]] + [/ i./ p [p s] s] + )] ) (type: .public (Unit a) diff --git a/stdlib/source/library/lux/world/db/sql.lux b/stdlib/source/library/lux/world/db/sql.lux index 205e5e03e..3e2f87581 100644 --- a/stdlib/source/library/lux/world/db/sql.lux +++ b/stdlib/source/library/lux/world/db/sql.lux @@ -21,7 +21,7 @@ ... Kind (template [<declaration>] - [(abstract: .public <declaration> Any)] + [(abstract: .public <declaration> Any [])] [Literal'] [Column'] @@ -66,415 +66,415 @@ Text ... SQL - (template [<declaration> <kind>] - [(type: .public <declaration> - (SQL <kind>))] - - [Literal (Value' Literal')] - [Column (Value' Column')] - [Placeholder (Value' Placeholder')] - [Value (Value' Any)] - - [Function Function'] - [Condition Condition'] - - [Index Index'] - - [Table Table'] - [View View'] - [Source Source'] - [DB DB'] - - [Order Order'] - - [(Schema kind) (Schema' kind)] - - [(Query where having order group limit offset) (Statement' (Action' where having (Query' order group limit offset)))] - [(Command where having) (Statement' (Action' where having Command'))] - [(Action where having kind) (Statement' (Action' where having kind))] - - [Definition (Statement' Definition')] - [Statement (Statement' Any)] - ) - - (def: Base_Query (.type (Query No_Where No_Having No_Order No_Group No_Limit No_Offset))) - (def: Any_Query (.type (Query Any Any Any Any Any Any))) - - (def: .public read - {#.doc (example "Only use this function for debugging purposes." - "Do not use this function to actually execute SQL code.")} - (-> (SQL Any) Text) - (|>> :representation)) - - (def: .public (sql action) - (-> Statement Text) - (format (:representation action) ";")) - - (def: listing - (-> (List (SQL Any)) Text) - (|>> (list\each (|>> :representation)) - (text.interposed ", "))) - - ... Value - (def: .public ? Placeholder (:abstraction "?")) - - (def: literal - (-> Text Literal) - (|>> :abstraction)) - - (def: .public null Literal (..literal "NULL")) - - (def: .public (int value) - (-> Int Literal) - (..literal (if (i.< +0 value) - (%.int value) - (%.nat (.nat value))))) - - (def: .public function - (-> Text Function) - (|>> :abstraction)) - - (def: .public (call function parameters) - (-> Function (List Value) Value) - (:abstraction (format (:representation function) - (..parenthesize (..listing parameters))))) - - ... Condition - (template [<name> <sql_op>] - [(def: .public (<name> reference sample) - (-> Value Value Condition) - (:abstraction - (..parenthesize - (format (:representation sample) + [(template [<declaration> <kind>] + [(type: .public <declaration> + (SQL <kind>))] + + [Literal (Value' Literal')] + [Column (Value' Column')] + [Placeholder (Value' Placeholder')] + [Value (Value' Any)] + + [Function Function'] + [Condition Condition'] + + [Index Index'] + + [Table Table'] + [View View'] + [Source Source'] + [DB DB'] + + [Order Order'] + + [(Schema kind) (Schema' kind)] + + [(Query where having order group limit offset) (Statement' (Action' where having (Query' order group limit offset)))] + [(Command where having) (Statement' (Action' where having Command'))] + [(Action where having kind) (Statement' (Action' where having kind))] + + [Definition (Statement' Definition')] + [Statement (Statement' Any)] + ) + + (def: Base_Query (.type (Query No_Where No_Having No_Order No_Group No_Limit No_Offset))) + (def: Any_Query (.type (Query Any Any Any Any Any Any))) + + (def: .public read + {#.doc (example "Only use this function for debugging purposes." + "Do not use this function to actually execute SQL code.")} + (-> (SQL Any) Text) + (|>> :representation)) + + (def: .public (sql action) + (-> Statement Text) + (format (:representation action) ";")) + + (def: listing + (-> (List (SQL Any)) Text) + (|>> (list\each (|>> :representation)) + (text.interposed ", "))) + + ... Value + (def: .public ? Placeholder (:abstraction "?")) + + (def: literal + (-> Text Literal) + (|>> :abstraction)) + + (def: .public null Literal (..literal "NULL")) + + (def: .public (int value) + (-> Int Literal) + (..literal (if (i.< +0 value) + (%.int value) + (%.nat (.nat value))))) + + (def: .public function + (-> Text Function) + (|>> :abstraction)) + + (def: .public (call function parameters) + (-> Function (List Value) Value) + (:abstraction (format (:representation function) + (..parenthesize (..listing parameters))))) + + ... Condition + (template [<name> <sql_op>] + [(def: .public (<name> reference sample) + (-> Value Value Condition) + (:abstraction + (..parenthesize + (format (:representation sample) + " " <sql_op> " " + (:representation reference)))))] + + [= "="] + [<> "<>"] + [is? "IS"] + [> ">"] + [>= ">="] + [< "<"] + [<= "<="] + [like? "LIKE"] + [ilike? "ILIKE"] + ) + + (def: .public (between from to sample) + (-> Value Value Value Condition) + (:abstraction + (..parenthesize + (format (:representation sample) + " BETWEEN " (:representation from) + " AND " (:representation to))))) + + (def: .public (in options value) + (-> (List Value) Value Condition) + (:abstraction + (format (:representation value) + " IN " + (..parenthesize (listing options))))) + + (template [<func_name> <sql_op>] + [(def: .public (<func_name> left right) + (-> Condition Condition Condition) + (:abstraction + (format (..parenthesize (:representation left)) " " <sql_op> " " - (:representation reference)))))] - - [= "="] - [<> "<>"] - [is? "IS"] - [> ">"] - [>= ">="] - [< "<"] - [<= "<="] - [like? "LIKE"] - [ilike? "ILIKE"] - ) - - (def: .public (between from to sample) - (-> Value Value Value Condition) - (:abstraction - (..parenthesize - (format (:representation sample) - " BETWEEN " (:representation from) - " AND " (:representation to))))) - - (def: .public (in options value) - (-> (List Value) Value Condition) - (:abstraction - (format (:representation value) - " IN " - (..parenthesize (listing options))))) - - (template [<func_name> <sql_op>] - [(def: .public (<func_name> left right) - (-> Condition Condition Condition) - (:abstraction - (format (..parenthesize (:representation left)) - " " <sql_op> " " - (..parenthesize (:representation right)))))] - - [and "AND"] - [or "OR"] - ) - - (template [<name> <type> <sql>] - [(def: .public <name> - (-> <type> Condition) - (|>> :representation ..parenthesize (format <sql> " ") :abstraction))] - - [not Condition "NOT"] - [exists Any_Query "EXISTS"] - ) - - ... Query - (template [<name> <type> <decoration>] - [(def: .public <name> - (-> <type> Source) - (|>> :representation <decoration> :abstraction))] - - [from_table Table (<|)] - [from_view View (<|)] - [from_query Any_Query ..parenthesize] - ) - - (template [<func_name> <op>] - [(def: .public (<func_name> columns source) - (-> (List [Column Alias]) Source Base_Query) - (:abstraction - (format <op> - " " - (case columns - #.End - "*" - - _ - (|> columns - (list\each (.function (_ [column alias]) - (if (text\= ..no_alias alias) - (:representation column) - (format (:representation column) " AS " alias)))) - (text.interposed ", "))) - " FROM " (:representation source))))] - - - [select "SELECT"] - [select_distinct "SELECT DISTINCT"] - ) - - (template [<name> <join_text>] - [(def: .public (<name> table condition prev) - (-> Table Condition Base_Query Base_Query) - (:abstraction - (format (:representation prev) - " " <join_text> " " - (:representation table) - " ON " (:representation condition))))] - - [inner_join "INNER JOIN"] - [left_join "LEFT JOIN"] - [right_join "RIGHT JOIN"] - [full_outer_join "FULL OUTER JOIN"] - ) - - (template [<function> <sql_op>] - [(def: .public (<function> left right) - (-> Any_Query Any_Query (Query Without_Where Without_Having No_Order No_Group No_Limit No_Offset)) - (:abstraction - (format (:representation left) - " " <sql_op> " " - (:representation right))))] - - [union "UNION"] - [union_all "UNION ALL"] - [intersect "INTERSECT"] - ) - - (template [<name> <sql> <variables> <input> <output>] - [(`` (def: .public (<name> value query) - (All (_ (~~ (template.spliced <variables>))) - (-> Nat <input> <output>)) - (:abstraction - (format (:representation query) - " " <sql> " " - (%.nat value)))))] - - [limit "LIMIT" [where having order group offset] - (Query where having order group No_Limit offset) - (Query where having order group With_Limit offset)] - - [offset "OFFSET" [where having order group limit] - (Query where having order group limit No_Offset) - (Query where having order group limit With_Offset)] - ) - - (template [<name> <sql>] - [(def: .public <name> - Order - (:abstraction <sql>))] - - [ascending "ASC"] - [descending "DESC"] - ) - - (def: .public (order_by pairs query) - (All (_ where having group limit offset) - (-> (List [Value Order]) - (Query where having No_Order group limit offset) - (Query where having With_Order group limit offset))) - (case pairs - #.End - (|> query :representation :abstraction) - - _ - (:abstraction - (format (:representation query) - " ORDER BY " - (|> pairs - (list\each (.function (_ [value order]) - (format (:representation value) " " (:representation order)))) - (text.interposed ", ")))))) - - (def: .public (group_by pairs query) - (All (_ where having order limit offset) - (-> (List Value) - (Query where having order No_Group limit offset) - (Query where having order With_Group limit offset))) - (case pairs - #.End - (|> query :representation :abstraction) - - _ - (:abstraction - (format (:representation query) - " GROUP BY " - (..listing pairs))))) - - ... Command - (def: .public (insert table columns rows) - (-> Table (List Column) (List (List Value)) (Command Without_Where Without_Having)) - (:abstraction - (format "INSERT INTO " (:representation table) " " - (..parenthesize (..listing columns)) - " VALUES " - (|> rows - (list\each (|>> ..listing ..parenthesize)) - (text.interposed ", ")) - ))) - - (def: .public (update table pairs) - (-> Table (List [Column Value]) (Command No_Where No_Having)) - (:abstraction (format "UPDATE " (:representation table) - (case pairs - #.End - "" - - _ - (format " SET " (|> pairs - (list\each (.function (_ [column value]) - (format (:representation column) "=" (:representation value)))) - (text.interposed ", "))))))) - - (def: .public delete - (-> Table (Command No_Where No_Having)) - (|>> :representation (format "DELETE FROM ") :abstraction)) - - ... Action - (def: .public (where condition prev) - (All (_ kind having) - (-> Condition (Action No_Where having kind) (Action With_Where having kind))) - (:abstraction - (format (:representation prev) - " WHERE " - (:representation condition)))) - - (def: .public (having condition prev) - (All (_ where kind) - (-> Condition (Action where No_Having kind) (Action where With_Having kind))) - (:abstraction - (format (:representation prev) - " HAVING " - (:representation condition)))) - - ... Schema - (def: .public type - (-> Text (Schema Value)) - (|>> :abstraction)) - - (template [<name> <attr>] - [(def: .public (<name> attr) - (-> (Schema Value) (Schema Value)) + (..parenthesize (:representation right)))))] + + [and "AND"] + [or "OR"] + ) + + (template [<name> <type> <sql>] + [(def: .public <name> + (-> <type> Condition) + (|>> :representation ..parenthesize (format <sql> " ") :abstraction))] + + [not Condition "NOT"] + [exists Any_Query "EXISTS"] + ) + + ... Query + (template [<name> <type> <decoration>] + [(def: .public <name> + (-> <type> Source) + (|>> :representation <decoration> :abstraction))] + + [from_table Table (<|)] + [from_view View (<|)] + [from_query Any_Query ..parenthesize] + ) + + (template [<func_name> <op>] + [(def: .public (<func_name> columns source) + (-> (List [Column Alias]) Source Base_Query) + (:abstraction + (format <op> + " " + (case columns + #.End + "*" + + _ + (|> columns + (list\each (.function (_ [column alias]) + (if (text\= ..no_alias alias) + (:representation column) + (format (:representation column) " AS " alias)))) + (text.interposed ", "))) + " FROM " (:representation source))))] + + + [select "SELECT"] + [select_distinct "SELECT DISTINCT"] + ) + + (template [<name> <join_text>] + [(def: .public (<name> table condition prev) + (-> Table Condition Base_Query Base_Query) + (:abstraction + (format (:representation prev) + " " <join_text> " " + (:representation table) + " ON " (:representation condition))))] + + [inner_join "INNER JOIN"] + [left_join "LEFT JOIN"] + [right_join "RIGHT JOIN"] + [full_outer_join "FULL OUTER JOIN"] + ) + + (template [<function> <sql_op>] + [(def: .public (<function> left right) + (-> Any_Query Any_Query (Query Without_Where Without_Having No_Order No_Group No_Limit No_Offset)) + (:abstraction + (format (:representation left) + " " <sql_op> " " + (:representation right))))] + + [union "UNION"] + [union_all "UNION ALL"] + [intersect "INTERSECT"] + ) + + (template [<name> <sql> <variables> <input> <output>] + [(`` (def: .public (<name> value query) + (All (_ (~~ (template.spliced <variables>))) + (-> Nat <input> <output>)) + (:abstraction + (format (:representation query) + " " <sql> " " + (%.nat value)))))] + + [limit "LIMIT" [where having order group offset] + (Query where having order group No_Limit offset) + (Query where having order group With_Limit offset)] + + [offset "OFFSET" [where having order group limit] + (Query where having order group limit No_Offset) + (Query where having order group limit With_Offset)] + ) + + (template [<name> <sql>] + [(def: .public <name> + Order + (:abstraction <sql>))] + + [ascending "ASC"] + [descending "DESC"] + ) + + (def: .public (order_by pairs query) + (All (_ where having group limit offset) + (-> (List [Value Order]) + (Query where having No_Order group limit offset) + (Query where having With_Order group limit offset))) + (case pairs + #.End + (|> query :representation :abstraction) + + _ (:abstraction - (format (:representation attr) " " <attr>)))] - - [unique "UNIQUE"] - [not_null "NOT NULL"] - [stored "STORED"] - ) - - (def: .public (default value attr) - (-> Value (Schema Value) (Schema Value)) - (:abstraction - (format (:representation attr) " DEFAULT " (:representation value)))) - - (def: .public (define_column name type) - (-> Column (Schema Value) (Schema Column)) - (:abstraction - (format (:representation name) " " (:representation type)))) - - (def: .public (auto_increment offset column) - (-> Int (Schema Column) (Schema Column)) - (:abstraction - (format (:representation column) " AUTO_INCREMENT=" (:representation (..int offset))))) - - (def: .public (create_table or_replace? table columns) - (-> Bit Table (List (Schema Column)) Definition) - (let [command (if or_replace? - "CREATE OR REPLACE TABLE" - "CREATE TABLE IF NOT EXISTS")] - (:abstraction - (format command " " (:representation table) - (..parenthesize (..listing columns)))))) - - (def: .public (create_table_as table query) - (-> Table Any_Query Definition) - (:abstraction - (format "CREATE TABLE " (:representation table) " AS " (:representation query)))) - - (template [<name> <sql>] - [(def: .public (<name> table) - (-> Table Definition) + (format (:representation query) + " ORDER BY " + (|> pairs + (list\each (.function (_ [value order]) + (format (:representation value) " " (:representation order)))) + (text.interposed ", ")))))) + + (def: .public (group_by pairs query) + (All (_ where having order limit offset) + (-> (List Value) + (Query where having order No_Group limit offset) + (Query where having order With_Group limit offset))) + (case pairs + #.End + (|> query :representation :abstraction) + + _ (:abstraction - (format <sql> " TABLE " (:representation table))))] - - [drop "DROP"] - [truncate "TRUNCATE"] - ) - - (def: .public (add_column table column) - (-> Table (Schema Column) Definition) - (:abstraction - (format "ALTER TABLE " (:representation table) " ADD " (:representation column)))) - - (def: .public (drop_column table column) - (-> Table Column Definition) - (:abstraction - (format "ALTER TABLE " (:representation table) " DROP COLUMN " (:representation column)))) - - (template [<name> <type>] - [(def: .public (<name> name) - (-> Text <type>) - (:abstraction name))] - - [column Column] - [table Table] - [view View] - [index Index] - [db DB] - ) - - (template [<name> <type> <sql>] - [(def: .public <name> - (-> <type> Definition) - (|>> :representation (format <sql> " ") :abstraction))] - - [create_db DB "CREATE DATABASE"] - [drop_db DB "DROP DATABASE"] - [drop_view View "DROP VIEW"] - ) - - (template [<name> <sql>] - [(def: .public (<name> view query) - (-> View Any_Query Definition) + (format (:representation query) + " GROUP BY " + (..listing pairs))))) + + ... Command + (def: .public (insert table columns rows) + (-> Table (List Column) (List (List Value)) (Command Without_Where Without_Having)) + (:abstraction + (format "INSERT INTO " (:representation table) " " + (..parenthesize (..listing columns)) + " VALUES " + (|> rows + (list\each (|>> ..listing ..parenthesize)) + (text.interposed ", ")) + ))) + + (def: .public (update table pairs) + (-> Table (List [Column Value]) (Command No_Where No_Having)) + (:abstraction (format "UPDATE " (:representation table) + (case pairs + #.End + "" + + _ + (format " SET " (|> pairs + (list\each (.function (_ [column value]) + (format (:representation column) "=" (:representation value)))) + (text.interposed ", "))))))) + + (def: .public delete + (-> Table (Command No_Where No_Having)) + (|>> :representation (format "DELETE FROM ") :abstraction)) + + ... Action + (def: .public (where condition prev) + (All (_ kind having) + (-> Condition (Action No_Where having kind) (Action With_Where having kind))) + (:abstraction + (format (:representation prev) + " WHERE " + (:representation condition)))) + + (def: .public (having condition prev) + (All (_ where kind) + (-> Condition (Action where No_Having kind) (Action where With_Having kind))) + (:abstraction + (format (:representation prev) + " HAVING " + (:representation condition)))) + + ... Schema + (def: .public type + (-> Text (Schema Value)) + (|>> :abstraction)) + + (template [<name> <attr>] + [(def: .public (<name> attr) + (-> (Schema Value) (Schema Value)) + (:abstraction + (format (:representation attr) " " <attr>)))] + + [unique "UNIQUE"] + [not_null "NOT NULL"] + [stored "STORED"] + ) + + (def: .public (default value attr) + (-> Value (Schema Value) (Schema Value)) + (:abstraction + (format (:representation attr) " DEFAULT " (:representation value)))) + + (def: .public (define_column name type) + (-> Column (Schema Value) (Schema Column)) + (:abstraction + (format (:representation name) " " (:representation type)))) + + (def: .public (auto_increment offset column) + (-> Int (Schema Column) (Schema Column)) + (:abstraction + (format (:representation column) " AUTO_INCREMENT=" (:representation (..int offset))))) + + (def: .public (create_table or_replace? table columns) + (-> Bit Table (List (Schema Column)) Definition) + (let [command (if or_replace? + "CREATE OR REPLACE TABLE" + "CREATE TABLE IF NOT EXISTS")] (:abstraction - (format <sql> " " (:representation view) " AS " (:representation query))))] - - [create_view "CREATE VIEW"] - [create_or_replace_view "CREATE OR REPLACE VIEW"] - ) - - (def: .public (create_index index table unique? columns) - (-> Index Table Bit (List Column) Definition) - (:abstraction - (format "CREATE " (if unique? "UNIQUE" "") " INDEX " (:representation index) - " ON " (:representation table) " " (..parenthesize (..listing columns))))) - - (def: .public (with alias query body) - (All (_ where having order group limit offset) - (-> Table Any_Query - (Query where having order group limit offset) - (Query where having order group limit offset))) - (:abstraction - (format "WITH " (:representation alias) - " AS " (..parenthesize (:representation query)) - " " (:representation body)))) + (format command " " (:representation table) + (..parenthesize (..listing columns)))))) + + (def: .public (create_table_as table query) + (-> Table Any_Query Definition) + (:abstraction + (format "CREATE TABLE " (:representation table) " AS " (:representation query)))) + + (template [<name> <sql>] + [(def: .public (<name> table) + (-> Table Definition) + (:abstraction + (format <sql> " TABLE " (:representation table))))] + + [drop "DROP"] + [truncate "TRUNCATE"] + ) + + (def: .public (add_column table column) + (-> Table (Schema Column) Definition) + (:abstraction + (format "ALTER TABLE " (:representation table) " ADD " (:representation column)))) + + (def: .public (drop_column table column) + (-> Table Column Definition) + (:abstraction + (format "ALTER TABLE " (:representation table) " DROP COLUMN " (:representation column)))) + + (template [<name> <type>] + [(def: .public (<name> name) + (-> Text <type>) + (:abstraction name))] + + [column Column] + [table Table] + [view View] + [index Index] + [db DB] + ) + + (template [<name> <type> <sql>] + [(def: .public <name> + (-> <type> Definition) + (|>> :representation (format <sql> " ") :abstraction))] + + [create_db DB "CREATE DATABASE"] + [drop_db DB "DROP DATABASE"] + [drop_view View "DROP VIEW"] + ) + + (template [<name> <sql>] + [(def: .public (<name> view query) + (-> View Any_Query Definition) + (:abstraction + (format <sql> " " (:representation view) " AS " (:representation query))))] + + [create_view "CREATE VIEW"] + [create_or_replace_view "CREATE OR REPLACE VIEW"] + ) + + (def: .public (create_index index table unique? columns) + (-> Index Table Bit (List Column) Definition) + (:abstraction + (format "CREATE " (if unique? "UNIQUE" "") " INDEX " (:representation index) + " ON " (:representation table) " " (..parenthesize (..listing columns))))) + + (def: .public (with alias query body) + (All (_ where having order group limit offset) + (-> Table Any_Query + (Query where having order group limit offset) + (Query where having order group limit offset))) + (:abstraction + (format "WITH " (:representation alias) + " AS " (..parenthesize (:representation query)) + " " (:representation body))))] ) diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index ca06e9f74..73ef783b9 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -33,54 +33,52 @@ ["[0]" //]) (abstract: .public Concern - {} - (Record [#creation Bit #modification Bit #deletion Bit]) - (def: none - Concern - (:abstraction - [#creation false - #modification false - #deletion false])) - - (template [<concern> <predicate> <event> <create> <modify> <delete>] - [(def: .public <concern> - Concern - (:abstraction - [#creation <create> - #modification <modify> - #deletion <delete>])) - - (def: .public <predicate> - (Predicate Concern) - (|>> :representation (value@ <event>)))] - - [creation creation? #creation - true false false] - [modification modification? #modification - false true false] - [deletion deletion? #deletion - false false true] - ) - - (def: .public (also left right) - (-> Concern Concern Concern) - (:abstraction - [#creation (or (..creation? left) (..creation? right)) - #modification (or (..modification? left) (..modification? right)) - #deletion (or (..deletion? left) (..deletion? right))])) - - (def: .public all - Concern - ($_ ..also - ..creation - ..modification - ..deletion - )) + [(def: none + Concern + (:abstraction + [#creation false + #modification false + #deletion false])) + + (template [<concern> <predicate> <event> <create> <modify> <delete>] + [(def: .public <concern> + Concern + (:abstraction + [#creation <create> + #modification <modify> + #deletion <delete>])) + + (def: .public <predicate> + (Predicate Concern) + (|>> :representation (value@ <event>)))] + + [creation creation? #creation + true false false] + [modification modification? #modification + false true false] + [deletion deletion? #deletion + false false true] + ) + + (def: .public (also left right) + (-> Concern Concern Concern) + (:abstraction + [#creation (or (..creation? left) (..creation? right)) + #modification (or (..modification? left) (..modification? right)) + #deletion (or (..deletion? left) (..deletion? right))])) + + (def: .public all + Concern + ($_ ..also + ..creation + ..modification + ..deletion + ))] ) (type: .public (Watcher !) diff --git a/stdlib/source/library/lux/world/net/http/mime.lux b/stdlib/source/library/lux/world/net/http/mime.lux index 257a4d5a5..ba7811ed2 100644 --- a/stdlib/source/library/lux/world/net/http/mime.lux +++ b/stdlib/source/library/lux/world/net/http/mime.lux @@ -9,17 +9,15 @@ abstract]]]) (abstract: .public MIME - {#doc "Multipurpose Internet Mail Extensions"} - Text - (def: .public mime - (-> Text MIME) - (|>> :abstraction)) + [(def: .public mime + (-> Text MIME) + (|>> :abstraction)) - (def: .public name - (-> MIME Text) - (|>> :representation)) + (def: .public name + (-> MIME Text) + (|>> :representation))] ) ... https://developer.mozilla.org/en-US/docs/Web/HTTP/Basics_of_HTTP/MIME_types/Complete_list_of_MIME_types diff --git a/stdlib/source/library/lux/world/program.lux b/stdlib/source/library/lux/world/program.lux index 6e535fef3..ea0423155 100644 --- a/stdlib/source/library/lux/world/program.lux +++ b/stdlib/source/library/lux/world/program.lux @@ -292,8 +292,8 @@ ... @.scheme ... (as_is (ffi.import: (exit [Int] "io" Nothing)) ... ... https://srfi.schemers.org/srfi-98/srfi-98.html - ... (abstract: Pair Any) - ... (abstract: PList Any) + ... (abstract: Pair Any []) + ... (abstract: PList Any []) ... (ffi.import: (get-environment-variables [] "io" PList)) ... (ffi.import: (car [Pair] Text)) ... (ffi.import: (cdr [Pair] Text)) diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index eb00c2af5..996858e3e 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -31,138 +31,136 @@ ("static" getInstance [java/lang/String] java/security/MessageDigest) (digest [[byte]] [byte])]) -(abstract: .public SHA-1 {} Any) -(abstract: .public MD5 {} Any) +(abstract: .public SHA-1 Any []) +(abstract: .public MD5 Any []) (abstract: .public (Hash h) - {} - Binary - (def: .public data - (All (_ h) (-> (Hash h) Binary)) - (|>> :representation)) - - (template [<name> <kind> <algorithm>] - [(def: .public (<name> value) - (-> Binary (Hash <kind>)) - (|> (java/security/MessageDigest::getInstance [<algorithm>]) - (java/security/MessageDigest::digest [value]) - :abstraction))] - - [sha-1 ..SHA-1 "SHA-1"] - [md5 ..MD5 "MD5"] - ) - - (def: encoded - (Format Binary) - (binary.aggregate (function (_ byte representation) - (let [hex (\ n.hex encoded byte) - hex (case (text.size hex) - 1 (format "0" hex) - _ hex)] - (format representation hex))) - "")) - - (template [<factor> <name>] - [(def: <name> - Nat - <factor>)] - - [20 sha-1::size] - [16 md5::size] - ) - - (def: hex_per_byte - 2) - - (def: hex_per_chunk - (n.* hex_per_byte i64.bytes_per_i64)) - - (exception: .public (not_a_hash {size Nat} {value Text}) - (exception.report - ["Pseudo hash" (%.text value)] - ["Expected size" (%.nat size)] - ["Actual size" (%.nat (text.size value))])) - - (template [<name> <size>] - [(exception: .public (<name> {data Binary}) - (exception.report - ["Pseudo hash" (%.text (..encoded data))] - ["Expected size" (%.nat <size>)] - ["Actual size" (%.nat (binary.size data))]))] - - [not_a_sha-1 ..sha-1::size] - [not_a_md5 ..md5::size] - ) - - (template [<name> <kind> <size> <exception>] - [(def: .public (<name> data) - (-> Binary (Try (Hash <kind>))) - (if (n.= <size> (binary.size data)) - (#try.Success (:abstraction data)) - (exception.except <exception> [data])))] - - [as_sha-1 SHA-1 ..sha-1::size ..not_a_sha-1] - [as_md5 MD5 ..md5::size ..not_a_md5] - ) - - (def: hash_size - (-> Text Nat) - (|>> text.size (n./ ..hex_per_byte))) - - (def: encoding_size - (-> Nat Nat) - (n.* ..hex_per_byte)) - - (def: (decoded size constructor encoded) - (All (_ h) - (-> Nat (-> Binary (Try (Hash h))) - (-> Text (Try (Hash h))))) - (let [hash_size (..hash_size encoded)] - (if (n.= size hash_size) - (loop [input encoded - chunk 0 - output (binary.empty hash_size)] - (let [index (n.* chunk i64.bytes_per_i64)] - (case (text.split_at ..hex_per_chunk input) - (#.Some [head tail]) - (do try.monad - [head (\ n.hex decoded head) - output (binary.write/64! index head output)] - (recur tail (++ chunk) output)) - - #.None - (case (..hash_size input) - 0 (constructor output) - (^template [<size> <write>] - [<size> - (do try.monad - [head (\ n.hex decoded input) - output (<write> index head output)] - (constructor output))]) - ([1 binary.write/8!] - [2 binary.write/16!] - [4 binary.write/32!]) - _ (exception.except ..not_a_hash [(..encoding_size size) encoded]))))) - (exception.except ..not_a_hash [(..encoding_size size) encoded])))) - - (template [<codec> <hash> <nat> <constructor>] - [(implementation: .public <codec> - (Codec Text (Hash <hash>)) - - (def: encoded (|>> :representation ..encoded)) - (def: decoded (..decoded <nat> <constructor>)))] - - [sha-1_codec SHA-1 ..sha-1::size ..as_sha-1] - [md5_codec MD5 ..md5::size ..as_md5] - ) - - (implementation: .public equivalence - (All (_ h) (Equivalence (Hash h))) - - (def: (= reference subject) - (\ binary.equivalence = - (:representation reference) - (:representation subject)))) + [(def: .public data + (All (_ h) (-> (Hash h) Binary)) + (|>> :representation)) + + (template [<name> <kind> <algorithm>] + [(def: .public (<name> value) + (-> Binary (Hash <kind>)) + (|> (java/security/MessageDigest::getInstance [<algorithm>]) + (java/security/MessageDigest::digest [value]) + :abstraction))] + + [sha-1 ..SHA-1 "SHA-1"] + [md5 ..MD5 "MD5"] + ) + + (def: encoded + (Format Binary) + (binary.aggregate (function (_ byte representation) + (let [hex (\ n.hex encoded byte) + hex (case (text.size hex) + 1 (format "0" hex) + _ hex)] + (format representation hex))) + "")) + + (template [<factor> <name>] + [(def: <name> + Nat + <factor>)] + + [20 sha-1::size] + [16 md5::size] + ) + + (def: hex_per_byte + 2) + + (def: hex_per_chunk + (n.* hex_per_byte i64.bytes_per_i64)) + + (exception: .public (not_a_hash {size Nat} {value Text}) + (exception.report + ["Pseudo hash" (%.text value)] + ["Expected size" (%.nat size)] + ["Actual size" (%.nat (text.size value))])) + + (template [<name> <size>] + [(exception: .public (<name> {data Binary}) + (exception.report + ["Pseudo hash" (%.text (..encoded data))] + ["Expected size" (%.nat <size>)] + ["Actual size" (%.nat (binary.size data))]))] + + [not_a_sha-1 ..sha-1::size] + [not_a_md5 ..md5::size] + ) + + (template [<name> <kind> <size> <exception>] + [(def: .public (<name> data) + (-> Binary (Try (Hash <kind>))) + (if (n.= <size> (binary.size data)) + (#try.Success (:abstraction data)) + (exception.except <exception> [data])))] + + [as_sha-1 SHA-1 ..sha-1::size ..not_a_sha-1] + [as_md5 MD5 ..md5::size ..not_a_md5] + ) + + (def: hash_size + (-> Text Nat) + (|>> text.size (n./ ..hex_per_byte))) + + (def: encoding_size + (-> Nat Nat) + (n.* ..hex_per_byte)) + + (def: (decoded size constructor encoded) + (All (_ h) + (-> Nat (-> Binary (Try (Hash h))) + (-> Text (Try (Hash h))))) + (let [hash_size (..hash_size encoded)] + (if (n.= size hash_size) + (loop [input encoded + chunk 0 + output (binary.empty hash_size)] + (let [index (n.* chunk i64.bytes_per_i64)] + (case (text.split_at ..hex_per_chunk input) + (#.Some [head tail]) + (do try.monad + [head (\ n.hex decoded head) + output (binary.write/64! index head output)] + (recur tail (++ chunk) output)) + + #.None + (case (..hash_size input) + 0 (constructor output) + (^template [<size> <write>] + [<size> + (do try.monad + [head (\ n.hex decoded input) + output (<write> index head output)] + (constructor output))]) + ([1 binary.write/8!] + [2 binary.write/16!] + [4 binary.write/32!]) + _ (exception.except ..not_a_hash [(..encoding_size size) encoded]))))) + (exception.except ..not_a_hash [(..encoding_size size) encoded])))) + + (template [<codec> <hash> <nat> <constructor>] + [(implementation: .public <codec> + (Codec Text (Hash <hash>)) + + (def: encoded (|>> :representation ..encoded)) + (def: decoded (..decoded <nat> <constructor>)))] + + [sha-1_codec SHA-1 ..sha-1::size ..as_sha-1] + [md5_codec MD5 ..md5::size ..as_md5] + ) + + (implementation: .public equivalence + (All (_ h) (Equivalence (Hash h))) + + (def: (= reference subject) + (\ binary.equivalence = + (:representation reference) + (:representation subject))))] ) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index b2603fc0d..7616ea1a9 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -28,17 +28,15 @@ (exception: got_wrecked) (actor: counter - {} - Nat - ((on_mail message state self) - (message state self)) + [((on_mail message state self) + (message state self)) - (message: (count! {increment Nat} state self) - Nat - (let [state' (n.+ increment state)] - (async\in (#try.Success [state' state'])))) + (message: (count! {increment Nat} state self) + Nat + (let [state' (n.+ increment state)] + (async\in (#try.Success [state' state']))))] ) (def: (mailed? outcome) diff --git a/stdlib/source/test/lux/type/abstract.lux b/stdlib/source/test/lux/type/abstract.lux index 66bee2f43..9004d7fbe 100644 --- a/stdlib/source/test/lux/type/abstract.lux +++ b/stdlib/source/test/lux/type/abstract.lux @@ -47,71 +47,67 @@ (with_expansions [no_current! (..with_no_active_frames (..current)) no_specific! (..with_no_active_frames (..specific))] (/.abstract: (g!Foo a) - {} - Text - (/.abstract: (g!Bar a) - {} - - Nat + [(/.abstract: (g!Bar a) + Nat - (def: .public test - Test - (<| (_.covering /._) - (_.for [/.abstract:]) - (do random.monad - [expected_foo (random.ascii/lower 5) - expected_bar random.nat] - ($_ _.and - (_.cover [/.:abstraction] - (and (exec (: (g!Foo Text) - (/.:abstraction g!Foo expected_foo)) - true) - (exec (: (g!Bar Text) - (/.:abstraction expected_bar)) - true))) - (_.cover [/.:representation] - (and (|> expected_foo - (/.:abstraction g!Foo) - (: (g!Foo Bit)) - (/.:representation g!Foo) - (text\= expected_foo)) - (|> (/.:abstraction expected_bar) - (: (g!Bar Bit)) - /.:representation - (n.= expected_bar)))) - (_.cover [/.:transmutation] - (and (exec (|> expected_foo - (/.:abstraction g!Foo) - (: (g!Foo .Macro)) - (/.:transmutation g!Foo) - (: (g!Foo .Lux))) - true) - (exec (|> (/.:abstraction expected_bar) - (: (g!Bar .Macro)) - /.:transmutation - (: (g!Bar .Lux))) - true))) - (_.cover [/.^:representation] - (and (let [(/.^:representation g!Foo actual_foo) - (: (g!Foo .Module) - (/.:abstraction g!Foo expected_foo))] - (text\= expected_foo actual_foo)) - (let [(/.^:representation actual_bar) - (: (g!Bar .Module) - (/.:abstraction expected_bar))] - (n.= expected_bar actual_bar)))) - (_.for [/.Frame] - ($_ _.and - (_.cover [/.current] - (text\= (template.text [g!Bar]) - (..current))) - (_.cover [/.specific] - (text\= (template.text [g!Foo]) - (..specific))) - (_.cover [/.no_active_frames] - (and no_current! - no_specific!)) - )) - ))))))))) + [(def: .public test + Test + (<| (_.covering /._) + (_.for [/.abstract:]) + (do random.monad + [expected_foo (random.ascii/lower 5) + expected_bar random.nat] + ($_ _.and + (_.cover [/.:abstraction] + (and (exec (: (g!Foo Text) + (/.:abstraction g!Foo expected_foo)) + true) + (exec (: (g!Bar Text) + (/.:abstraction expected_bar)) + true))) + (_.cover [/.:representation] + (and (|> expected_foo + (/.:abstraction g!Foo) + (: (g!Foo Bit)) + (/.:representation g!Foo) + (text\= expected_foo)) + (|> (/.:abstraction expected_bar) + (: (g!Bar Bit)) + /.:representation + (n.= expected_bar)))) + (_.cover [/.:transmutation] + (and (exec (|> expected_foo + (/.:abstraction g!Foo) + (: (g!Foo .Macro)) + (/.:transmutation g!Foo) + (: (g!Foo .Lux))) + true) + (exec (|> (/.:abstraction expected_bar) + (: (g!Bar .Macro)) + /.:transmutation + (: (g!Bar .Lux))) + true))) + (_.cover [/.^:representation] + (and (let [(/.^:representation g!Foo actual_foo) + (: (g!Foo .Module) + (/.:abstraction g!Foo expected_foo))] + (text\= expected_foo actual_foo)) + (let [(/.^:representation actual_bar) + (: (g!Bar .Module) + (/.:abstraction expected_bar))] + (n.= expected_bar actual_bar)))) + (_.for [/.Frame] + ($_ _.and + (_.cover [/.current] + (text\= (template.text [g!Bar]) + (..current))) + (_.cover [/.specific] + (text\= (template.text [g!Foo]) + (..specific))) + (_.cover [/.no_active_frames] + (and no_current! + no_specific!)) + )) + ))))])])))) |