diff options
Diffstat (limited to 'stdlib/source/library')
85 files changed, 10624 insertions, 10623 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index e3635595a..c275d546f 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -67,131 +67,131 @@ (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}))))) ) ) @@ -233,10 +233,9 @@ (def: behavior^ (Parser BehaviorC) - (<code>.tuple - ($_ <>.and - ..on_mail^ - (<>.some <code>.any)))) + ($_ <>.and + ..on_mail^ + (<>.some <code>.any))) (def: (on_mail g!_ ?on_mail) (-> Code (Maybe On_MailC) Code) @@ -268,13 +267,13 @@ (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>.tuple (<>.and <code>.any <code>.any)) ?on_mail on_mail^]) diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux index 6e38aff6f..477870a86 100644 --- a/stdlib/source/library/lux/control/concurrency/async.lux +++ b/stdlib/source/library/lux/control/concurrency/async.lux @@ -20,62 +20,62 @@ (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 091273281..6241c90c7 100644 --- a/stdlib/source/library/lux/control/concurrency/atom.lux +++ b/stdlib/source/library/lux/control/concurrency/atom.lux @@ -52,30 +52,30 @@ @.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 755e201ff..1a0ef82f9 100644 --- a/stdlib/source/library/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/library/lux/control/concurrency/semaphore.lux @@ -33,89 +33,89 @@ (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 @@ -131,41 +131,41 @@ #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) - (do async.monad - [outcome (..signal! turnstile)] - (recur (++ step))) - (\ async.monad in [])))) - - (template [<phase> <update> <goal> <turnstile>] - [(def: (<phase> (^:representation barrier)) - (-> Barrier (Async Any)) + (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 - [.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)))] + [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))) ) diff --git a/stdlib/source/library/lux/control/concurrency/stm.lux b/stdlib/source/library/lux/control/concurrency/stm.lux index 722a2f78f..6e468b90a 100644 --- a/stdlib/source/library/lux/control/concurrency/stm.lux +++ b/stdlib/source/library/lux/control/concurrency/stm.lux @@ -26,51 +26,51 @@ (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 654415bd3..158a11eeb 100644 --- a/stdlib/source/library/lux/control/io.lux +++ b/stdlib/source/library/lux/control/io.lux @@ -17,50 +17,50 @@ (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 baedf1354..5819243a4 100644 --- a/stdlib/source/library/lux/control/lazy.lux +++ b/stdlib/source/library/lux/control/lazy.lux @@ -20,23 +20,23 @@ (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 4bdab69c1..2a49f4b51 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -26,44 +26,44 @@ (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 [forger input output]] - (|export|.parser - ($_ <>.and - |declaration|.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 [forger input output]] + (|export|.parser + ($_ <>.and + |declaration|.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 f0a55bdd4..7b15e4210 100644 --- a/stdlib/source/library/lux/control/security/policy.lux +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -11,83 +11,83 @@ (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 ec49d9a1a..f0e1223a4 100644 --- a/stdlib/source/library/lux/control/thread.lux +++ b/stdlib/source/library/lux/control/thread.lux @@ -20,38 +20,38 @@ (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 6e56b4b1c..d277ec515 100644 --- a/stdlib/source/library/lux/data/collection/queue/priority.lux +++ b/stdlib/source/library/lux/data/collection/queue/priority.lux @@ -40,86 +40,86 @@ (abstract: .public (Queue a) (Maybe (Tree :@: Priority a)) - [(def: .public empty - Queue - (:abstraction #.None)) - - (def: .public (front queue) - (All (_ a) (-> (Queue a) (Maybe 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 (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} + [tree (:representation queue) + .let [highest_priority (tree.tag 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 - (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)}))))] + (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 89baa8935..2d4c3975b 100644 --- a/stdlib/source/library/lux/data/collection/set/multi.lux +++ b/stdlib/source/library/lux/data/collection/set/multi.lux @@ -21,118 +21,118 @@ (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 - 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 + (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) - (..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)))))] + (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))))) ) (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 a3bd77830..72344d090 100644 --- a/stdlib/source/library/lux/data/collection/set/ordered.lux +++ b/stdlib/source/library/lux/data/collection/set/ordered.lux @@ -15,63 +15,63 @@ (abstract: .public (Set a) (/.Dictionary a a) - [(def: .public empty - (All (_ a) (-> (Order a) (Set a))) - (|>> /.empty :abstraction)) + (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)) + (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>))] + (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?] - ) + [(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 (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 (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 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 (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 (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 (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))))) + (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))))] + (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 87925a89a..e90d53f84 100644 --- a/stdlib/source/library/lux/data/collection/stack.lux +++ b/stdlib/source/library/lux/data/collection/stack.lux @@ -13,54 +13,54 @@ (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 c5fc655e8..5cef4d130 100644 --- a/stdlib/source/library/lux/data/collection/tree/finger.lux +++ b/stdlib/source/library/lux/data/collection/tree/finger.lux @@ -18,87 +18,87 @@ #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 f396b712a..52581fbc8 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -57,84 +57,84 @@ (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 e0c1d1773..488ccba64 100644 --- a/stdlib/source/library/lux/data/format/css.lux +++ b/stdlib/source/library/lux/data/format/css.lux @@ -22,112 +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 (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 css + (-> (CSS Any) Text) + (|>> :representation)) + + (def: .public empty + (CSS Common) + (:abstraction "")) - (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 (rule selector style) + (-> (Selector Any) Style (CSS Common)) + (:abstraction (format (/selector.selector selector) "{" (/style.inline style) "}"))) - (template [<name> <combinator>] - [(def: .public <name> - (-> (Selector Any) Style (CSS Common) (CSS Common)) - (..dependent <combinator>))] + (def: .public char_set + (-> Encoding (CSS Special)) + (|>> encoding.name + %.text + (text.enclosed ["@charset " ";"]) + :abstraction)) - [with_descendants /selector.in] - [with_children /selector.sub] - )] + (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] + ) ) diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/data/format/css/property.lux index 27c5a880c..ea9ca5a93 100644 --- a/stdlib/source/library/lux/data/format/css/property.lux +++ b/stdlib/source/library/lux/data/format/css/property.lux @@ -58,446 +58,446 @@ (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 fe4c8f7d4..21058fea9 100644 --- a/stdlib/source/library/lux/data/format/css/query.lux +++ b/stdlib/source/library/lux/data/format/css/query.lux @@ -27,109 +27,109 @@ (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 38eda4881..0ad018e6c 100644 --- a/stdlib/source/library/lux/data/format/css/selector.lux +++ b/stdlib/source/library/lux/data/format/css/selector.lux @@ -19,188 +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 + (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 (text.enclosed ["(" ")"]) - (format ":lang") + (format ":not") :abstraction)) - (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))))) + (abstract: .public Index + Text + + (def: .public index + (-> Nat Index) + (|>> %.nat :abstraction)) + + (template [<name> <index>] + [(def: .public <name> Index (:abstraction <index>))] - (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"] - )] - )] + [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"] + ) + ) ) diff --git a/stdlib/source/library/lux/data/format/css/style.lux b/stdlib/source/library/lux/data/format/css/style.lux index 37b80b4ce..b41d9c9b7 100644 --- a/stdlib/source/library/lux/data/format/css/style.lux +++ b/stdlib/source/library/lux/data/format/css/style.lux @@ -13,22 +13,22 @@ (abstract: .public Style 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 1d5fe95df..25b09fb71 100644 --- a/stdlib/source/library/lux/data/format/css/value.lux +++ b/stdlib/source/library/lux/data/format/css/value.lux @@ -35,17 +35,17 @@ (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,1269 +64,1269 @@ (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) + (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))))) - - (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) + (%.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) + + (def: .public (degree value) + (-> Nat Angle) + (:abstraction (format (%.nat (n.% ..degree_limit value)) "deg"))) + + (template [<degree> <name>] + [(def: .public <name> + Angle + (..degree <degree>))] - (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 " ") + [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 (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 - (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 " ") + (..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) :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) - :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 " ")] + (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 7e1a7e322..72ec3e7a1 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -82,492 +82,492 @@ (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 - :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) + (template [<name> <brand>] + [(abstract: <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: (<super_raw> brand) Any) + (type: .public <super> (HTML (<super_raw> Any))) + + (`` (template [<sub> <sub_raw>] + [(abstract: <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 - 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 ">")] - )] + 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 b04f60806..8f64a70f0 100644 --- a/stdlib/source/library/lux/data/format/markdown.lux +++ b/stdlib/source/library/lux/data/format/markdown.lux @@ -31,170 +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)) - - ... A snippet of code. - (def: .public snippet - (-> Text (Markdown Span)) - (|>> (text.enclosed ["`` " " ``"]) :abstraction)) - - ... A (generic) block of code. - (def: .public generic_code - (-> Text (Markdown Block)) - (let [open (format "```" text.new_line) - close (format text.new_line "```")] - (|>> (text.enclosed [open close]) ..block))) - - ... A block of code of a specific language. - (def: .public (code language block) - (-> 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)) + + ... A snippet of code. + (def: .public snippet + (-> Text (Markdown Span)) + (|>> (text.enclosed ["`` " " ``"]) :abstraction)) + + ... A (generic) block of code. + (def: .public generic_code + (-> Text (Markdown Block)) + (let [open (format "```" text.new_line) + close (format text.new_line "```")] + (|>> (text.enclosed [open close]) ..block))) + + ... A block of code of a specific language. + (def: .public (code language block) + (-> 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 ec7b997e9..c33250527 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -73,31 +73,31 @@ (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 @@ -157,55 +157,55 @@ (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 @@ -247,53 +247,53 @@ [(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] @@ -305,31 +305,32 @@ (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) @@ -391,131 +392,131 @@ (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 @@ -527,19 +528,19 @@ (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 b8955f732..50d78c021 100644 --- a/stdlib/source/library/lux/data/text/buffer.lux +++ b/stdlib/source/library/lux/data/text/buffer.lux @@ -55,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)) + (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)) (function (_ array) (exec - (JS_Array::push [chunk] array) + (table/insert [array chunk]) array)))] (:abstraction [(n.+ (//.size chunk) capacity) - (|>> 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)))) + (|>> 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 3b6dff526..9ab4e3325 100644 --- a/stdlib/source/library/lux/data/text/encoding.lux +++ b/stdlib/source/library/lux/data/text/encoding.lux @@ -10,157 +10,157 @@ (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 bca01c5ee..5abc56ffc 100644 --- a/stdlib/source/library/lux/data/text/unicode/block.lux +++ b/stdlib/source/library/lux/data/text/unicode/block.lux @@ -17,45 +17,45 @@ (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 32a05b3a4..3ee3dfb49 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -29,208 +29,208 @@ (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 (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 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))))))] + (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 57f346903..b827c962f 100644 --- a/stdlib/source/library/lux/ffi.js.lux +++ b/stdlib/source/library/lux/ffi.js.lux @@ -22,15 +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 8760b35f0..ab6437d36 100644 --- a/stdlib/source/library/lux/ffi.lua.lux +++ b/stdlib/source/library/lux/ffi.lua.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: <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 ae8e4b347..f39cd314a 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 ccee694ae..fafac379e 100644 --- a/stdlib/source/library/lux/ffi.py.lux +++ b/stdlib/source/library/lux/ffi.py.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: <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 c2d06bb78..d025b4b23 100644 --- a/stdlib/source/library/lux/ffi.rb.lux +++ b/stdlib/source/library/lux/ffi.rb.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: <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 18800df0a..5d78822f3 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 e0ac8bce0..09c5e9add 100644 --- a/stdlib/source/library/lux/locale.lux +++ b/stdlib/source/library/lux/locale.lux @@ -19,28 +19,28 @@ (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 f8314c376..7082755cd 100644 --- a/stdlib/source/library/lux/locale/language.lux +++ b/stdlib/source/library/lux/locale/language.lux @@ -17,558 +17,558 @@ [#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 ded9f2110..130565353 100644 --- a/stdlib/source/library/lux/locale/territory.lux +++ b/stdlib/source/library/lux/locale/territory.lux @@ -19,295 +19,295 @@ #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 e82f222cc..fe9ab2bf9 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -32,112 +32,112 @@ [#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 0d3c4fb7f..c94cbde14 100644 --- a/stdlib/source/library/lux/math/modulus.lux +++ b/stdlib/source/library/lux/math/modulus.lux @@ -23,27 +23,27 @@ (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 (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 divisor + (All (_ %) (-> (Modulus %) Int)) + (|>> :representation)) - (def: .public (= reference subject) - (All (_ %r %s) (-> (Modulus %r) (Modulus %s) Bit)) - (i.= (:representation reference) - (:representation subject))) + (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 (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 1a14f8d6e..253896c2f 100644 --- a/stdlib/source/library/lux/target/common_lisp.lux +++ b/stdlib/source/library/lux/target/common_lisp.lux @@ -23,446 +23,446 @@ (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]) - :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 + (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: 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>)))] + (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)" - (~~ (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>))))] + (f.not_a_number? value) + "(/ 0.0d0 0.0d0)" - (~~ (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 + ... 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 - 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 _} + (|> 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))) ) (def: .public (while condition body) diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux index 662f0c3a4..1519e639b 100644 --- a/stdlib/source/library/lux/target/js.lux +++ b/stdlib/source/library/lux/target/js.lux @@ -31,388 +31,388 @@ (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") - :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)) + (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 (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 + (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: .public (then pre post) - (-> Statement Statement Statement) - (:abstraction (format (:representation pre) - text.new_line - (:representation post)))) + (def: argument_separator ", ") + (def: field_separator ": ") + (def: statement_suffix ";") - (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) - " ") + (def: .public array + (-> (List Expression) Computation) + (|>> (list\each ..code) + (text.interposed ..argument_separator) + ..element :abstraction)) - (def: .public (function name inputs body) - (-> Var (List Var) Statement Computation) - (|> (..function! name inputs body) - :representation + (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 ["{" "}"]) ..expression :abstraction)) - (def: .public (closure inputs body) - (-> (List Var) Statement Computation) - (|> body - ..block - (format "function" - (|> inputs - (list\each ..code) - (text.interposed ..argument_separator) - ..expression) - " ") + (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>] + [... A 32-bit integer expression. + (def: .public (<name> value) + (-> <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)) - (template [<name> <op>] - [(def: .public (<name> param subject) - (-> Expression Expression Computation) - (|> (format (:representation subject) " " <op> " " (:representation param)) - ..expression + (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))] - [= "==="] - [< "<"] - [<= "<="] - [> ">"] - [>= ">="] - - [+ "+"] - [- "-"] - [* "*"] - [/ "/"] - [% "%"] - - [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>] - [... A 32-bit integer expression. - (def: .public (<name> value) - (-> <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 (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 2908238d5..73239ffd2 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/address.lux @@ -26,49 +26,49 @@ (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 13f9343a7..506e041be 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 @@ -31,61 +31,61 @@ (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 1118c3b22..c6c132a8c 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 @@ -20,49 +20,49 @@ (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 646278f35..c43e5ed0b 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -237,22 +237,23 @@ (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 27efe496d..51517ff74 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -44,23 +44,23 @@ (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,46 +86,46 @@ (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 b774dfd4e..73ff384f4 100644 --- a/stdlib/source/library/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/library/lux/target/jvm/constant/tag.lux @@ -17,34 +17,34 @@ (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 390b7c95c..c7776612a 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/name.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/name.lux @@ -16,21 +16,21 @@ (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 5d4f124a6..1e7e57721 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/signed.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/signed.lux @@ -25,83 +25,83 @@ (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: <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 097265bcf..804374a4e 100644 --- a/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/library/lux/target/jvm/encoding/unsigned.lux @@ -24,98 +24,98 @@ (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: .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: &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] - )] + (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 cdf27baba..361514578 100644 --- a/stdlib/source/library/lux/target/jvm/index.lux +++ b/stdlib/source/library/lux/target/jvm/index.lux @@ -18,21 +18,21 @@ (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 48c0697d9..c37bb039b 100644 --- a/stdlib/source/library/lux/target/jvm/modifier.lux +++ b/stdlib/source/library/lux/target/jvm/modifier.lux @@ -26,56 +26,56 @@ (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 6327fefa8..8456668bb 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 e3ec58a89..3a3235a7c 100644 --- a/stdlib/source/library/lux/target/jvm/type.lux +++ b/stdlib/source/library/lux/target/jvm/type.lux @@ -30,165 +30,165 @@ (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)))) + (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 (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 - (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)))] + [(/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 2f7a2eed6..6d4b73aa2 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 7d7d4e7fe..677c7b801 100644 --- a/stdlib/source/library/lux/target/jvm/type/descriptor.lux +++ b/stdlib/source/library/lux/target/jvm/type/descriptor.lux @@ -24,101 +24,101 @@ (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 d144ac6fe..ee5734d6d 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 ce31cbbcc..a3a101f12 100644 --- a/stdlib/source/library/lux/target/jvm/type/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/type/reflection.lux @@ -18,87 +18,87 @@ (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 86663ce49..b0a2c0303 100644 --- a/stdlib/source/library/lux/target/jvm/type/signature.lux +++ b/stdlib/source/library/lux/target/jvm/type/signature.lux @@ -21,141 +21,141 @@ (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 bf36d301e..6e1f1ee98 100644 --- a/stdlib/source/library/lux/target/lua.lux +++ b/stdlib/source/library/lux/target/lua.lux @@ -38,328 +38,328 @@ (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) - (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) + (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) - (text.enclosed ["(" ")"]) - (format (:representation func)) :abstraction)) - (def: .public (do method args table) - (-> Text (List Expression) Expression Computation) - (|> args - (list\each ..code) + (def: .public array + (-> (List Expression) Literal) + (|>> (list\each ..code) (text.interposed ..input_separator) - (text.enclosed ["(" ")"]) - (format (:representation table) ":" method) + (text.enclosed ["{" "}"]) :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 ["(" ")"]) + (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)) - (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 (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)))) ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux index dd205862f..79272dd3e 100644 --- a/stdlib/source/library/lux/target/php.lux +++ b/stdlib/source/library/lux/target/php.lux @@ -46,493 +46,493 @@ (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) - :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)) + (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)) - ... 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))) + (def: .public var + (-> Text Var) + (|>> (format "$") :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)) + (template [<name> <type>] + [(def: .public <name> + (-> Text <type>) + (|>> :abstraction))] - (def: .public (array_merge/+ required optionals) - (-> Expression (List Expression) Computation) - (..apply/* (list& required optionals) (..constant "array_merge"))) + [constant Constant] + [label 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 (set_label label) + (-> Label Statement) + (:abstraction (format (:representation label) ":"))) - (def: .public (new constructor inputs) - (-> Constant (List Expression) Computation) - (|> (format "new " (:representation constructor) (arguments inputs)) - :abstraction)) + (def: .public (go_to label) + (-> Label Statement) + (:abstraction + (format "goto " (:representation label) ..statement_suffix))) - (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 null + Literal + (:abstraction "NULL")) - (def: .public (item idx array) - (-> Expression Expression Access) - (|> (format (:representation array) "[" (:representation idx) "]") + (def: .public bool + (-> Bit Literal) + (|>> (case> #0 "false" + #1 "true") :abstraction)) - (def: .public (global name) - (-> Text Global) - (|> (..var "GLOBALS") (..item (..string name)) :transmutation)) + (def: .public int + (-> Int Literal) + (.let [to_hex (\ n.hex encoded)] + (|>> .nat + to_hex + (format "0x") + :abstraction))) - (def: .public (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (..group (:representation test)) " ? " - (..group (:representation then)) " : " - (..group (:representation else))) - ..group + (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)) - (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 + (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 (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: 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 (cond clauses else!) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index a649fbcf1..1a9796a44 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -50,403 +50,403 @@ (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) + (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)) (<| :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)) - (<| :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))] + (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 "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 <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)))) ) (def: .public (cond clauses else!) diff --git a/stdlib/source/library/lux/target/r.lux b/stdlib/source/library/lux/target/r.lux index 323b8c4bb..4de9c2966 100644 --- a/stdlib/source/library/lux/target/r.lux +++ b/stdlib/source/library/lux/target/r.lux @@ -25,362 +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) - (..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 ", "))] + (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 "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 (: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)))) ) diff --git a/stdlib/source/library/lux/target/ruby.lux b/stdlib/source/library/lux/target/ruby.lux index 85a3c92c3..f4f967335 100644 --- a/stdlib/source/library/lux/target/ruby.lux +++ b/stdlib/source/library/lux/target/ruby.lux @@ -38,387 +38,387 @@ (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") - :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)) + (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: .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)) + (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 (apply_lambda/* args lambda) - (-> (List Expression) Expression Computation) - (|> args - (list\each (|>> :representation)) + (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)) (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)) + (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 (? test then else) - (-> Expression Expression Expression Computation) - (|> (format (:representation test) " ? " - (:representation then) " : " - (:representation else)) - (text.enclosed ["(" ")"]) + (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) :abstraction)) - (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 (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 390a43867..692e903bc 100644 --- a/stdlib/source/library/lux/target/scheme.lux +++ b/stdlib/source/library/lux/target/scheme.lux @@ -29,353 +29,353 @@ (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 f87a8f6f6..743516d24 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -79,70 +79,70 @@ (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 7053a71e1..52742572d 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -75,70 +75,70 @@ #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 = - (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 < + (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)) - (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)))))))))] + (\ //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))))))))) ) (def: section_parser diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux index d0c044d39..fd4a728f2 100644 --- a/stdlib/source/library/lux/time/duration.lux +++ b/stdlib/source/library/lux/time/duration.lux @@ -26,62 +26,62 @@ (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 57063a5a0..d5ffcdb7e 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -35,53 +35,53 @@ (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 9b69e84d6..cff485bde 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -38,19 +38,19 @@ (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 value - (-> Year Int) - (|>> :representation ..external)) - - (def: .public epoch - Year - (:abstraction +1970))] + (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 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 83bbc51e9..0f1f5ef2c 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -79,208 +79,208 @@ [#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 - :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 + (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 [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) + (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 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 - 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 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 6c2662602..75753c473 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -44,123 +44,123 @@ [#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 96d5a9922..d007967f2 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/document.lux @@ -31,44 +31,44 @@ [#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 b31b18353..034e61388 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/key.lux @@ -9,11 +9,11 @@ (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 2b4466d71..51216b293 100644 --- a/stdlib/source/library/lux/type/abstract.lux +++ b/stdlib/source/library/lux/type/abstract.lux @@ -214,7 +214,7 @@ ($_ <>.and ..declaration <code>.any - (<code>.tuple (<>.some <code>.any)) + (<>.some <code>.any) ))) ... TODO: Make sure the generated code always gets optimized away. diff --git a/stdlib/source/library/lux/type/dynamic.lux b/stdlib/source/library/lux/type/dynamic.lux index d766c77a0..412f811ec 100644 --- a/stdlib/source/library/lux/type/dynamic.lux +++ b/stdlib/source/library/lux/type/dynamic.lux @@ -24,31 +24,31 @@ (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 3d0700124..a3a79bfd2 100644 --- a/stdlib/source/library/lux/type/quotient.lux +++ b/stdlib/source/library/lux/type/quotient.lux @@ -14,33 +14,33 @@ (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 bfa951ede..2de171779 100644 --- a/stdlib/source/library/lux/type/refinement.lux +++ b/stdlib/source/library/lux/type/refinement.lux @@ -16,39 +16,39 @@ [#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 d5c209cd7..5c2618263 100644 --- a/stdlib/source/library/lux/type/resource.lux +++ b/stdlib/source/library/lux/type/resource.lux @@ -66,39 +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 494a9e62d..7b60ba1f5 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -29,33 +29,33 @@ (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 a4b94f517..60abb4484 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))) - - ... Only use this function for debugging purposes. - ... Do not use this function to actually execute SQL code. - (def: .public read - (-> (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> " " - (..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) + (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))) + + ... Only use this function for debugging purposes. + ... Do not use this function to actually execute SQL code. + (def: .public read + (-> (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 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) - - _ + (: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)) (: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) - - _ + (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) (: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)) - (: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")] + (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 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))))] + (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 e014fc157..51ac92a90 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -38,47 +38,47 @@ #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 ba7811ed2..fb80bdc86 100644 --- a/stdlib/source/library/lux/world/net/http/mime.lux +++ b/stdlib/source/library/lux/world/net/http/mime.lux @@ -11,13 +11,13 @@ (abstract: .public MIME 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 4858d01f0..5d5604777 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)) |