aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux469
-rw-r--r--source/lux/codata/function.lux4
-rw-r--r--source/lux/codata/lazy.lux12
-rw-r--r--source/lux/codata/reader.lux12
-rw-r--r--source/lux/codata/state.lux12
-rw-r--r--source/lux/codata/stream.lux10
-rw-r--r--source/lux/data/bool.lux8
-rw-r--r--source/lux/data/char.lux4
-rw-r--r--source/lux/data/error.lux8
-rw-r--r--source/lux/data/id.lux14
-rw-r--r--source/lux/data/io.lux8
-rw-r--r--source/lux/data/list.lux32
-rw-r--r--source/lux/data/maybe.lux12
-rw-r--r--source/lux/data/number/int.lux40
-rw-r--r--source/lux/data/number/real.lux40
-rw-r--r--source/lux/data/text.lux18
-rw-r--r--source/lux/data/writer.lux8
-rw-r--r--source/lux/meta/lux.lux8
-rw-r--r--source/lux/meta/syntax.lux8
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 14:30:15 +0000