aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/concatenative.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/concatenative.lux252
1 files changed, 126 insertions, 126 deletions
diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux
index 9451fa111..104dcf593 100644
--- a/stdlib/source/lux/control/concatenative.lux
+++ b/stdlib/source/lux/control/concatenative.lux
@@ -1,4 +1,4 @@
-(;module: [lux #- if loop when
+(.module: [lux #- if loop when
n/+ n/- n/* n// n/% n/= n/< n/<= n/> n/>=
i/+ i/- i/* i// i/% i/= i/< i/<= i/> i/>=
d/+ d/- d/* d// d/% d/= d/< d/<= d/> d/>=
@@ -24,21 +24,21 @@
#top (List Code)})
(def: aliases^
- (s;Syntax (List Alias))
- (|> (p;seq s;local-symbol s;any)
- p;some
- s;record
- (p;default (list))))
+ (s.Syntax (List Alias))
+ (|> (p.seq s.local-symbol s.any)
+ p.some
+ s.record
+ (p.default (list))))
(def: bottom^
- (s;Syntax Nat)
- (s;form (p;after (s;this (` #;Bound)) s;nat)))
+ (s.Syntax Nat)
+ (s.form (p.after (s.this (` #.Bound)) s.nat)))
(def: stack^
- (s;Syntax Stack)
- (p;either (p;seq (p;maybe bottom^)
- (s;tuple (p;some s;any)))
- (p;seq (|> bottom^ (p/map (|>> #;Some)))
+ (s.Syntax Stack)
+ (p.either (p.seq (p.maybe bottom^)
+ (s.tuple (p.some s.any)))
+ (p.seq (|> bottom^ (p/map (|>> #.Some)))
(p/wrap (list)))))
(def: (stack-fold tops bottom)
@@ -50,38 +50,38 @@
(def: (singleton expander)
(-> (Meta (List Code)) (Meta Code))
- (monad;do Monad<Meta>
+ (monad.do Monad<Meta>
[expansion expander]
(case expansion
- (#;Cons singleton #;Nil)
+ (#.Cons singleton #.Nil)
(wrap singleton)
_
- (macro;fail (format "Cannot expand to more than a single AST/Code node:\n"
- (|> expansion (L/map %code) (text;join-with " ")))))))
+ (macro.fail (format "Cannot expand to more than a single AST/Code node:\n"
+ (|> expansion (L/map %code) (text.join-with " ")))))))
(syntax: #export (=> [aliases aliases^]
[inputs stack^]
[outputs stack^])
(let [de-alias (function [aliased]
(L/fold (function [[from to] pre]
- (code;replace (code;local-symbol from) to pre))
+ (code.replace (code.local-symbol from) to pre))
aliased
aliases))]
- (case [(|> inputs (get@ #bottom) (m/map (|>> code;nat (~) #;Bound (`))))
- (|> outputs (get@ #bottom) (m/map (|>> code;nat (~) #;Bound (`))))]
- [(#;Some bottomI) (#;Some bottomO)]
- (monad;do @
- [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) bottomI)))
- outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) bottomO)))]
+ (case [(|> inputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`))))
+ (|> outputs (get@ #bottom) (m/map (|>> code.nat (~) #.Bound (`))))]
+ [(#.Some bottomI) (#.Some bottomO)]
+ (monad.do @
+ [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) bottomI)))
+ outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) bottomO)))]
(wrap (list (` (-> (~ (de-alias inputC))
(~ (de-alias outputC)))))))
[?bottomI ?bottomO]
(with-gensyms [g!stack]
- (monad;do @
- [inputC (singleton (macro;expand-all (stack-fold (get@ #top inputs) (maybe;default g!stack ?bottomI))))
- outputC (singleton (macro;expand-all (stack-fold (get@ #top outputs) (maybe;default g!stack ?bottomO))))]
+ (monad.do @
+ [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI))))
+ outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))]
(wrap (list (` (All [(~ g!stack)]
(-> (~ (de-alias inputC))
(~ (de-alias outputC))))))))))))
@@ -96,35 +96,35 @@
(def: (prepare command)
(-> Code Code)
(case command
- (^or [_ (#;Bool _)]
- [_ (#;Nat _)] [_ (#;Int _)]
- [_ (#;Deg _)] [_ (#;Frac _)]
- [_ (#;Text _)]
- [_ (#;Tag _)] (^ [_ (#;Form (list [_ (#;Tag _)]))]))
- (` (;;push (~ command)))
+ (^or [_ (#.Bool _)]
+ [_ (#.Nat _)] [_ (#.Int _)]
+ [_ (#.Deg _)] [_ (#.Frac _)]
+ [_ (#.Text _)]
+ [_ (#.Tag _)] (^ [_ (#.Form (list [_ (#.Tag _)]))]))
+ (` (..push (~ command)))
- [_ (#;Tuple block)]
- (` (;;push (|>> (~@ (L/map prepare block)))))
+ [_ (#.Tuple block)]
+ (` (..push (|>> (~@ (L/map prepare block)))))
_
command))
-(syntax: #export (||> [commands (p;some s;any)])
- (wrap (list (` (|> ;;begin! (~@ (L/map prepare commands)) ;;end!)))))
+(syntax: #export (||> [commands (p.some s.any)])
+ (wrap (list (` (|> ..begin! (~@ (L/map prepare commands)) ..end!)))))
-(syntax: #export (word: [export csr;export] [name s;local-symbol]
- [annotations (p;default cs;empty-annotations csr;annotations)]
+(syntax: #export (word: [export csr.export] [name s.local-symbol]
+ [annotations (p.default cs.empty-annotations csr.annotations)]
type
- [commands (p;some s;any)])
- (wrap (list (` (def: (~@ (csw;export export)) (~ (code;local-symbol name))
- (~ (csw;annotations annotations))
+ [commands (p.some s.any)])
+ (wrap (list (` (def: (~@ (csw.export export)) (~ (code.local-symbol name))
+ (~ (csw.annotations annotations))
(~ type)
(|>> (~@ (L/map prepare commands))))))))
-(syntax: #export (apply [arity (|> s;nat (p;filter (;n/> +0)))])
+(syntax: #export (apply [arity (|> s.nat (p.filter (.n/> +0)))])
(with-gensyms [g!func g!stack g!output]
- (monad;do @
- [g!inputs (|> (macro;gensym "input") (list;repeat arity) (monad;seq @))]
+ (monad.do @
+ [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))]
(wrap (list (` (: (All [(~@ g!inputs) (~ g!output)]
(-> (-> (~@ g!inputs) (~ g!output))
(=> [(~@ g!inputs)] [(~ g!output)])))
@@ -198,133 +198,133 @@
(function [[[stack subject] param]]
[stack (<func> param subject)]))]
- [Nat Nat n/+ ;n/+]
- [Nat Nat n/- ;n/-]
- [Nat Nat n/* ;n/*]
- [Nat Nat n// ;n//]
- [Nat Nat n/% ;n/%]
- [Nat Bool n/= ;n/=]
- [Nat Bool n/< ;n/<]
- [Nat Bool n/<= ;n/<=]
- [Nat Bool n/> ;n/>]
- [Nat Bool n/>= ;n/>=]
-
- [Int Int i/+ ;i/+]
- [Int Int i/- ;i/-]
- [Int Int i/* ;i/*]
- [Int Int i// ;i//]
- [Int Int i/% ;i/%]
- [Int Bool i/= ;i/=]
- [Int Bool i/< ;i/<]
- [Int Bool i/<= ;i/<=]
- [Int Bool i/> ;i/>]
- [Int Bool i/>= ;i/>=]
-
- [Deg Deg d/+ ;d/+]
- [Deg Deg d/- ;d/-]
- [Deg Deg d/* ;d/*]
- [Deg Deg d// ;d//]
- [Deg Deg d/% ;d/%]
- [Deg Bool d/= ;d/=]
- [Deg Bool d/< ;d/<]
- [Deg Bool d/<= ;d/<=]
- [Deg Bool d/> ;d/>]
- [Deg Bool d/>= ;d/>=]
-
- [Frac Frac f/+ ;f/+]
- [Frac Frac f/- ;f/-]
- [Frac Frac f/* ;f/*]
- [Frac Frac f// ;f//]
- [Frac Frac f/% ;f/%]
- [Frac Bool f/= ;f/=]
- [Frac Bool f/< ;f/<]
- [Frac Bool f/<= ;f/<=]
- [Frac Bool f/> ;f/>]
- [Frac Bool f/>= ;f/>=]
+ [Nat Nat n/+ .n/+]
+ [Nat Nat n/- .n/-]
+ [Nat Nat n/* .n/*]
+ [Nat Nat n// .n//]
+ [Nat Nat n/% .n/%]
+ [Nat Bool n/= .n/=]
+ [Nat Bool n/< .n/<]
+ [Nat Bool n/<= .n/<=]
+ [Nat Bool n/> .n/>]
+ [Nat Bool n/>= .n/>=]
+
+ [Int Int i/+ .i/+]
+ [Int Int i/- .i/-]
+ [Int Int i/* .i/*]
+ [Int Int i// .i//]
+ [Int Int i/% .i/%]
+ [Int Bool i/= .i/=]
+ [Int Bool i/< .i/<]
+ [Int Bool i/<= .i/<=]
+ [Int Bool i/> .i/>]
+ [Int Bool i/>= .i/>=]
+
+ [Deg Deg d/+ .d/+]
+ [Deg Deg d/- .d/-]
+ [Deg Deg d/* .d/*]
+ [Deg Deg d// .d//]
+ [Deg Deg d/% .d/%]
+ [Deg Bool d/= .d/=]
+ [Deg Bool d/< .d/<]
+ [Deg Bool d/<= .d/<=]
+ [Deg Bool d/> .d/>]
+ [Deg Bool d/>= .d/>=]
+
+ [Frac Frac f/+ .f/+]
+ [Frac Frac f/- .f/-]
+ [Frac Frac f/* .f/*]
+ [Frac Frac f// .f//]
+ [Frac Frac f/% .f/%]
+ [Frac Bool f/= .f/=]
+ [Frac Bool f/< .f/<]
+ [Frac Bool f/<= .f/<=]
+ [Frac Bool f/> .f/>]
+ [Frac Bool f/>= .f/>=]
)
(def: #export if
- (All [..a ..b]
- (=> {then (=> ..a ..b)
- else (=> ..a ..b)}
- ..a [Bool then else] ..b))
+ (All [__a __b]
+ (=> {then (=> __a __b)
+ else (=> __a __b)}
+ __a [Bool then else] __b))
(function [[[[stack test] then] else]]
- (;if test
+ (.if test
(then stack)
(else stack))))
(def: #export call
- (All [..a ..b]
- (=> {quote (=> ..a ..b)}
- ..a [quote] ..b))
+ (All [__a __b]
+ (=> {quote (=> __a __b)}
+ __a [quote] __b))
(function [[stack block]]
(block stack)))
(def: #export loop
- (All [...]
- (=> {test (=> ... ... [Bool])}
- ... [test] ...))
+ (All [___]
+ (=> {test (=> ___ ___ [Bool])}
+ ___ [test] ___))
(function loop [[stack pred]]
(let [[stack' verdict] (pred stack)]
- (;if verdict
+ (.if verdict
(loop [stack' pred])
stack'))))
(def: #export dip
- (All [... a]
- (=> ... [a (=> ... ...)]
- ... [a]))
+ (All [___ a]
+ (=> ___ [a (=> ___ ___)]
+ ___ [a]))
(function [[[stack a] quote]]
[(quote stack) a]))
(def: #export dip2
- (All [... a b]
- (=> ... [a b (=> ... ...)]
- ... [a b]))
+ (All [___ a b]
+ (=> ___ [a b (=> ___ ___)]
+ ___ [a b]))
(function [[[[stack a] b] quote]]
[[(quote stack) a] b]))
(def: #export do
- (All [..a ..b]
- (=> {pred (=> ..a ..b [Bool])
- body (=> ..b ..a)}
- ..b [pred body]
- ..a [pred body]))
+ (All [__a __b]
+ (=> {pred (=> __a __b [Bool])
+ body (=> __b __a)}
+ __b [pred body]
+ __a [pred body]))
(function [[[stack pred] body]]
[[(body stack) pred] body]))
(def: #export while
- (All [..a ..b]
- (=> {pred (=> ..a ..b [Bool])
- body (=> ..b ..a)}
- ..a [pred body]
- ..b))
+ (All [__a __b]
+ (=> {pred (=> __a __b [Bool])
+ body (=> __b __a)}
+ __a [pred body]
+ __b))
(function while [[[stack pred] body]]
(let [[stack' verdict] (pred stack)]
- (;if verdict
+ (.if verdict
(while [[(body stack') pred] body])
stack'))))
(def: #export compose
- (All [..a ..b ..c]
- (=> [(=> ..a ..b) (=> ..b ..c)]
- [(=> ..a ..c)]))
+ (All [__a __b __c]
+ (=> [(=> __a __b) (=> __b __c)]
+ [(=> __a __c)]))
(function [[[stack f] g]]
[stack (|>> f g)]))
(def: #export curry
- (All [..a ..b a]
- (=> ..a [a (=> ..a [a] ..b)]
- ..a [(=> ..a ..b)]))
+ (All [__a __b a]
+ (=> __a [a (=> __a [a] __b)]
+ __a [(=> __a __b)]))
(function [[[stack arg] quote]]
[stack (|>> (push arg) quote)]))
## [Words]
(word: #export when
- (All [...]
- (=> {body (=> ... ...)}
- ... [Bool body]
- ...))
+ (All [___]
+ (=> {body (=> ___ ___)}
+ ___ [Bool body]
+ ___))
swap [call] [drop] if)
(word: #export ?
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 16:05:05 +0000