aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library
diff options
context:
space:
mode:
authorEduardo Julian2022-06-13 07:40:50 -0400
committerEduardo Julian2022-06-13 07:40:50 -0400
commit63dec2e80905100ae2b48ada1d4e0d675338d00f (patch)
treea8e7d90610288ca417dccb000ea8fa8dc1221132 /stdlib/source/library
parent289f9de576a7980184339f380d5000f7d71f6d7e (diff)
De-sigil-ification: suffix : [Part 7]
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/control/concatenative.lux195
-rw-r--r--stdlib/source/library/lux/data/format/css/value.lux126
2 files changed, 140 insertions, 181 deletions
diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux
index 9bd9d2355..4661a546e 100644
--- a/stdlib/source/library/lux/control/concatenative.lux
+++ b/stdlib/source/library/lux/control/concatenative.lux
@@ -1,21 +1,22 @@
(.using
[library
- [lux (.except Alias if loop)
+ [lux (.except Alias if loop left right)
["[0]" meta]
+ ["[0]" type]
[abstract
["[0]" monad]]
[control
["[0]" maybe (.open: "[1]#[0]" monad)]]
[data
+ ["[0]" product]
["[0]" text (.only)
["%" \\format (.only format)]]
[collection
["[0]" list (.open: "[1]#[0]" mix functor)]]]
["[0]" macro (.only with_symbols)
+ [syntax (.only syntax)]
["[0]" code]
- ["[0]" template]
- [syntax (.only syntax)
- ["|[0]|" export]]]
+ ["[0]" template]]
[math
[number
["n" nat]
@@ -26,111 +27,55 @@
["<>" parser (.open: "[1]#[0]" monad)
["<[0]>" code (.only Parser)]]])
-(type: Alias
- [Text Code])
-
(type: Stack
(Record
[#bottom (Maybe Code)
#top (List Code)]))
-(def: aliases^
- (Parser (List Alias))
- (|> (<>.and <code>.local <code>.any)
- <>.some
- <code>.tuple))
-
-(def: top^
+(def: top
(Parser (List Code))
(<code>.tuple (<>.some <code>.any)))
-(def: bottom^
+(def: bottom
(Parser Code)
- (<code>.not ..top^))
+ (<code>.not ..top))
-(def: stack^
+(def: stack
(Parser Stack)
- (<>.either (<>.and (<>.maybe bottom^)
- ..top^)
- (<>.and (<>#each (|>> {.#Some}) bottom^)
+ (<>.either (<>.and (<>.maybe bottom)
+ ..top)
+ (<>.and (<>#each (|>> {.#Some}) bottom)
(<>#in (list)))))
-(def: (stack_mix tops bottom)
+(def: (stack_type tops bottom)
(-> (List Code) Code Code)
(list#mix (function (_ top bottom)
(` [(~ bottom) (~ top)]))
bottom
tops))
-(def: (singleton expander)
- (-> (Meta (List Code)) (Meta Code))
- (monad.do meta.monad
- [expansion expander]
- (case expansion
- {.#Item singleton {.#End}}
- (in singleton)
-
- _
- (meta.failure (format "Cannot expand to more than a single AST/Code node:" text.new_line
- (|> expansion (list#each %.code) (text.interposed " ")))))))
-
-(def: signature^
- (Parser [(List Alias) Stack Stack])
- (<>.either (all <>.and aliases^ stack^ stack^)
- (all <>.and (<>#in (list)) stack^ stack^)))
-
(def: .public =>
- (syntax (_ [[aliases inputs outputs] signature^])
- (let [de_alias (function (_ aliased)
- (list#mix (function (_ [from to] pre)
- (code.replaced (code.local from) to pre))
- aliased
- aliases))]
- (case [(the #bottom inputs)
- (the #bottom outputs)]
- [{.#Some bottomI} {.#Some bottomO}]
- (monad.do meta.monad
- [inputC (singleton (macro.full_expansion (stack_mix (the #top inputs) bottomI)))
- outputC (singleton (macro.full_expansion (stack_mix (the #top outputs) bottomO)))]
- (in (list (` (-> (~ (de_alias inputC))
- (~ (de_alias outputC)))))))
-
- [?bottomI ?bottomO]
- (with_symbols [g!stack]
- (monad.do meta.monad
- [inputC (singleton (macro.full_expansion (stack_mix (the #top inputs) (maybe.else g!stack ?bottomI))))
- outputC (singleton (macro.full_expansion (stack_mix (the #top outputs) (maybe.else g!stack ?bottomO))))]
- (with_symbols [g!_]
- (in (list (` (All ((~ g!_) (~ g!stack))
- (-> (~ (de_alias inputC))
- (~ (de_alias outputC))))))))))))))
-
-(def: beginning
- Any
- [])
-
-(def: end
- (All (_ a) (-> [Any a] a))
- (function (_ [_ top])
- top))
-
-(def: .public ||>
- (syntax (_ [commands (<>.some <code>.any)])
- (in (list (` (|> (~! ..beginning) (~+ commands) ((~! ..end))))))))
-
-(def: word
- (Parser [Code Text Code (List Code)])
- (|export|.parser
- (all <>.and
- <code>.local
- <code>.any
- (<>.many <code>.any))))
-
-(def: .public word:
- (syntax (_ [[export_policy name type commands] ..word])
- (in (list (` (def: (~ export_policy) (~ (code.local name))
- (~ type)
- (|>> (~+ commands))))))))
+ (syntax (_ [inputs stack
+ outputs stack])
+ (with_symbols [g!_ common_bottom]
+ (let [input_bottom (maybe.else common_bottom (the #bottom inputs))
+ output_bottom (maybe.else common_bottom (the #bottom outputs))
+ input_stack (stack_type (the #top inputs) input_bottom)
+ output_stack (stack_type (the #top outputs) output_bottom)]
+ (in (list (.if (or (same? common_bottom input_bottom)
+ (same? common_bottom output_bottom))
+ (` (All ((~ g!_) (~ common_bottom))
+ (-> (~ input_stack)
+ (~ output_stack))))
+ (` (-> (~ input_stack)
+ (~ output_stack))))))))))
+
+(def: .public (value it)
+ (All (_ ,,, a)
+ (-> (=> []
+ ,,, [a])
+ a))
+ (|> [] it product.right))
(def: .public apply
(syntax (_ [arity (<>.only (n.> 0) <code>.nat)])
@@ -141,7 +86,7 @@
(-> (-> (~+ g!inputs) (~ g!output))
(=> [(~+ g!inputs)] [(~ g!output)])))
(function ((~ g!_) (~ g!func))
- (function ((~ g!_) (~ (stack_mix g!inputs g!stack)))
+ (function ((~ g!_) (~ (stack_type g!inputs g!stack)))
[(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))))
(with_template [<arity>]
@@ -177,12 +122,12 @@
(function (_ [[stack l] r])
[[stack r] l]))
-(def: .public rotL
+(def: .public left_rotation
(All (_ a b c) (=> [a b c] [b c a]))
(function (_ [[[stack a] b] c])
[[[stack b] c] a]))
-(def: .public rotR
+(def: .public right_rotation
(All (_ a b c) (=> [a b c] [c a b]))
(function (_ [[[stack a] b] c])
[[[stack c] a] b]))
@@ -192,12 +137,12 @@
(function (_ [[stack l] r])
[stack [l r]]))
-(def: .public ||L
+(def: .public left
(All (_ a b) (=> [a] [(Or a b)]))
(function (_ [stack l])
[stack {0 #0 l}]))
-(def: .public ||R
+(def: .public right
(All (_ a b) (=> [b] [(Or a b)]))
(function (_ [stack r])
[stack {0 #1 r}]))
@@ -255,9 +200,10 @@
(def: .public if
(All (_ ,,,0 ,,,1)
- (=> [then (=> ,,,0 ,,,1)
- else (=> ,,,0 ,,,1)]
- ,,,0 [Bit then else] ,,,1))
+ (type.let [then (=> ,,,0 ,,,1)
+ else (=> ,,,0 ,,,1)]
+ (=> ,,,0 [Bit then else]
+ ,,,1)))
(function (_ [[[stack test] then] else])
(.if test
(then stack)
@@ -265,15 +211,18 @@
(def: .public call
(All (_ ,,,0 ,,,1)
- (=> [quote (=> ,,,0 ,,,1)]
- ,,,0 [quote] ,,,1))
+ (type.let [quote (=> ,,,0 ,,,1)]
+ (=> ,,,0 [quote]
+ ,,,1)))
(function (_ [stack quote])
(quote stack)))
(def: .public loop
(All (_ ,,,)
- (=> [test (=> ,,, ,,, [Bit])]
- ,,, [test] ,,,))
+ (type.let [test (=> ,,,
+ ,,, [Bit])]
+ (=> ,,, [test]
+ ,,,)))
(function (loop [stack pred])
(let [[stack' verdict] (pred stack)]
(.if verdict
@@ -296,19 +245,19 @@
(def: .public do
(All (_ ,,,0 ,,,1)
- (=> [body (=> ,,,0 ,,,1)
- pred (=> ,,,1 ,,,0 [Bit])]
- ,,,0 [pred body]
- ,,,1 [pred body]))
+ (type.let [body (=> ,,,0 ,,,1)
+ pred (=> ,,,1 ,,,0 [Bit])]
+ (=> ,,,0 [pred body]
+ ,,,1 [pred body])))
(function (_ [[stack pred] body])
[[(body stack) pred] body]))
(def: .public while
(All (_ ,,,0 ,,,1)
- (=> [body (=> ,,,1 ,,,0)
- pred (=> ,,,0 ,,,1 [Bit])]
- ,,,0 [pred body]
- ,,,1))
+ (type.let [body (=> ,,,1 ,,,0)
+ pred (=> ,,,0 ,,,1 [Bit])]
+ (=> ,,,0 [pred body]
+ ,,,1)))
(function (while [[stack pred] body])
(let [[stack' verdict] (pred stack)]
(.if verdict
@@ -329,20 +278,20 @@
(function (_ [[stack arg] quote])
[stack (|>> (push arg) quote)]))
-(word: .public when
+(def: .public when
(All (_ ,,,)
- (=> [body (=> ,,, ,,,)]
- ,,, [Bit body]
- ,,,))
- swap
- (push ..call)
- (push ..drop)
- if)
-
-(word: .public ?
+ (type.let [body (=> ,,, ,,,)]
+ (=> ,,, [Bit body]
+ ,,,)))
+ (|>> swap
+ (push ..call)
+ (push ..drop)
+ if))
+
+(def: .public ?
(All (_ a)
(=> [Bit a a] [a]))
- rotL
- (push ..drop)
- (push ..nip)
- if)
+ (|>> left_rotation
+ (push ..drop)
+ (push ..nip)
+ if))
diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/data/format/css/value.lux
index ad27c40b7..79636d63a 100644
--- a/stdlib/source/library/lux/data/format/css/value.lux
+++ b/stdlib/source/library/lux/data/format/css/value.lux
@@ -33,8 +33,8 @@
(syntax (_ [symbol <code>.text])
(in (list (code.local (text.replaced "-" "_" symbol))))))
-(def: enumeration:
- (template (enumeration: <abstraction> <representation> <out> <sample>+ <definition>+)
+(def: enumeration
+ (template (_ <abstraction> <representation> <out> <sample>+ <definition>+)
[(primitive: .public <abstraction>
<representation>
@@ -793,11 +793,13 @@
(format name)
abstraction))
- (enumeration: Step Text
- step
- [[start "start"]
- [end "end"]]
- [])
+ (enumeration
+ Step
+ Text
+ step
+ [[start "start"]
+ [end "end"]]
+ [])
(def: .public (steps intervals step)
(-> Nat Step (Value Timing))
@@ -1055,19 +1057,23 @@
(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"]]
- [])
+ (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"]]
+ [])
(with_template [<name> <function>]
[(def: .public (<name> shape extent location start next)
@@ -1142,28 +1148,30 @@
(-> 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))])
+ (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))
@@ -1212,22 +1220,24 @@
(-> 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))])
+ (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 " ")