diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux.lux | 298 | ||||
| -rw-r--r-- | stdlib/source/lux/control/comonad.lux | 11 | ||||
| -rw-r--r-- | stdlib/source/lux/control/monad.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/data/coll/list.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/io.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/ast.lux | 2 |
6 files changed, 163 insertions, 165 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index cd16ce35f..1c74cac80 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -323,11 +323,11 @@ ## (type: Cursor ## {#module Text -## #line Int -## #column Int}) +## #line Nat +## #column Nat}) (_lux_def Cursor (#NamedT ["lux" "Cursor"] - (#ProdT Text (#ProdT Int Int))) + (#ProdT Text (#ProdT Nat Nat))) (#Cons [["lux" "tags"] (#ListA (#Cons (#TextA "module") (#Cons (#TextA "line") (#Cons (#TextA "column") @@ -673,16 +673,10 @@ default-def-meta-exported)) ## Base functions & macros -## (def: _cursor -## Cursor -## ["" -1 -1]) (_lux_def _cursor - (_lux_: Cursor ["" -1 -1]) + (_lux_: Cursor ["" +0 +0]) #Nil) -## (def: (_meta data) -## (-> (AST' (Meta Cursor)) AST) -## [["" -1 -1] data]) (_lux_def _meta (_lux_: (#LambdaT (#AppT AST' (#AppT Meta Cursor)) @@ -691,11 +685,6 @@ [_cursor data])) #Nil) -## (def: (return x) -## (All [a] -## (-> a Compiler -## (Either Text [Compiler a]))) -## ...) (_lux_def return (_lux_: (#UnivQ #Nil (#LambdaT (#BoundT +1) @@ -708,11 +697,6 @@ (#Right state val)))) #Nil) -## (def: (fail msg) -## (All [a] -## (-> Text Compiler -## (Either Text [Compiler a]))) -## ...) (_lux_def fail (_lux_: (#UnivQ #Nil (#LambdaT Text @@ -1044,7 +1028,7 @@ (def:'' (Text/= x y) #Nil (#LambdaT Text (#LambdaT Text Bool)) - (_lux_proc ["jvm" "invokevirtual:java.lang.Object:equals:java.lang.Object"] [x y])) + (_lux_proc ["text" "="] [x y])) (def:'' (get-rep key env) #Nil @@ -1157,7 +1141,7 @@ #Nil (#UnivQ #Nil (#LambdaT ($' List (#BoundT +1)) Int)) - (fold (lambda'' [_ acc] (_lux_proc ["jvm" "ladd"] [1 acc])) 0 list)) + (fold (lambda'' [_ acc] (_lux_proc ["int" "+"] [1 acc])) 0 list)) (macro:' #export (All tokens) (#Cons [["lux" "doc"] (#TextA "## Universal quantification. @@ -1469,7 +1453,7 @@ (def:''' (wrap-meta content) #Nil (-> AST AST) - (tuple$ (list (tuple$ (list (text$ "") (int$ -1) (int$ -1))) + (tuple$ (list (tuple$ (list (text$ "") (nat$ +0) (nat$ +0))) content))) (def:''' (untemplate-list tokens) @@ -1685,7 +1669,7 @@ (def:''' (Text/append x y) #Nil (-> Text Text Text) - (_lux_proc ["jvm" "invokevirtual:java.lang.String:concat:java.lang.String"] [x y])) + (_lux_proc ["text" "append"] [x y])) (def:''' (Ident/encode ident) #Nil @@ -1931,12 +1915,12 @@ (macro:' #export (|> tokens) (list [["lux" "doc"] (#TextA "## Piping macro. - (|> elems (map ->Text) (interpose \" \") (fold Text/append \"\")) + (|> elems (map Int/encode) (interpose \" \") (fold Text/append \"\")) ## => (fold Text/append \"\" (interpose \" \" - (map ->Text elems)))")]) + (map Int/encode elems)))")]) (_lux_case tokens (#Cons [init apps]) (return (list (fold (_lux_: (-> AST AST AST) @@ -1958,12 +1942,12 @@ (macro:' #export (<| tokens) (list [["lux" "doc"] (#TextA "## Reverse piping macro. - (<| (fold Text/append \"\") (interpose \" \") (map ->Text) elems) + (<| (fold Text/append \"\") (interpose \" \") (map Int/encode) elems) ## => (fold Text/append \"\" (interpose \" \" - (map ->Text elems)))")]) + (map Int/encode elems)))")]) (_lux_case (reverse tokens) (#Cons [init apps]) (return (list (fold (_lux_: (-> AST AST AST) @@ -2077,12 +2061,46 @@ (def:''' (i= x y) #Nil (-> Int Int Bool) - (_lux_proc ["jvm" "leq"] [x y])) + (_lux_proc ["int" "="] [x y])) -(def:''' (->Text x) +(def:''' (Bool/encode x) #Nil - (-> (host java.lang.Object) Text) - (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x])) + (-> Bool Text) + (if x "true" "false")) + +(def:''' (Nat/encode x) + #Nil + (-> Nat Text) + (_lux_proc ["nat" "encode"] [x])) + +(def:''' (Int/encode x) + #Nil + (-> Int Text) + (_lux_proc ["int" "encode"] [x])) + +(def:''' (Deg/encode x) + #Nil + (-> Deg Text) + (_lux_proc ["deg" "encode"] [x])) + +(def:''' (Real/encode x) + #Nil + (-> Real Text) + (_lux_proc ["real" "encode"] [x])) + +(def:''' (Char/encode x) + #Nil + (-> Char Text) + (let' [as-text (_lux_case x + #"\t" "\\t" + #"\b" "\\b" + #"\n" "\\n" + #"\r" "\\r" + #"\f" "\\f" + #"\"" "\\\"" + #"\\" "\\\\" + _ (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))] + ($_ Text/append "#\"" as-text "\""))) (macro:' #export (do-template tokens) (list [["lux" "doc"] (#TextA "## By specifying a pattern (with holes), and the input data to fill those holes, repeats the pattern as many times as necessary. @@ -2105,7 +2123,7 @@ (|> data' (join-map (. apply (make-env bindings'))) return) - (fail (Text/append "Irregular arguments vectors for do-template. Expected size " (->Text num-bindings))))) + (fail (Text/append "Irregular arguments vectors for do-template. Expected size " (Int/encode num-bindings))))) _ (fail "Wrong syntax for do-template")) @@ -2113,47 +2131,47 @@ _ (fail "Wrong syntax for do-template"))) -(do-template [<type> <category> <=-name> <=> <lt-name> <lte-name> <lt> <gt-name> <gte-name> +(do-template [<type> <category> <=-name> <lt-name> <lte-name> <gt-name> <gte-name> <eq-doc> <<-doc> <<=-doc> <>-doc> <>=-doc>] [(def:''' #export (<=-name> test subject) (list [["lux" "doc"] (#TextA <eq-doc>)]) (-> <type> <type> Bool) - (_lux_proc [<category> <=>] [subject test])) + (_lux_proc [<category> "="] [subject test])) (def:''' #export (<lt-name> test subject) (list [["lux" "doc"] (#TextA <<-doc>)]) (-> <type> <type> Bool) - (_lux_proc [<category> <lt>] [subject test])) + (_lux_proc [<category> "<"] [subject test])) (def:''' #export (<lte-name> test subject) (list [["lux" "doc"] (#TextA <<=-doc>)]) (-> <type> <type> Bool) - (if (_lux_proc [<category> <lt>] [subject test]) + (if (_lux_proc [<category> "<"] [subject test]) true - (_lux_proc [<category> <=>] [subject test]))) + (_lux_proc [<category> "="] [subject test]))) (def:''' #export (<gt-name> test subject) (list [["lux" "doc"] (#TextA <>-doc>)]) (-> <type> <type> Bool) - (_lux_proc [<category> <lt>] [test subject])) + (_lux_proc [<category> "<"] [test subject])) (def:''' #export (<gte-name> test subject) (list [["lux" "doc"] (#TextA <>=-doc>)]) (-> <type> <type> Bool) - (if (_lux_proc [<category> <lt>] [test subject]) + (if (_lux_proc [<category> "<"] [test subject]) true - (_lux_proc [<category> <=>] [subject test])))] + (_lux_proc [<category> "="] [subject test])))] - [ Nat "nat" n.= "=" n.< n.<= "<" n.> n.>= + [ Nat "nat" n.= n.< n.<= n.> n.>= "Natural equality." "Natural less-than." "Natural less-than-equal." "Natural greater-than." "Natural greater-than-equal."] - [ Int "jvm" i.= "leq" i.< i.<= "llt" i.> i.>= + [ Int "int" i.= i.< i.<= i.> i.>= "Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."] - [Deg "deg" d.= "=" d.< d.<= "<" d.> d.>= + [ Deg "deg" d.= d.< d.<= d.> d.>= "Degree equality." "Degree less-than." "Degree less-than-equal." "Degree greater-than." "Degree greater-than-equal."] - [Real "jvm" r.= "deq" r.< r.<= "dlt" r.> r.>= + [Real "real" r.= r.< r.<= r.> r.>= "Real equality." "Real less-than." "Real less-than-equal." "Real greater-than." "Real greater-than-equal."] ) @@ -2163,29 +2181,29 @@ (-> <type> <type> <type>) (_lux_proc <op> [subject param]))] - [ Nat n.+ ["nat" "+"] "Nat(ural) addition."] - [ Nat n.- ["nat" "-"] "Nat(ural) substraction."] - [ Nat n.* ["nat" "*"] "Nat(ural) multiplication."] - [ Nat n./ ["nat" "/"] "Nat(ural) division."] - [ Nat n.% ["nat" "%"] "Nat(ural) remainder."] + [ Nat n.+ [ "nat" "+"] "Nat(ural) addition."] + [ Nat n.- [ "nat" "-"] "Nat(ural) substraction."] + [ Nat n.* [ "nat" "*"] "Nat(ural) multiplication."] + [ Nat n./ [ "nat" "/"] "Nat(ural) division."] + [ Nat n.% [ "nat" "%"] "Nat(ural) remainder."] - [ Int i.+ ["jvm" "ladd"] "Int(eger) addition."] - [ Int i.- ["jvm" "lsub"] "Int(eger) substraction."] - [ Int i.* ["jvm" "lmul"] "Int(eger) multiplication."] - [ Int i./ ["jvm" "ldiv"] "Int(eger) division."] - [ Int i.% ["jvm" "lrem"] "Int(eger) remainder."] - - [Deg d.+ ["deg" "+"] "Deg(ree) addition."] - [Deg d.- ["deg" "-"] "Deg(ree) substraction."] - [Deg d.* ["deg" "*"] "Deg(ree) multiplication."] - [Deg d./ ["deg" "/"] "Deg(ree) division."] - [Deg d.% ["deg" "%"] "Deg(ree) remainder."] + [ Int i.+ [ "int" "+"] "Int(eger) addition."] + [ Int i.- [ "int" "-"] "Int(eger) substraction."] + [ Int i.* [ "int" "*"] "Int(eger) multiplication."] + [ Int i./ [ "int" "/"] "Int(eger) division."] + [ Int i.% [ "int" "%"] "Int(eger) remainder."] + + [ Deg d.+ [ "deg" "+"] "Deg(ree) addition."] + [ Deg d.- [ "deg" "-"] "Deg(ree) substraction."] + [ Deg d.* [ "deg" "*"] "Deg(ree) multiplication."] + [ Deg d./ [ "deg" "/"] "Deg(ree) division."] + [ Deg d.% [ "deg" "%"] "Deg(ree) remainder."] - [Real r.+ ["jvm" "dadd"] "Real addition."] - [Real r.- ["jvm" "dsub"] "Real substraction."] - [Real r.* ["jvm" "dmul"] "Real multiplication."] - [Real r./ ["jvm" "ddiv"] "Real division."] - [Real r.% ["jvm" "drem"] "Real remainder."] + [Real r.+ ["real" "+"] "Real addition."] + [Real r.- ["real" "-"] "Real substraction."] + [Real r.* ["real" "*"] "Real multiplication."] + [Real r./ ["real" "/"] "Real division."] + [Real r.% ["real" "%"] "Real remainder."] ) (do-template [<name> <type> <test> <doc>] @@ -2196,14 +2214,14 @@ left right))] - [n.min Nat n.< "Nat(ural) minimum."] - [n.max Nat n.> "Nat(ural) maximum."] + [n.min Nat n.< "Nat(ural) minimum."] + [n.max Nat n.> "Nat(ural) maximum."] - [i.min Int i.< "Int(eger) minimum."] - [i.max Int i.> "Int(eger) maximum."] + [i.min Int i.< "Int(eger) minimum."] + [i.max Int i.> "Int(eger) maximum."] - [d.min Deg d.< "Deg(ree) minimum."] - [d.max Deg d.> "Deg(ree) maximum."] + [d.min Deg d.< "Deg(ree) minimum."] + [d.max Deg d.> "Deg(ree) maximum."] [r.min Real r.< "Real minimum."] [r.max Real r.> "Real minimum."] @@ -2530,16 +2548,16 @@ (-> Text ($' Lux AST)) (_lux_case state {#info info #source source #modules modules - #scopes scopes #type-vars types #host host + #scopes scopes #type-vars types #host host #seed seed #expected expected #cursor cursor #scope-type-vars scope-type-vars #catching catching} (#Right {#info info #source source #modules modules - #scopes scopes #type-vars types #host host + #scopes scopes #type-vars types #host host #seed (n.+ +1 seed) #expected expected #cursor cursor #scope-type-vars scope-type-vars #catching catching} - (symbol$ ["" ($_ Text/append "__gensym__" prefix (->Text seed))])))) + (symbol$ ["" ($_ Text/append "__gensym__" prefix (Nat/encode seed))])))) (macro:' #export (Rec tokens) (list [["lux" "doc"] (#TextA "## Parameter-less recursive types. @@ -2622,36 +2640,26 @@ (let' [[left right] pair] (list left right))) -(def:''' (Nat->Text x) - #Nil - (-> Nat Text) - (_lux_proc ["nat" "encode"] [x])) - -(def:''' (Deg->Text x) - #Nil - (-> Deg Text) - (_lux_proc ["deg" "encode"] [x])) - (def:' (ast-to-text ast) (-> AST Text) (_lux_case ast [_ (#BoolS value)] - (->Text value) + (Bool/encode value) [_ (#NatS value)] - (Nat->Text value) + (Nat/encode value) [_ (#IntS value)] - (->Text value) + (Int/encode value) [_ (#DegS value)] - (Deg->Text value) + (Deg/encode value) [_ (#RealS value)] - (->Text value) + (Real/encode value) [_ (#CharS value)] - ($_ Text/append "#" "\"" (->Text value) "\"") + ($_ Text/append "#" "\"" (Char/encode value) "\"") [_ (#TextS value)] ($_ Text/append "\"" value "\"") @@ -4158,13 +4166,13 @@ ($_ Text/append "(-> " (|> (flatten-lambda type) (map Type/show) (interpose " ") reverse (fold Text/append "")) ")") (#BoundT id) - (Nat->Text id) + (Nat/encode id) (#VarT id) - ($_ Text/append "⌈v:" (->Text id) "⌋") + ($_ Text/append "⌈v:" (Nat/encode id) "⌋") (#ExT id) - ($_ Text/append "⟨e:" (->Text id) "⟩") + ($_ Text/append "⟨e:" (Nat/encode id) "⟩") (#UnivQ env body) ($_ Text/append "(All " (Type/show body) ")") @@ -4354,12 +4362,12 @@ (macro: #export (|>. tokens) {#;doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. - (|> (map ->Text) (interpose \" \") (fold Text/append \"\")) + (|> (map Int/encode) (interpose \" \") (fold Text/append \"\")) ## => (lambda [<something>] (fold Text/append \"\" (interpose \" \" - (map ->Text <something>))))"} + (map Int/encode <something>))))"} (do Monad<Lux> [g!arg (gensym "arg")] (return (list (` (lambda [(~ g!arg)] (|> (~ g!arg) (~@ tokens)))))))) @@ -4379,7 +4387,7 @@ (default 20 #;None) => 20"} (case tokens (^ (list else maybe)) - (let [g!temp (: AST [["" -1 -1] (#;SymbolS ["" ""])]) + (let [g!temp (: AST [_cursor (#;SymbolS ["" ""])]) code (` (case (~ maybe) (#;Some (~ g!temp)) (~ g!temp) @@ -4793,7 +4801,7 @@ ) (def: (find-baseline-column ast) - (-> AST Int) + (-> AST Nat) (case ast (^template [<tag>] [[_ _ column] (<tag> _)] @@ -4810,12 +4818,12 @@ (^template [<tag>] [[_ _ column] (<tag> parts)] - (fold i.min column (map find-baseline-column parts))) + (fold n.min column (map find-baseline-column parts))) ([#FormS] [#TupleS]) [[_ _ column] (#RecordS pairs)] - (fold i.min column + (fold n.min column (List/append (map (. find-baseline-column first) pairs) (map (. find-baseline-column second) pairs))) )) @@ -4833,19 +4841,6 @@ _ (#Doc-Example ast))) -(def: (Char/encode x) - (-> Char Text) - (let [as-text (case x - #"\t" "\\t" - #"\b" "\\b" - #"\n" "\\n" - #"\r" "\\r" - #"\f" "\\f" - #"\"" "\\\"" - #"\\" "\\\\" - _ (_lux_proc ["jvm" "invokevirtual:java.lang.Object:toString:"] [x]))] - ($_ Text/append "#\"" as-text "\""))) - (def: (Text/encode original) (-> Text Text) (let [escaped (|> original @@ -4865,16 +4860,28 @@ (-> <type> <type>) (<op> <one> value))] - [i.inc i.+ 1 Int "Increment function."] - [i.dec i.- 1 Int "Decrement function."] - [n.inc n.+ +1 Nat "Increment function."] - [n.dec n.- +1 Nat "Decrement function."] + [i.inc i.+ 1 Int "[Int] Increment function."] + [i.dec i.- 1 Int "[Int] Decrement function."] + [n.inc n.+ +1 Nat "[Nat] Increment function."] + [n.dec n.- +1 Nat "[Nat] Decrement function."] ) -(def: tag->Text +(def: Tag/encode (-> Ident Text) (. (Text/append "#") Ident/encode)) +(do-template [<name> <op> <from> <to>] + [(def: #export (<name> input) + (-> <from> <to>) + (_lux_proc <op> [input]))] + + [int-to-nat ["int" "to-nat"] Int Nat] + [nat-to-int ["nat" "to-int"] Nat Int] + + [real-to-deg ["real" "to-deg"] Real Deg] + [deg-to-real ["deg" "to-real"] Deg Real] + ) + (def: (repeat n x) (All [a] (-> Int a (List a))) (if (i.> 0 n) @@ -4882,17 +4889,18 @@ #;Nil)) (def: (cursor-padding baseline [_ old-line old-column] [_ new-line new-column]) - (-> Int Cursor Cursor Text) - (if (i.= old-line new-line) - (Text/join (repeat (i.- old-column new-column) " ")) - (let [extra-lines (Text/join (repeat (i.- old-line new-line) "\n")) - space-padding (Text/join (repeat (i.- baseline new-column) " "))] + (-> Nat Cursor Cursor Text) + (if (n.= old-line new-line) + (Text/join (repeat (nat-to-int (n.- old-column new-column)) " ")) + (let [extra-lines (Text/join (repeat (nat-to-int (n.- old-line new-line)) "\n")) + space-padding (Text/join (repeat (nat-to-int (n.- baseline new-column)) " "))] (Text/append extra-lines space-padding)))) (def: (Text/size x) - (-> Text Int) - (_lux_proc ["jvm" "i2l"] - [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])])) + (-> Text Nat) + (:! Nat + (_lux_proc ["jvm" "i2l"] + [(_lux_proc ["jvm" "invokevirtual:java.lang.String:length:"] [x])]))) (def: (Text/trim x) (-> Text Text) @@ -4900,18 +4908,18 @@ (def: (update-cursor [file line column] ast-text) (-> Cursor Text Cursor) - [file line (i.+ column (Text/size ast-text))]) + [file line (n.+ column (Text/size ast-text))]) (def: (delim-update-cursor [file line column]) (-> Cursor Cursor) - [file line (i.inc column)]) + [file line (n.inc column)]) (def: rejoin-all-pairs (-> (List [AST AST]) (List AST)) (. List/join (map rejoin-pair))) (def: (doc-example->Text prev-cursor baseline example) - (-> Cursor Int AST [Cursor Text]) + (-> Cursor Nat AST [Cursor Text]) (case example (^template [<tag> <show>] [new-cursor (<tag> value)] @@ -4919,15 +4927,15 @@ [(update-cursor new-cursor as-text) (Text/append (cursor-padding baseline prev-cursor new-cursor) as-text)])) - ([#BoolS ->Text] - [#NatS Nat->Text] - [#IntS ->Text] - [#DegS Deg->Text] - [#RealS ->Text] + ([#BoolS Bool/encode] + [#NatS Nat/encode] + [#IntS Int/encode] + [#DegS Deg/encode] + [#RealS Real/encode] [#CharS Char/encode] [#TextS Text/encode] [#SymbolS Ident/encode] - [#TagS tag->Text]) + [#TagS Tag/encode]) (^template [<tag> <open> <close> <prep>] [group-cursor (<tag> parts)] @@ -4947,7 +4955,7 @@ )) (def: (with-baseline baseline [file line column]) - (-> Int Cursor Cursor) + (-> Nat Cursor Cursor) [file line baseline]) (def: (doc-fragment->Text fragment) @@ -5166,7 +5174,7 @@ (compare <text> (:: AST/encode show <expr>)) (compare true (:: Eq<AST> = <expr> <expr>))] - [(bool true) "true" [["" -1 -1] (#;BoolS true)]] + [(bool true) "true" [_ (#;BoolS true)]] [(bool false) "false" [_ (#;BoolS false)]] [(int 123) "123" [_ (#;IntS 123)]] [(real 123.0) "123.0" [_ (#;RealS 123.0)]] @@ -5447,7 +5455,7 @@ (wrap (list (` (#ExT (~ (nat$ var-id)))))) #;None - (fail (Text/append "Indexed-type doesn't exist: " (->Text idx))))) + (fail (Text/append "Indexed-type doesn't exist: " (Nat/encode idx))))) _ (fail "Wrong syntax for $"))) @@ -5537,7 +5545,7 @@ (do Monad<Lux> [cursor get-cursor] (let [[module line column] cursor - cursor-prefix ($_ hack_Text/append "[" module "," (->Text line) "," (->Text column) "] ")] + cursor-prefix ($_ hack_Text/append "[" module "," (Nat/encode line) "," (Nat/encode column) "] ")] (wrap (list (` (hack_Text/append (~ (text$ cursor-prefix)) (~ message))))))) _ @@ -5591,18 +5599,6 @@ _ (fail "Wrong syntax for @post"))) -(do-template [<name> <op> <from> <to>] - [(def: #export (<name> input) - (-> <from> <to>) - (_lux_proc <op> [input]))] - - [int-to-nat ["int" "to-nat"] Int Nat] - [nat-to-int ["nat" "to-int"] Nat Int] - - [real-to-deg ["real" "to-deg"] Real Deg] - [deg-to-real ["deg" "to-real"] Deg Real] - ) - (macro: #export (type-of tokens) {#;doc (doc "Generates the type corresponding to a given definition or variable." (let [my-num (: Int 123)] diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux index f78ffea17..5ed443040 100644 --- a/stdlib/source/lux/control/comonad.lux +++ b/stdlib/source/lux/control/comonad.lux @@ -18,6 +18,8 @@ split)) ## [Syntax] +(def: _cursor Cursor ["" +0 +0]) + (macro: #export (be tokens state) {#;doc (doc "A co-monadic parallel to the \"do\" macro." (let [square (lambda [n] (i.* n n))] @@ -26,9 +28,8 @@ (square (head inputs)))))} (case tokens (#;Cons comonad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil))) - (let [g!@ (: AST [["" -1 -1] (#;SymbolS ["" "@"])]) - g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])]) - g!split (: AST [["" -1 -1] (#;SymbolS ["" " split "])]) + (let [g!map (: AST [_cursor (#;SymbolS ["" " map "])]) + g!split (: AST [_cursor (#;SymbolS ["" " split "])]) body' (fold (: (-> [AST AST] AST AST) (lambda [binding body'] (let [[var value] binding] @@ -42,8 +43,8 @@ body (reverse (as-pairs bindings)))] (#;Right [state (#;Cons (` (;_lux_case (~ comonad) - (~ g!@) - (;_lux_case (~ g!@) + (~' @) + (;_lux_case (~' @) {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)} (~ body')))) #;Nil)])) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index 5c540791a..a6d0d5988 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -49,6 +49,8 @@ join)) ## [Syntax] +(def: _cursor Cursor ["" +0 +0]) + (macro: #export (do tokens state) {#;doc (doc "Macro for easy concatenation of monadic operations." (do Monad<Maybe> @@ -57,10 +59,9 @@ (wrap (f3 z))))} (case tokens (#;Cons monad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil))) - (let [g!@ (: AST [["" -1 -1] (#;SymbolS ["" "@"])]) - g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])]) - g!join (: AST [["" -1 -1] (#;SymbolS ["" " join "])]) - g!apply (: AST [["" -1 -1] (#;SymbolS ["" " apply "])]) + (let [g!map (: AST [_cursor (#;SymbolS ["" " map "])]) + g!join (: AST [_cursor (#;SymbolS ["" " join "])]) + g!apply (: AST [_cursor (#;SymbolS ["" " apply "])]) body' (fold (: (-> [AST AST] AST AST) (lambda [binding body'] (let [[var value] binding] @@ -74,8 +75,8 @@ body (reverse (as-pairs bindings)))] (#;Right [state (#;Cons (` (;_lux_case (~ monad) - (~ g!@) - (;_lux_case (~ g!@) + (~' @) + (;_lux_case (~' @) {#applicative {#A;functor {#F;map (~ g!map)} #A;wrap (~' wrap) #A;apply (~ g!apply)} diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 4d9d9c270..5f2ef3984 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -335,7 +335,7 @@ ## [Syntax] (def: (symbol$ name) (-> Text AST) - [["" -1 -1] (#;SymbolS "" name)]) + [["" +0 +0] (#;SymbolS "" name)]) (macro: #export (zip tokens state) {#;doc (doc "Create list zippers with the specified number of input lists." diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 93c01ee85..8a9e6bb9e 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -19,7 +19,7 @@ "Some value...")))} (case tokens (^ (list value)) - (let [blank (: AST [["" -1 -1] (#;SymbolS ["" ""])])] + (let [blank (: AST [["" +0 +0] (#;SymbolS ["" ""])])] (#;Right [state (list (` (;_lux_lambda (~ blank) (~ blank) (~ value))))])) _ diff --git a/stdlib/source/lux/macro/ast.lux b/stdlib/source/lux/macro/ast.lux index 49d68b5c3..6647307dd 100644 --- a/stdlib/source/lux/macro/ast.lux +++ b/stdlib/source/lux/macro/ast.lux @@ -27,7 +27,7 @@ ## (Meta Cursor (AST' (Meta Cursor)))) ## [Utils] -(def: _cursor Cursor ["" -1 -1]) +(def: _cursor Cursor ["" +0 +0]) ## [Functions] (do-template [<name> <type> <tag>] |