diff options
author | Eduardo Julian | 2015-08-04 20:38:02 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-08-04 20:38:02 -0400 |
commit | 691b3e3174e01ed7d859f58442371328aefcfad4 (patch) | |
tree | eb13bf0e6801ebe1a5771f6750d459d3cbd67ad6 | |
parent | a8ac885a008f519816d747eca0f894ec9794e938 (diff) |
- Struct definition no longer required prefixed members (now, it actually prohibits them).
-rw-r--r-- | source/lux.lux | 469 | ||||
-rw-r--r-- | source/lux/codata/function.lux | 4 | ||||
-rw-r--r-- | source/lux/codata/lazy.lux | 12 | ||||
-rw-r--r-- | source/lux/codata/reader.lux | 12 | ||||
-rw-r--r-- | source/lux/codata/state.lux | 12 | ||||
-rw-r--r-- | source/lux/codata/stream.lux | 10 | ||||
-rw-r--r-- | source/lux/data/bool.lux | 8 | ||||
-rw-r--r-- | source/lux/data/char.lux | 4 | ||||
-rw-r--r-- | source/lux/data/error.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 | 32 | ||||
-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, 371 insertions, 356 deletions
diff --git a/source/lux.lux b/source/lux.lux index deb6025ad..ced208d40 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1975,22 +1975,252 @@ #None (fail "Wrong syntax for defsig")))) +(def (some f xs) + (All [a b] + (-> (-> a (Maybe b)) (List a) (Maybe b))) + (case xs + #Nil + #None + + (#Cons x xs') + (case (f x) + #None + (some f xs') + + (#Some y) + (#Some y)))) + +(def (last-index-of part text) + (-> Text Text Int) + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "lastIndexOf" ["java.lang.String"] + text [part]))) + +(def (index-of part text) + (-> Text Text Int) + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "indexOf" ["java.lang.String"] + text [part]))) + +(def (substring1 idx text) + (-> Int Text Text) + (_jvm_invokevirtual "java.lang.String" "substring" ["int"] + text [(_jvm_l2i idx)])) + +(def (substring2 idx1 idx2 text) + (-> Int Int Text Text) + (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] + text [(_jvm_l2i idx1) (_jvm_l2i idx2)])) + +(def (split-module-contexts module) + (-> Text (List Text)) + (#Cons module (let [idx (last-index-of "/" module)] + (if (i< idx 0) + #Nil + (split-module-contexts (substring2 0 idx module)))))) + +(def (split-module module) + (-> Text (List Text)) + (let [idx (index-of "/" module)] + (if (i< idx 0) + (#Cons module #Nil) + (#Cons (substring2 0 idx module) + (split-module (substring1 (i+ 1 idx) module)))))) + +(def (split-slot slot) + (-> Text (, Text Text)) + (let [idx (index-of ";" slot) + module (substring2 0 idx slot) + name (substring1 (i+ 1 idx) slot)] + [module name])) + +(def (type:show type) + (-> Type Text) + (case type + (#DataT name) + ($ text:++ "(^ " name ")") + + (#TupleT elems) + (case elems + #;Nil + "(,)" + + _ + ($ text:++ "(, " (|> elems (map type:show) (interpose " ") (foldL text:++ "")) ")")) + + (#VariantT cases) + (case cases + #;Nil + "(|)" + + _ + ($ text:++ "(| " + (|> cases + (map (: (-> (, Text Type) Text) + (lambda [kv] + (case kv + [k (#TupleT #;Nil)] + ($ text:++ "#" k) + + [k v] + ($ text:++ "(#" k " " (type:show v) ")"))))) + (interpose " ") + (foldL text:++ "")) + ")")) + + (#RecordT fields) + (case fields + #;Nil + "(&)" + + _ + ($ text:++ "(& " + (|> fields + (map (: (-> (, Text Type) Text) + (: (-> (, Text Type) Text) + (lambda [kv] + (let [[k v] kv] + ($ text:++ "(#" k " " (type:show v) ")")))))) + (interpose " ") + (foldL text:++ "")) + ")")) + + (#LambdaT input output) + ($ text:++ "(-> " (type:show input) " " (type:show output) ")") + + (#VarT id) + ($ text:++ "⌈" (->text id) "⌋") + + (#BoundT name) + name + + (#ExT ?id) + ($ text:++ "⟨" (->text ?id) "⟩") + + (#AppT ?lambda ?param) + ($ text:++ "(" (type:show ?lambda) " " (type:show ?param) ")") + + (#AllT ?env ?name ?arg ?body) + ($ text:++ "(All " ?name " [" ?arg "] " (type:show ?body) ")") + )) + +(def (beta-reduce env type) + (-> (List (, Text Type)) Type Type) + (case type + (#VariantT ?cases) + (#VariantT (map (: (-> (, Text Type) (, Text Type)) + (lambda [kv] + (let [[k v] kv] + [k (beta-reduce env v)]))) + ?cases)) + + (#RecordT ?fields) + (#RecordT (map (: (-> (, Text Type) (, Text Type)) + (lambda [kv] + (let [[k v] kv] + [k (beta-reduce env v)]))) + ?fields)) + + (#TupleT ?members) + (#TupleT (map (beta-reduce env) ?members)) + + (#AppT ?type-fn ?type-arg) + (#AppT (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)) + + (#AllT ?local-env ?local-name ?local-arg ?local-def) + (case ?local-env + #None + (#AllT (#Some env) ?local-name ?local-arg ?local-def) + + (#Some _) + type) + + (#LambdaT ?input ?output) + (#LambdaT (beta-reduce env ?input) (beta-reduce env ?output)) + + (#BoundT ?name) + (case (get ?name env) + (#Some bound) + bound + + _ + type) + + _ + type + )) + +(def (apply-type type-fn param) + (-> Type Type (Maybe Type)) + (case type-fn + (#AllT env name arg body) + (#Some (beta-reduce (|> (case env + (#Some env) env + _ (list)) + (put name type-fn) + (put arg param)) + body)) + + (#AppT F A) + (do Maybe/Monad + [type-fn* (apply-type F A)] + (apply-type type-fn* param)) + + _ + #None)) + +(def (resolve-struct-type type) + (-> Type (Maybe Type)) + (case type + (#RecordT slots) + (#Some type) + + (#AppT fun arg) + (apply-type fun arg) + + (#AllT _ _ _ body) + (resolve-struct-type body) + + _ + #None)) + +(def expected-type + (Lux Type) + (lambda [state] + (let [{#source source #modules modules + #envs envs #types types #host host + #seed seed #eval? eval? #expected expected} state] + (#Right state expected)))) + (defmacro #export (struct tokens) (do Lux/Monad [tokens' (map% Lux/Monad macro-expand tokens) - members (map% Lux/Monad - (: (-> AST (Lux (, AST AST))) - (lambda [token] - (case token - (\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_def")) (#Meta _ (#SymbolS name)) value)))) - (do Lux/Monad - [name' (normalize name)] - (;return (: (, AST AST) [(tag$ name') value]))) + struct-type expected-type] + (case (resolve-struct-type struct-type) + (#Some (#RecordT slots)) + (do Lux/Monad + [#let [translations (map (: (-> (, Text Type) (, Text Ident)) + (lambda [[sname _]] + (let [[module name] (split-slot sname)] + [name [module name]]))) + slots)] + members (map% Lux/Monad + (: (-> AST (Lux (, AST AST))) + (lambda [token] + (case token + (\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_def")) (#Meta _ (#SymbolS ["" name])) value)))) + (case (get name translations) + (#Some tag-name) + (;return (: (, AST AST) [(tag$ tag-name) value])) + + _ + (fail "Structures require defined members")) - _ - (fail "Structures require defined members")))) - (list:join tokens'))] - (;return (list (record$ members))))) + _ + (fail "Structures members must be unqualified.")))) + (list:join tokens'))] + (;return (list (record$ members)))) + + _ + (fail "struct can only use records.")))) (defmacro #export (defstruct tokens) (let [[export? tokens'] (: (, Bool (List AST)) @@ -2205,41 +2435,6 @@ (#Left ($ text:++ "Unknown module: " module))) )) -(def (last-index-of part text) - (-> Text Text Int) - (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "lastIndexOf" ["java.lang.String"] - text [part]))) - -(def (index-of part text) - (-> Text Text Int) - (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "indexOf" ["java.lang.String"] - text [part]))) - -(def (substring1 idx text) - (-> Int Text Text) - (_jvm_invokevirtual "java.lang.String" "substring" ["int"] - text [(_jvm_l2i idx)])) - -(def (substring2 idx1 idx2 text) - (-> Int Int Text Text) - (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] - text [(_jvm_l2i idx1) (_jvm_l2i idx2)])) - -(def (split-module-contexts module) - (-> Text (List Text)) - (#Cons module (let [idx (last-index-of "/" module)] - (if (i< idx 0) - #Nil - (split-module-contexts (substring2 0 idx module)))))) - -(def (split-module module) - (-> Text (List Text)) - (let [idx (index-of "/" module)] - (if (i< idx 0) - (#Cons module #Nil) - (#Cons (substring2 0 idx module) - (split-module (substring1 (i+ 1 idx) module)))))) - (def (@ idx xs) (All [a] (-> Int (List a) (Maybe a))) @@ -2392,178 +2587,6 @@ unknowns) (list (` (import (~@ tokens)))))))))) -(def (some f xs) - (All [a b] - (-> (-> a (Maybe b)) (List a) (Maybe b))) - (case xs - #Nil - #None - - (#Cons x xs') - (case (f x) - #None - (some f xs') - - (#Some y) - (#Some y)))) - -(def (split-slot slot) - (-> Text (, Text Text)) - (let [idx (index-of ";" slot) - module (substring2 0 idx slot) - name (substring1 (i+ 1 idx) slot)] - [module name])) - -(def (type:show type) - (-> Type Text) - (case type - (#DataT name) - ($ text:++ "(^ " name ")") - - (#TupleT elems) - (case elems - #;Nil - "(,)" - - _ - ($ text:++ "(, " (|> elems (map type:show) (interpose " ") (foldL text:++ "")) ")")) - - (#VariantT cases) - (case cases - #;Nil - "(|)" - - _ - ($ text:++ "(| " - (|> cases - (map (: (-> (, Text Type) Text) - (lambda [kv] - (case kv - [k (#TupleT #;Nil)] - ($ text:++ "#" k) - - [k v] - ($ text:++ "(#" k " " (type:show v) ")"))))) - (interpose " ") - (foldL text:++ "")) - ")")) - - (#RecordT fields) - (case fields - #;Nil - "(&)" - - _ - ($ text:++ "(& " - (|> fields - (map (: (-> (, Text Type) Text) - (: (-> (, Text Type) Text) - (lambda [kv] - (let [[k v] kv] - ($ text:++ "(#" k " " (type:show v) ")")))))) - (interpose " ") - (foldL text:++ "")) - ")")) - - (#LambdaT input output) - ($ text:++ "(-> " (type:show input) " " (type:show output) ")") - - (#VarT id) - ($ text:++ "⌈" (->text id) "⌋") - - (#BoundT name) - name - - (#ExT ?id) - ($ text:++ "⟨" (->text ?id) "⟩") - - (#AppT ?lambda ?param) - ($ text:++ "(" (type:show ?lambda) " " (type:show ?param) ")") - - (#AllT ?env ?name ?arg ?body) - ($ text:++ "(All " ?name " [" ?arg "] " (type:show ?body) ")") - )) - -(def (beta-reduce env type) - (-> (List (, Text Type)) Type Type) - (case type - (#VariantT ?cases) - (#VariantT (map (: (-> (, Text Type) (, Text Type)) - (lambda [kv] - (let [[k v] kv] - [k (beta-reduce env v)]))) - ?cases)) - - (#RecordT ?fields) - (#RecordT (map (: (-> (, Text Type) (, Text Type)) - (lambda [kv] - (let [[k v] kv] - [k (beta-reduce env v)]))) - ?fields)) - - (#TupleT ?members) - (#TupleT (map (beta-reduce env) ?members)) - - (#AppT ?type-fn ?type-arg) - (#AppT (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)) - - (#AllT ?local-env ?local-name ?local-arg ?local-def) - (case ?local-env - #None - (#AllT (#Some env) ?local-name ?local-arg ?local-def) - - (#Some _) - type) - - (#LambdaT ?input ?output) - (#LambdaT (beta-reduce env ?input) (beta-reduce env ?output)) - - (#BoundT ?name) - (case (get ?name env) - (#Some bound) - bound - - _ - type) - - _ - type - )) - -(def (apply-type type-fn param) - (-> Type Type (Maybe Type)) - (case type-fn - (#AllT env name arg body) - (#Some (beta-reduce (|> (case env - (#Some env) env - _ (list)) - (put name type-fn) - (put arg param)) - body)) - - (#AppT F A) - (do Maybe/Monad - [type-fn* (apply-type F A)] - (apply-type type-fn* param)) - - _ - #None)) - -(def (resolve-struct-type type) - (-> Type (Maybe Type)) - (case type - (#RecordT slots) - (#Some type) - - (#AppT fun arg) - (apply-type fun arg) - - (#AllT _ _ _ body) - (resolve-struct-type body) - - _ - #None)) - (def (try-both f x1 x2) (All [a b] (-> (-> a (Maybe b)) a a (Maybe b))) @@ -2666,14 +2689,6 @@ #seed seed #eval? eval? #expected expected} state] (#Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs))))))))) -(def expected-type - (Lux Type) - (lambda [state] - (let [{#source source #modules modules - #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} state] - (#Right state expected)))) - (def (use-field field-name type) (-> Text Type (, AST AST)) (let [[module name] (split-slot field-name) diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux index 7898e998d..8eb87c00b 100644 --- a/source/lux/codata/function.lux +++ b/source/lux/codata/function.lux @@ -26,5 +26,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 dbb1c13ad..de5c40eef 100644 --- a/source/lux/codata/lazy.lux +++ b/source/lux/codata/lazy.lux @@ -9,8 +9,8 @@ (;import lux (lux (meta macro ast) - (control (functor #as F #refer #all) - (monad #as M #refer #all)) + (control functor + monad) (data list)) (.. function)) @@ -37,13 +37,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 e91687c3a..ee1798793 100644 --- a/source/lux/codata/reader.lux +++ b/source/lux/codata/reader.lux @@ -7,8 +7,8 @@ ## You must not remove this notice, or any other, from this software. (;import (lux #refer (#exclude Reader)) - (lux/control (functor #as F #refer #all) - (monad #as M #refer #all))) + (lux/control functor + monad)) ## [Types] (deftype #export (Reader r a) @@ -17,17 +17,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 bc9858a29..c6fd8397d 100644 --- a/source/lux/codata/state.lux +++ b/source/lux/codata/state.lux @@ -7,8 +7,8 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/control (functor #as F #refer #all) - (monad #as M #refer #all))) + (lux/control functor + monad)) ## [Types] (deftype #export (State s a) @@ -16,20 +16,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 251d77815..871c50821 100644 --- a/source/lux/codata/stream.lux +++ b/source/lux/codata/stream.lux @@ -113,14 +113,14 @@ ## [Structures] (defstruct #export Stream/Functor (Functor Stream) - (def (F;map f fa) + (def (map f fa) (let [[h t] (! fa)] - (... [(f h) (F;map f t)])))) + (... [(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 92f5486ef..8f7a3bd13 100644 --- a/source/lux/data/bool.lux +++ b/source/lux/data/bool.lux @@ -14,19 +14,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 b97ec644d..04579c3a7 100644 --- a/source/lux/data/char.lux +++ b/source/lux/data/char.lux @@ -13,9 +13,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/error.lux b/source/lux/data/error.lux index cb5c309a6..7388dd786 100644 --- a/source/lux/data/error.lux +++ b/source/lux/data/error.lux @@ -17,18 +17,18 @@ ## [Structures] (defstruct #export Error/Functor (Functor Error) - (def (F;map f ma) + (def (map f ma) (case ma (#Fail msg) (#Fail msg) (#Ok datum) (#Ok (f datum))))) (defstruct #export Error/Monad (Monad Error) - (def M;_functor Error/Functor) + (def _functor Error/Functor) - (def (M;wrap a) + (def (wrap a) (#Ok a)) - (def (M;join mma) + (def (join mma) (case mma (#Fail msg) (#Fail msg) (#Ok ma) ma))) diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux index 3ad6b056b..58e7360b8 100644 --- a/source/lux/data/id.lux +++ b/source/lux/data/id.lux @@ -17,16 +17,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 f03dbddc6..ae71f9f34 100644 --- a/source/lux/data/io.lux +++ b/source/lux/data/io.lux @@ -30,16 +30,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 5b579e243..87afe7fe9 100644 --- a/source/lux/data/list.lux +++ b/source/lux/data/list.lux @@ -258,30 +258,30 @@ (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 (m;++ xs' 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) (F;map f ma')])))) + (#;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)))) (defstruct #export PList/Dict (Dict PList) - (def (D;get k (#PList [eq kvs])) + (def (get k (#PList [eq kvs])) (loop [kvs kvs] (case kvs #;Nil @@ -292,7 +292,7 @@ (#;Some v') (recur kvs'))))) - (def (D;put k v (#PList [eq kvs])) + (def (put k v (#PList [eq kvs])) (#PList [eq (loop [kvs kvs] (case kvs #;Nil @@ -303,7 +303,7 @@ (#;Cons [k v] kvs') (#;Cons [k' v'] (recur kvs')))))])) - (def (D;remove k (#PList [eq kvs])) + (def (remove k (#PList [eq kvs])) (#PList [eq (loop [kvs kvs] (case kvs #;Nil @@ -315,18 +315,18 @@ (#;Cons [[k' v'] (recur kvs')]))))]))) (defstruct #export List/Stack (S;Stack List) - (def S;empty (list)) - (def (S;empty? xs) + (def empty (list)) + (def (empty? xs) (case xs #;Nil true _ false)) - (def (S;push x xs) + (def (push x xs) (#;Cons x xs)) - (def (S;pop xs) + (def (pop xs) (case xs #;Nil #;None (#;Cons x xs') (#;Some xs'))) - (def (S;top xs) + (def (top xs) (case xs #;Nil #;None (#;Cons x xs') (#;Some x)))) diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux index bba85daf7..e23dbe291 100644 --- a/source/lux/data/maybe.lux +++ b/source/lux/data/maybe.lux @@ -21,25 +21,25 @@ ## [Structures] (defstruct #export Maybe/Monoid (Monoid Maybe) - (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 35c8d34bf..f3c81ef4e 100644 --- a/source/lux/data/number/int.lux +++ b/source/lux/data/number/int.lux @@ -18,20 +18,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 @@ -42,18 +42,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))))] @@ -62,16 +62,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] @@ -82,7 +82,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 4f9e4fa5f..9ba05df62 100644 --- a/source/lux/data/number/real.lux +++ b/source/lux/data/number/real.lux @@ -18,20 +18,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 @@ -42,18 +42,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))))] @@ -62,16 +62,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] @@ -82,7 +82,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 3f6f5d085..f691be397 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -118,12 +118,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) @@ -131,17 +131,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 f71492e35..7c6831e85 100644 --- a/source/lux/data/writer.lux +++ b/source/lux/data/writer.lux @@ -18,17 +18,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 bc859b823..26513ed81 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -29,7 +29,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) @@ -39,11 +39,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 beb2c9e7a..a69a89cb3 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -38,7 +38,7 @@ ## [Structures] (defstruct #export Parser/Functor (F;Functor Parser) - (def (F;map f ma) + (def (map f ma) (lambda [tokens] (case (ma tokens) #;None @@ -48,12 +48,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 |