diff options
Diffstat (limited to 'source')
| -rw-r--r-- | source/lux.lux | 291 | ||||
| -rw-r--r-- | source/lux/codata/function.lux | 4 | ||||
| -rw-r--r-- | source/lux/codata/lazy.lux | 8 | ||||
| -rw-r--r-- | source/lux/codata/reader.lux | 8 | ||||
| -rw-r--r-- | source/lux/codata/state.lux | 8 | ||||
| -rw-r--r-- | source/lux/codata/stream.lux | 8 | ||||
| -rw-r--r-- | source/lux/data/bool.lux | 8 | ||||
| -rw-r--r-- | source/lux/data/char.lux | 4 | ||||
| -rw-r--r-- | source/lux/data/either.lux | 8 | ||||
| -rw-r--r-- | source/lux/data/id.lux | 14 | ||||
| -rw-r--r-- | source/lux/data/io.lux | 8 | ||||
| -rw-r--r-- | source/lux/data/list.lux | 16 | ||||
| -rw-r--r-- | source/lux/data/maybe.lux | 12 | ||||
| -rw-r--r-- | source/lux/data/number/int.lux | 40 | ||||
| -rw-r--r-- | source/lux/data/number/real.lux | 40 | ||||
| -rw-r--r-- | source/lux/data/text.lux | 18 | ||||
| -rw-r--r-- | source/lux/data/writer.lux | 8 | ||||
| -rw-r--r-- | source/lux/meta/lux.lux | 8 | ||||
| -rw-r--r-- | source/lux/meta/syntax.lux | 8 |
19 files changed, 260 insertions, 259 deletions
diff --git a/source/lux.lux b/source/lux.lux index 422fb4fad..3ba8ec897 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -539,9 +539,9 @@ #Nil)))))) #Nil)) - (#Cons [_ (#SymbolS self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))) + (#Cons [_ (#SymbolS "" self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil))) (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda")) - (#Cons (_meta (#SymbolS self)) + (#Cons (_meta (#SymbolS "" self)) (#Cons arg (#Cons (_lux_case args' #Nil @@ -649,26 +649,6 @@ (defmacro #export (comment tokens) (return #Nil)) -(defmacro (->' tokens) - (_lux_case tokens - (#Cons input (#Cons output #Nil)) - (return (#Cons (_meta (#FormS (#Cons (tag$ ["lux" "LambdaT"]) - (#Cons (_meta (#TupleS (#Cons input (#Cons output #Nil)))) - #Nil)))) - #Nil)) - - (#Cons input (#Cons output others)) - (return (#Cons (_meta (#FormS (#Cons (tag$ ["lux" "LambdaT"]) - (#Cons (_meta (#TupleS (#Cons input - (#Cons (_meta (#FormS (#Cons (symbol$ ["lux" "->'"]) - (#Cons output others)))) - #Nil)))) - #Nil)))) - #Nil)) - - _ - (fail "Wrong syntax for ->'"))) - (defmacro ($' tokens) (_lux_case tokens (#Cons x #Nil) @@ -687,7 +667,9 @@ (def'' (map f xs) (#UnivQ #Nil (#UnivQ #Nil - (->' (->' (#BoundT 3) (#BoundT 1)) ($' List (#BoundT 3)) ($' List (#BoundT 1))))) + (#LambdaT (#LambdaT (#BoundT 3) (#BoundT 1)) + (#LambdaT ($' List (#BoundT 3)) + ($' List (#BoundT 1)))))) (_lux_case xs #Nil #Nil @@ -700,7 +682,7 @@ ($' List (#TupleT (#Cons Text (#Cons AST #Nil))))) (def'' (make-env xs ys) - (->' ($' List Text) ($' List AST) RepEnv) + (#LambdaT ($' List Text) (#LambdaT ($' List AST) RepEnv)) (_lux_case (_lux_: (#TupleT (#Cons ($' List Text) (#Cons ($' List AST) #Nil))) [xs ys]) [(#Cons x xs') (#Cons y ys')] @@ -710,12 +692,12 @@ #Nil)) (def'' (text:= x y) - (->' Text Text Bool) + (#LambdaT Text (#LambdaT Text Bool)) (_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"] x [y])) (def'' (get-rep key env) - (->' Text RepEnv ($' Maybe AST)) + (#LambdaT Text (#LambdaT RepEnv ($' Maybe AST))) (_lux_case env #Nil #None @@ -729,7 +711,7 @@ (get-rep key env')))) (def'' (replace-syntax reps syntax) - (->' RepEnv AST AST) + (#LambdaT RepEnv (#LambdaT AST AST)) (_lux_case syntax [_ (#SymbolS "" name)] (_lux_case (get-rep name reps) @@ -746,7 +728,7 @@ [meta (#TupleS (map (replace-syntax reps) members))] [meta (#RecordS slots)] - [meta (#RecordS (map (_lux_: (->' (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil)))) + [meta (#RecordS (map (_lux_: (#LambdaT (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil)))) (lambda'' [slot] (_lux_case slot [k v] @@ -758,7 +740,7 @@ ) (def'' (update-bounds ast) - (->' AST AST) + (#LambdaT AST AST) (_lux_case ast [_ (#BoolS value)] (bool$ value) @@ -785,7 +767,7 @@ (tuple$ (map update-bounds members)) [_ (#RecordS pairs)] - (record$ (map (_lux_: (->' (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil)))) + (record$ (map (_lux_: (#LambdaT (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil)))) (lambda'' [pair] (let'' [name val] pair [name (update-bounds val)]))) @@ -798,32 +780,33 @@ (form$ (map update-bounds members))) ) -(defmacro (All' tokens) - (_lux_case tokens - (#Cons [_ (#TupleS (#Cons [_ (#SymbolS "" arg-name)] other-args))] - (#Cons body #Nil)) - (let'' bound-var (_meta (#FormS (#Cons (tag$ ["lux" "BoundT"]) (#Cons (int$ 1) #Nil)))) - (let'' body' (replace-syntax (#Cons [arg-name bound-var] #Nil) - (update-bounds body)) - (return (#Cons (_meta (#FormS (#Cons (tag$ ["lux" "UnivQ"]) - (#Cons (tag$ ["lux" "Nil"]) - (#Cons (_lux_case other-args - #Nil - body' - - _ - (_meta (#FormS (#Cons (symbol$ ["lux" "All'"]) - (#Cons (_meta (#TupleS other-args)) - (#Cons body' - #Nil)))))) - #Nil))))) - #Nil)))) +(def'' (parse-univq-args args next) + ## (All [a] (-> (List AST) (-> (List Text) (Lux a)) (Lux a))) + (#UnivQ #Nil (#LambdaT ($' List AST) + (#LambdaT (#LambdaT ($' List Text) (#AppT (#AppT StateE Compiler) (#BoundT 1))) + (#AppT (#AppT StateE Compiler) (#BoundT 1))))) + (_lux_case args + #Nil + (next #Nil) + + (#Cons [_ (#SymbolS "" arg-name)] args') + (parse-univq-args args' (lambda'' [names] (next (#Cons arg-name names)))) _ - (fail "Wrong syntax for All'"))) + (fail "Expected symbol."))) + +(def'' (make-bound idx) + (#LambdaT Int AST) + (form$ (#Cons (tag$ ["lux" "BoundT"]) (#Cons (int$ idx) #Nil)))) (def'' (foldL f init xs) - (All' [a b] (->' (->' a b a) a ($' List b) a)) + ## (All [a b] (-> (-> a b a) a (List b) a)) + (#UnivQ #Nil (#UnivQ #Nil (#LambdaT (#LambdaT (#BoundT 3) + (#LambdaT (#BoundT 1) + (#BoundT 3))) + (#LambdaT (#BoundT 3) + (#LambdaT ($' List (#BoundT 1)) + (#BoundT 3)))))) (_lux_case xs #Nil init @@ -831,27 +814,66 @@ (#Cons x xs') (foldL f (f init x) xs'))) +(defmacro #export (All tokens) + (let'' [self-name tokens] (_lux_: (#TupleT (#Cons Text (#Cons ASTList #Nil))) + (_lux_case tokens + (#Cons [_ (#SymbolS "" self-name)] tokens) + [self-name tokens] + + _ + ["" tokens])) + (_lux_case tokens + (#Cons [_ (#TupleS args)] (#Cons body #Nil)) + (parse-univq-args args + (lambda'' [names] + (let'' body' (foldL (_lux_: (#LambdaT AST (#LambdaT Text AST)) + (lambda'' [body' name'] + (form$ (#Cons (tag$ ["lux" "UnivQ"]) + (#Cons (tag$ ["lux" "Nil"]) + (#Cons (replace-syntax (#Cons [name' (make-bound 1)] #Nil) + (update-bounds body')) #Nil)))))) + (replace-syntax (#Cons [self-name (make-bound -2)] #Nil) + body) + names) + (return (#Cons body' #Nil))))) + + _ + (fail "Wrong syntax for All")) + )) + (def'' (reverse list) - (All' [a] (->' ($' List a) ($' List a))) + (All [a] (#LambdaT ($' List a) ($' List a))) (foldL (lambda'' [tail head] (#Cons head tail)) #Nil list)) +(defmacro #export (-> tokens) + (_lux_case (reverse tokens) + (#Cons output inputs) + (return (#Cons (foldL (_lux_: (#LambdaT AST (#LambdaT AST AST)) + (lambda'' [o i] (form$ (#Cons (tag$ ["lux" "LambdaT"]) (#Cons i (#Cons o #Nil)))))) + output + inputs) + #Nil)) + + _ + (fail "Wrong syntax for ->"))) + (defmacro (list xs) - (return (#Cons [(foldL (lambda'' [tail head] - (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"])) - (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])]))) - #Nil])])))) - (_meta (#TagS ["lux" "Nil"])) - (reverse xs)) - #Nil]))) + (return (#Cons (foldL (lambda'' [tail head] + (form$ (#Cons (tag$ ["lux" "Cons"]) + (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])])) + #Nil)))) + (tag$ ["lux" "Nil"]) + (reverse xs)) + #Nil))) (defmacro (list& xs) (_lux_case (reverse xs) - (#Cons [last init]) + (#Cons last init) (return (list (foldL (lambda'' [tail head] - (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"])) - (_meta (#TupleS (list head tail))))))) + (form$ (list (tag$ ["lux" "Cons"]) + (tuple$ (list head tail))))) last init))) @@ -859,13 +881,13 @@ (fail "Wrong syntax for list&"))) (defmacro (lambda' tokens) - (let'' [name tokens'] (_lux_: (#TupleT (list Ident ($' List AST))) + (let'' [name tokens'] (_lux_: (#TupleT (list Text ($' List AST))) (_lux_case tokens - (#Cons [[_ (#SymbolS name)] tokens']) + (#Cons [[_ (#SymbolS ["" name])] tokens']) [name tokens'] _ - [["" ""] tokens])) + ["" tokens])) (_lux_case tokens' (#Cons [[_ (#TupleS args)] (#Cons [body #Nil])]) (_lux_case args @@ -874,7 +896,7 @@ (#Cons [harg targs]) (return (list (form$ (list (symbol$ ["" "_lux_lambda"]) - (symbol$ name) + (symbol$ ["" name]) harg (foldL (lambda'' [body' arg] (form$ (list (symbol$ ["" "_lux_lambda"]) @@ -931,7 +953,7 @@ )) (def''' (as-pairs xs) - (All' [a] (->' ($' List a) ($' List (#TupleT (list a a))))) + (All [a] (-> ($' List a) ($' List (#TupleT (list a a))))) (_lux_case xs (#Cons x (#Cons y xs')) (#Cons [x y] (as-pairs xs')) @@ -942,8 +964,8 @@ (defmacro (let' tokens) (_lux_case tokens (#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])]) - (return (list (foldL (_lux_: (->' AST (#TupleT (list AST AST)) - AST) + (return (list (foldL (_lux_: (-> AST (#TupleT (list AST AST)) + AST) (lambda' [body binding] (_lux_case binding [label value] @@ -955,8 +977,8 @@ (fail "Wrong syntax for let'"))) (def''' (any? p xs) - (All' [a] - (->' (->' a Bool) ($' List a) Bool)) + (All [a] + (-> (-> a Bool) ($' List a) Bool)) (_lux_case xs #Nil false @@ -967,7 +989,7 @@ false (any? p xs')))) (def''' (spliced? token) - (->' AST Bool) + (-> AST Bool) (_lux_case token [_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [_ #Nil])]))] true @@ -976,12 +998,12 @@ false)) (def''' (wrap-meta content) - (->' AST AST) + (-> AST AST) (tuple$ (list (tuple$ (list (text$ "") (int$ -1) (int$ -1))) content))) (def''' (untemplate-list tokens) - (->' ($' List AST) AST) + (-> ($' List AST) AST) (_lux_case tokens #Nil (_meta (#TagS ["lux" "Nil"])) @@ -991,7 +1013,7 @@ (_meta (#TupleS (list token (untemplate-list tokens'))))))))) (def''' #export (list:++ xs ys) - (All' [a] (->' ($' List a) ($' List a) ($' List a))) + (All [a] (-> ($' List a) ($' List a) ($' List a))) (_lux_case xs (#Cons x xs') (#Cons x (list:++ xs' ys)) @@ -1010,7 +1032,7 @@ (fail "Wrong syntax for $"))) (def''' (splice replace? untemplate tag elems) - (->' Bool (->' AST AST) AST ($' List AST) AST) + (-> Bool (-> AST AST) AST ($' List AST) AST) (_lux_case replace? true (_lux_case (any? spliced? elems) @@ -1037,7 +1059,7 @@ (wrap-meta (form$ (list tag (untemplate-list (map untemplate elems))))))) (def''' (untemplate replace? subst token) - (->' Bool Text AST AST) + (-> Bool Text AST AST) (_lux_case (_lux_: (#TupleT (list Bool AST)) [replace? token]) [_ [_ (#BoolS value)]] (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value))))) @@ -1084,7 +1106,7 @@ [_ [_ (#RecordS fields)]] (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) - (untemplate-list (map (_lux_: (->' (#TupleT (list AST AST)) AST) + (untemplate-list (map (_lux_: (-> (#TupleT (list AST AST)) AST) (lambda' [kv] (let' [[k v] kv] (tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v)))))) @@ -1110,7 +1132,7 @@ (defmacro #export (|> tokens) (_lux_case tokens (#Cons [init apps]) - (return (list (foldL (_lux_: (->' AST AST AST) + (return (list (foldL (_lux_: (-> AST AST AST) (lambda' [acc app] (_lux_case app [_ (#TupleS parts)] @@ -1141,8 +1163,8 @@ ## (-> Compiler (Either Text (, Compiler a)))) (def''' #export Lux Type - (All' [a] - (->' Compiler ($' Either Text (#TupleT (list Compiler a)))))) + (All [a] + (-> Compiler ($' Either Text (#TupleT (list Compiler a)))))) ## (defsig (Monad m) ## (: (All [a] (-> a (m a))) @@ -1152,11 +1174,11 @@ (def''' Monad Type (#NamedT ["lux" "Monad"] - (All' [m] - (#TupleT (list (All' [a] (->' a ($' m a))) - (All' [a b] (->' (->' a ($' m b)) - ($' m a) - ($' m b)))))))) + (All [m] + (#TupleT (list (All [a] (-> a ($' m a))) + (All [a b] (-> (-> a ($' m b)) + ($' m a) + ($' m b)))))))) (_lux_declare-tags [#return #bind] Monad) (def''' Maybe/Monad @@ -1196,17 +1218,6 @@ _ (fail "Wrong syntax for ^"))) -(defmacro #export (-> tokens) - (_lux_case (reverse tokens) - (#Cons output inputs) - (return (list (foldL (_lux_: (->' AST AST AST) - (lambda' [o i] (`' (#;LambdaT (~ i) (~ o))))) - output - inputs))) - - _ - (fail "Wrong syntax for ->"))) - (defmacro #export (, tokens) (return (list (`' (#;TupleT (~ (untemplate-list tokens))))))) @@ -1237,11 +1248,11 @@ (def''' (map% m f xs) ## (All [m a b] ## (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) - (All' [m a b] - (-> ($' Monad m) - (-> a ($' m b)) - ($' List a) - ($' m ($' List b)))) + (All [m a b] + (-> ($' Monad m) + (-> a ($' m b)) + ($' List a) + ($' m ($' List b)))) (let' [{#;return wrap #;bind _} m] (_lux_case xs #Nil @@ -1255,8 +1266,8 @@ ))) (def''' (. f g) - (All' [a b c] - (-> (-> b c) (-> a b) (-> a c))) + (All [a b c] + (-> (-> b c) (-> a b) (-> a c))) (lambda' [x] (f (g x)))) @@ -1315,8 +1326,8 @@ template)) (def''' (join-map f xs) - (All' [a b] - (-> (-> a ($' List b)) ($' List a) ($' List b))) + (All [a b] + (-> (-> a ($' List b)) ($' List a) ($' List b))) (_lux_case xs #Nil #Nil @@ -1408,39 +1419,6 @@ (let' [[module name] ident] ($ text:++ module ";" name))) -(def''' (make-bound idx) - (-> Int AST) - (`' (#;BoundT (~ (int$ idx))))) - -(defmacro #export (All tokens) - (let' [[self-name tokens] (_lux_: (, Text ASTList) - (_lux_case tokens - (#Cons [_ (#SymbolS "" self-name)] tokens) - [self-name tokens] - - _ - ["" tokens]))] - (_lux_case tokens - (#Cons [_ (#TupleS (#Cons harg targs))] (#Cons body #Nil)) - (_lux_case (map% Maybe/Monad get-name (#Cons harg targs)) - (#Some names) - (let' [body' (foldL (_lux_: (-> AST Text AST) - (lambda' [body' name'] - (`' (#;UnivQ #;Nil (~ (|> body' - (update-bounds) - (replace-syntax (list [name' (make-bound 1)])))))))) - (replace-syntax (list [self-name (make-bound -2)]) - body) - names)] - (return (list body'))) - - #None - (fail "\"All\" arguments must be symbols.")) - - _ - (fail "Wrong syntax for All")) - )) - (def''' (get k plist) (All [a] (-> Text ($' List (, Text a)) ($' Maybe a))) @@ -1980,7 +1958,7 @@ (\ (list [_ (#TupleS (#Cons head tail))] body)) (#Some ["" ""] head tail body) - (\ (list [_ (#SymbolS [_ name])] [_ (#TupleS (#Cons head tail))] body)) + (\ (list [_ (#SymbolS ["" name])] [_ (#TupleS (#Cons head tail))] body)) (#Some ["" name] head tail body) _ @@ -2379,17 +2357,40 @@ (defmacro #export (struct tokens) (do Lux/Monad - [tokens' (map% Lux/Monad macro-expand tokens)] + [tokens' (map% Lux/Monad macro-expand tokens) + struct-type expected-type + tags+type (resolve-type-tags struct-type) + tags (: (Lux (List Ident)) + (case tags+type + (#Some [tags _]) + (return tags) + + _ + (fail "No tags available for type."))) + #let [tag-mappings (: (List (, Text AST)) + (map (lambda [tag] [(second tag) (tag$ tag)]) + tags))] + _ (: (Lux Unit) + (let [msg ($ text:++ "struct/tag-mappings: " "[" (|> tag-mappings (map first) (interpose " ") (foldL text:++ "")) "]" " " (type:show struct-type)) + _ (_jvm_invokevirtual "java.io.PrintStream" "println" ["java.lang.Object"] + (_jvm_getstatic "java.lang.System" "out") [msg])] + (return (: Unit [])))) + ] (do Lux/Monad [members (map% Lux/Monad (: (-> AST (Lux (, AST AST))) (lambda [token] (case token - (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS tag-name)] value))]) - (wrap (: (, AST AST) [(tag$ tag-name) value])) + (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))]) + (case (get tag-name tag-mappings) + (#Some tag) + (wrap (: (, AST AST) [tag value])) + + _ + (fail (text:++ "Unknown structure member: " tag-name))) _ - (fail "Structures members must be unqualified.")))) + (fail (text:++ "Invalid structure member: " (ast:show token)))))) (list:join tokens'))] (wrap (list (record$ members)))))) diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux index ea79ff9ad..a23e969b3 100644 --- a/source/lux/codata/function.lux +++ b/source/lux/codata/function.lux @@ -23,5 +23,5 @@ ## [Structures] (defstruct #export Comp/Monoid (All [a] (m;Monoid (-> a a))) - (def m;unit id) - (def m;++ .)) + (def unit id) + (def ++ .)) diff --git a/source/lux/codata/lazy.lux b/source/lux/codata/lazy.lux index 9c72fdb16..1529c0dae 100644 --- a/source/lux/codata/lazy.lux +++ b/source/lux/codata/lazy.lux @@ -34,13 +34,13 @@ ## [Structs] (defstruct #export Lazy/Functor (Functor Lazy) - (def (F;map f ma) + (def (map f ma) (lambda [k] (ma (. k f))))) (defstruct #export Lazy/Monad (Monad Lazy) - (def M;_functor Lazy/Functor) + (def _functor Lazy/Functor) - (def (M;wrap a) + (def (wrap a) (... a)) - (def M;join !)) + (def join !)) diff --git a/source/lux/codata/reader.lux b/source/lux/codata/reader.lux index 56b3e0286..e776f73ec 100644 --- a/source/lux/codata/reader.lux +++ b/source/lux/codata/reader.lux @@ -14,17 +14,17 @@ ## [Structures] (defstruct #export Reader/Functor (All [r] (Functor (Reader r))) - (def (F;map f fa) + (def (map f fa) (lambda [env] (f (fa env))))) (defstruct #export Reader/Monad (All [r] (Monad (Reader r))) - (def M;_functor Reader/Functor) + (def _functor Reader/Functor) - (def (M;wrap x) + (def (wrap x) (lambda [env] x)) - (def (M;join mma) + (def (join mma) (lambda [env] (mma env env)))) diff --git a/source/lux/codata/state.lux b/source/lux/codata/state.lux index d85ef3dbc..ec0a6bf63 100644 --- a/source/lux/codata/state.lux +++ b/source/lux/codata/state.lux @@ -13,20 +13,20 @@ ## [Structures] (defstruct #export State/Functor (Functor State) - (def (F;map f ma) + (def (map f ma) (lambda [state] (let [[state' a] (ma state)] [state' (f a)])))) (defstruct #export State/Monad (All [s] (Monad (State s))) - (def M;_functor State/Functor) + (def _functor State/Functor) - (def (M;wrap x) + (def (wrap x) (lambda [state] [state x])) - (def (M;join mma) + (def (join mma) (lambda [state] (let [[state' ma] (mma state)] (ma state'))))) diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux index 5415213d7..d0f84f0c7 100644 --- a/source/lux/codata/stream.lux +++ b/source/lux/codata/stream.lux @@ -110,14 +110,14 @@ ## [Structures] (defstruct #export Stream/Functor (Functor Stream) - (def (F;map f fa) + (def (map f fa) (let [[h t] (! fa)] (... [(f h) (map f t)])))) (defstruct #export Stream/CoMonad (CoMonad Stream) - (def CM;_functor Stream/Functor) - (def CM;unwrap head) - (def (CM;split wa) + (def _functor Stream/Functor) + (def unwrap head) + (def (split wa) (:: Stream/Functor (F;map repeat wa)))) ## [Pattern-matching] diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux index 29de09328..defaee22e 100644 --- a/source/lux/data/bool.lux +++ b/source/lux/data/bool.lux @@ -11,19 +11,19 @@ ## [Structures] (defstruct #export Bool/Eq (E;Eq Bool) - (def (E;= x y) + (def (= x y) (if x y (not y)))) (defstruct #export Bool/Show (S;Show Bool) - (def (S;show x) + (def (show x) (if x "true" "false"))) (do-template [<name> <unit> <op>] [(defstruct #export <name> (m;Monoid Bool) - (def m;unit <unit>) - (def (m;++ x y) + (def unit <unit>) + (def (++ x y) (<op> x y)))] [ Or/Monoid false or] diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux index e6e796123..4e0d41b22 100644 --- a/source/lux/data/char.lux +++ b/source/lux/data/char.lux @@ -10,9 +10,9 @@ ## [Structures] (defstruct #export Char/Eq (E;Eq Char) - (def (E;= x y) + (def (= x y) (_jvm_ceq x y))) (defstruct #export Char/Show (S;Show Char) - (def (S;show x) + (def (show x) ($ text:++ "#\"" (_jvm_invokevirtual "java.lang.Object" "toString" [] x []) "\""))) diff --git a/source/lux/data/either.lux b/source/lux/data/either.lux index 86d778965..38de1e2d1 100644 --- a/source/lux/data/either.lux +++ b/source/lux/data/either.lux @@ -46,18 +46,18 @@ ## [Structures] (defstruct #export Error/Functor (All [a] (Functor (Either a))) - (def (F;map f ma) + (def (map f ma) (case ma (#;Left msg) (#;Left msg) (#;Right datum) (#;Right (f datum))))) (defstruct #export Error/Monad (All [a] (Monad (Either a))) - (def M;_functor Error/Functor) + (def _functor Error/Functor) - (def (M;wrap a) + (def (wrap a) (#;Right a)) - (def (M;join mma) + (def (join mma) (case mma (#;Left msg) (#;Left msg) (#;Right ma) ma))) diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux index e06a24f94..6b996cf1e 100644 --- a/source/lux/data/id.lux +++ b/source/lux/data/id.lux @@ -14,16 +14,16 @@ ## [Structures] (defstruct #export Id/Functor (Functor Id) - (def (F;map f fa) + (def (map f fa) (let [(#Id a) fa] (#Id (f a))))) (defstruct #export Id/Monad (Monad Id) - (def M;_functor Id/Functor) - (def (M;wrap a) (#Id a)) - (def (M;join mma) (let [(#Id ma) mma] ma))) + (def _functor Id/Functor) + (def (wrap a) (#Id a)) + (def (join mma) (let [(#Id ma) mma] ma))) (defstruct #export Id/CoMonad (CoMonad Id) - (def CM;_functor Id/Functor) - (def (CM;unwrap wa) (let [(#Id a) wa] a)) - (def (CM;split wa) (#Id wa))) + (def _functor Id/Functor) + (def (unwrap wa) (let [(#Id a) wa] a)) + (def (split wa) (#Id wa))) diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux index 144410f5c..032381404 100644 --- a/source/lux/data/io.lux +++ b/source/lux/data/io.lux @@ -27,16 +27,16 @@ ## [Structures] (defstruct #export IO/Functor (F;Functor IO) - (def (F;map f ma) + (def (map f ma) (io (f (ma []))))) (defstruct #export IO/Monad (M;Monad IO) - (def M;_functor IO/Functor) + (def _functor IO/Functor) - (def (M;wrap x) + (def (wrap x) (io x)) - (def (M;join mma) + (def (join mma) (mma []))) ## [Functions] diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux index 10bbb8086..c9a4c7598 100644 --- a/source/lux/data/list.lux +++ b/source/lux/data/list.lux @@ -235,14 +235,14 @@ ## [Structures] ## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a)))) -## (def (E;= xs ys) +## (def (= xs ys) ## (case [xs ys] ## [#;Nil #;Nil] ## true ## [(#;Cons x xs') (#;Cons y ys')] ## (and (:: eq (E;= x y)) -## (E;= xs' ys')) +## (= xs' ys')) ## [_ _] ## false @@ -250,25 +250,25 @@ (defstruct #export List/Monoid (All [a] (Monoid (List a))) - (def m;unit #;Nil) - (def (m;++ xs ys) + (def unit #;Nil) + (def (++ xs ys) (case xs #;Nil ys (#;Cons x xs') (#;Cons x (++ xs' ys))))) (defstruct #export List/Functor (Functor List) - (def (F;map f ma) + (def (map f ma) (case ma #;Nil #;Nil (#;Cons [a ma']) (#;Cons [(f a) (map f ma')])))) (defstruct #export List/Monad (Monad List) - (def M;_functor List/Functor) + (def _functor List/Functor) - (def (M;wrap a) + (def (wrap a) (#;Cons [a #;Nil])) - (def (M;join mma) + (def (join mma) (using List/Monoid (foldL ++ unit mma)))) diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux index bb4eee6df..5df03f378 100644 --- a/source/lux/data/maybe.lux +++ b/source/lux/data/maybe.lux @@ -18,25 +18,25 @@ ## [Structures] (defstruct #export Maybe/Monoid (All [a] (Monoid (Maybe a))) - (def m;unit #;None) - (def (m;++ xs ys) + (def unit #;None) + (def (++ xs ys) (case xs #;None ys (#;Some x) (#;Some x)))) (defstruct #export Maybe/Functor (Functor Maybe) - (def (F;map f ma) + (def (map f ma) (case ma #;None #;None (#;Some a) (#;Some (f a))))) (defstruct #export Maybe/Monad (Monad Maybe) - (def M;_functor Maybe/Functor) + (def _functor Maybe/Functor) - (def (M;wrap x) + (def (wrap x) (#;Some x)) - (def (M;join mma) + (def (join mma) (case mma #;None #;None (#;Some xs) xs))) diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux index cc327ad0c..2d94ad43b 100644 --- a/source/lux/data/number/int.lux +++ b/source/lux/data/number/int.lux @@ -15,20 +15,20 @@ ## Number (do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>] [(defstruct #export <name> (N;Number <type>) - (def (N;+ x y) (<+> x y)) - (def (N;- x y) (<-> x y)) - (def (N;* x y) (<*> x y)) - (def (N;/ x y) (</> x y)) - (def (N;% x y) (<%> x y)) - (def (N;from-int x) + (def (+ x y) (<+> x y)) + (def (- x y) (<-> x y)) + (def (* x y) (<*> x y)) + (def (/ x y) (</> x y)) + (def (% x y) (<%> x y)) + (def (from-int x) (<from> x)) - (def (N;negate x) + (def (negate x) (<*> <-1> x)) - (def (N;abs x) + (def (abs x) (if (<<> x <0>) (<*> <-1> x) x)) - (def (N;signum x) + (def (signum x) (cond (<=> x <0>) <0> (<<> x <0>) <-1> ## else @@ -39,18 +39,18 @@ ## Eq (defstruct #export Int/Eq (E;Eq Int) - (def (E;= x y) (_jvm_leq x y))) + (def (= x y) (_jvm_leq x y))) ## Ord (do-template [<name> <type> <eq> <=> <lt> <gt>] [(defstruct #export <name> (O;Ord <type>) - (def O;_eq <eq>) - (def (O;< x y) (<lt> x y)) - (def (O;<= x y) + (def _eq <eq>) + (def (< x y) (<lt> x y)) + (def (<= x y) (or (<lt> x y) (<=> x y))) - (def (O;> x y) (<gt> x y)) - (def (O;>= x y) + (def (> x y) (<gt> x y)) + (def (>= x y) (or (<gt> x y) (<=> x y))))] @@ -59,16 +59,16 @@ ## Bounded (do-template [<name> <type> <top> <bottom>] [(defstruct #export <name> (B;Bounded <type>) - (def B;top <top>) - (def B;bottom <bottom>))] + (def top <top>) + (def bottom <bottom>))] [ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")]) ## Monoid (do-template [<name> <type> <unit> <++>] [(defstruct #export <name> (m;Monoid <type>) - (def m;unit <unit>) - (def (m;++ x y) (<++> x y)))] + (def unit <unit>) + (def (++ x y) (<++> x y)))] [ IntAdd/Monoid Int 0 _jvm_ladd] [ IntMul/Monoid Int 1 _jvm_lmul] @@ -79,7 +79,7 @@ ## Show (do-template [<name> <type> <body>] [(defstruct #export <name> (S;Show <type>) - (def (S;show x) + (def (show x) <body>))] [ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] diff --git a/source/lux/data/number/real.lux b/source/lux/data/number/real.lux index 27f1bf7b0..2b7090265 100644 --- a/source/lux/data/number/real.lux +++ b/source/lux/data/number/real.lux @@ -15,20 +15,20 @@ ## Number (do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>] [(defstruct #export <name> (N;Number <type>) - (def (N;+ x y) (<+> x y)) - (def (N;- x y) (<-> x y)) - (def (N;* x y) (<*> x y)) - (def (N;/ x y) (</> x y)) - (def (N;% x y) (<%> x y)) - (def (N;from-int x) + (def (+ x y) (<+> x y)) + (def (- x y) (<-> x y)) + (def (* x y) (<*> x y)) + (def (/ x y) (</> x y)) + (def (% x y) (<%> x y)) + (def (from-int x) (<from> x)) - (def (N;negate x) + (def (negate x) (<*> <-1> x)) - (def (N;abs x) + (def (abs x) (if (<<> x <0>) (<*> <-1> x) x)) - (def (N;signum x) + (def (signum x) (cond (<=> x <0>) <0> (<<> x <0>) <-1> ## else @@ -39,18 +39,18 @@ ## Eq (defstruct #export Real/Eq (E;Eq Real) - (def (E;= x y) (_jvm_deq x y))) + (def (= x y) (_jvm_deq x y))) ## Ord (do-template [<name> <type> <eq> <=> <lt> <gt>] [(defstruct #export <name> (O;Ord <type>) - (def O;_eq <eq>) - (def (O;< x y) (<lt> x y)) - (def (O;<= x y) + (def _eq <eq>) + (def (< x y) (<lt> x y)) + (def (<= x y) (or (<lt> x y) (<=> x y))) - (def (O;> x y) (<gt> x y)) - (def (O;>= x y) + (def (> x y) (<gt> x y)) + (def (>= x y) (or (<gt> x y) (<=> x y))))] @@ -59,16 +59,16 @@ ## Bounded (do-template [<name> <type> <top> <bottom>] [(defstruct #export <name> (B;Bounded <type>) - (def B;top <top>) - (def B;bottom <bottom>))] + (def top <top>) + (def bottom <bottom>))] [Real/Bounded Real (_jvm_getstatic "java.lang.Double" "MAX_VALUE") (_jvm_getstatic "java.lang.Double" "MIN_VALUE")]) ## Monoid (do-template [<name> <type> <unit> <++>] [(defstruct #export <name> (m;Monoid <type>) - (def m;unit <unit>) - (def (m;++ x y) (<++> x y)))] + (def unit <unit>) + (def (++ x y) (<++> x y)))] [RealAdd/Monoid Real 0.0 _jvm_dadd] [RealMul/Monoid Real 1.0 _jvm_dmul] @@ -79,7 +79,7 @@ ## Show (do-template [<name> <type> <body>] [(defstruct #export <name> (S;Show <type>) - (def (S;show x) + (def (show x) <body>))] [Real/Show Real (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux index 0040a96c5..533308dd0 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -115,12 +115,12 @@ ## [Structures] (defstruct #export Text/Eq (E;Eq Text) - (def (E;= x y) + (def (= x y) (_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"] x [y]))) (defstruct #export Text/Ord (O;Ord Text) - (def O;_eq Text/Eq) + (def _eq Text/Eq) (do-template [<name> <op>] [(def (<name> x y) @@ -128,17 +128,17 @@ x [y])) 0))] - [O;< i<] - [O;<= i<=] - [O;> i>] - [O;>= i>=])) + [< i<] + [<= i<=] + [> i>] + [>= i>=])) (defstruct #export Text/Show (S;Show Text) - (def S;show id)) + (def show id)) (defstruct #export Text/Monoid (m;Monoid Text) - (def m;unit "") - (def (m;++ x y) + (def unit "") + (def (++ x y) (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"] x [y]))) diff --git a/source/lux/data/writer.lux b/source/lux/data/writer.lux index 316e1fbcc..bf26eac9a 100644 --- a/source/lux/data/writer.lux +++ b/source/lux/data/writer.lux @@ -15,17 +15,17 @@ ## [Structures] (defstruct #export Writer/Functor (All [l] (Functor (Writer l))) - (def (F;map f fa) + (def (map f fa) (let [[log datum] fa] [log (f datum)]))) (defstruct #export (Writer/Monad mon) (All [l] (-> (Monoid l) (Monad (Writer l)))) - (def M;_functor Writer/Functor) + (def _functor Writer/Functor) - (def (M;wrap x) + (def (wrap x) [(:: mon m;unit) x]) - (def (M;join mma) + (def (join mma) (let [[log1 [log2 a]] mma] [(:: mon (m;++ log1 log2)) a]))) diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux index 92c43bbee..32ca78570 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -26,7 +26,7 @@ ## [Structures] (defstruct #export Lux/Functor (F;Functor Lux) - (def (F;map f fa) + (def (map f fa) (lambda [state] (case (fa state) (#;Left msg) @@ -36,11 +36,11 @@ (#;Right [state' (f a)]))))) (defstruct #export Lux/Monad (M;Monad Lux) - (def M;_functor Lux/Functor) - (def (M;wrap x) + (def _functor Lux/Functor) + (def (wrap x) (lambda [state] (#;Right [state x]))) - (def (M;join mma) + (def (join mma) (lambda [state] (case (mma state) (#;Left msg) diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index 1732350ce..7d888f659 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -35,7 +35,7 @@ ## [Structures] (defstruct #export Parser/Functor (F;Functor Parser) - (def (F;map f ma) + (def (map f ma) (lambda [tokens] (case (ma tokens) #;None @@ -45,12 +45,12 @@ (#;Some [tokens' (f a)]))))) (defstruct #export Parser/Monad (M;Monad Parser) - (def M;_functor Parser/Functor) + (def _functor Parser/Functor) - (def (M;wrap x tokens) + (def (wrap x tokens) (#;Some [tokens x])) - (def (M;join mma) + (def (join mma) (lambda [tokens] (case (mma tokens) #;None |