aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
authorEduardo Julian2015-08-29 18:12:27 -0400
committerEduardo Julian2015-08-29 18:12:27 -0400
commitcc928a8675cb35dabd4a4957ab6612b70f015d58 (patch)
tree676c99b8f37e9485f45d29397280501292706969 /source
parent8de225f98aaed212bf3b683208bff5c6ab85a835 (diff)
- Removed the (unnecessary) lux/data/cont module.
- Removed the (unnecessary) lux/data/error module and moved it's structures to lux/data/either. - Implemented the \slots destructurer for records. - Implemented quicksort for lists as the "sort" function in lux/data/list. - Added tags for the Cursor type.
Diffstat (limited to '')
-rw-r--r--source/lux.lux45
-rw-r--r--source/lux/data/cont.lux38
-rw-r--r--source/lux/data/either.lux42
-rw-r--r--source/lux/data/error.lux31
-rw-r--r--source/lux/data/list.lux24
5 files changed, 93 insertions, 87 deletions
diff --git a/source/lux.lux b/source/lux.lux
index d96b18fcb..cf56f326a 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -160,6 +160,7 @@
(#NamedT ["lux" "Cursor"]
(#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil))))))
(_lux_export Cursor)
+(_lux_declare-tags [#module #line #column] Cursor)
## (deftype (Meta m v)
## (| (#Meta m v)))
@@ -785,8 +786,8 @@
(#Meta _ (#RecordS pairs))
(record$ (map (_lux_: (->' (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil))))
(lambda'' [pair]
- (let'' [name val] pair
- [name (update-bounds val)])))
+ (let'' [name val] pair
+ [name (update-bounds val)])))
pairs))
(#Meta _ (#FormS (#Cons (#Meta _ (#TagS "lux" "BoundT")) (#Cons (#Meta _ (#IntS idx)) #Nil))))
@@ -931,8 +932,8 @@
(def''' (as-pairs xs)
(All' [a] (->' ($' List a) ($' List (#TupleT (list a a)))))
(_lux_case xs
- (#Cons [x (#Cons [y xs'])])
- (#Cons [[x y] (as-pairs xs')])
+ (#Cons x (#Cons y xs'))
+ (#Cons [x y] (as-pairs xs'))
_
#Nil))
@@ -3224,3 +3225,39 @@
(defmacro #export (export tokens)
(return (map (lambda [token] (` (_lux_export (~ token)))) tokens)))
+
+(defmacro #export (\slots tokens)
+ (case tokens
+ (\ (list body (#Meta _ (#TupleS (list& hslot' tslots')))))
+ (do Lux/Monad
+ [slots (: (Lux (, Ident (List Ident)))
+ (case (: (Maybe (, Ident (List Ident)))
+ (do Maybe/Monad
+ [hslot (get-ident hslot')
+ tslots (map% Maybe/Monad get-ident tslots')]
+ (wrap [hslot tslots])))
+ (#Some slots)
+ (return slots)
+
+ #None
+ (fail "Wrong syntax for \\slots")))
+ #let [[hslot tslots] slots]
+ hslot (normalize hslot)
+ tslots (map% Lux/Monad normalize tslots)
+ output (resolve-tag hslot)
+ g!_ (gensym "_")
+ #let [[idx tags type] output
+ slot-pairings (map (: (-> Ident (, Text AST))
+ (lambda [[module name]] [name (symbol$ ["" name])]))
+ (list& hslot tslots))
+ pattern (record$ (map (: (-> Ident (, AST AST))
+ (lambda [[module name]]
+ (let [tag (tag$ [module name])]
+ (case (get name slot-pairings)
+ (#Some binding) [tag binding]
+ #None [tag g!_]))))
+ tags))]]
+ (return (list pattern body)))
+
+ _
+ (fail "Wrong syntax for \\slots")))
diff --git a/source/lux/data/cont.lux b/source/lux/data/cont.lux
deleted file mode 100644
index 2c55eb641..000000000
--- a/source/lux/data/cont.lux
+++ /dev/null
@@ -1,38 +0,0 @@
-## Copyright (c) Eduardo Julian. All rights reserved.
-## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-## If a copy of the MPL was not distributed with this file,
-## You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(;import lux
- (lux/control (functor #as F #refer #all)
- (monad #as M #refer #all)))
-
-## [Types]
-(deftype #export (Cont r a)
- (-> (-> a r) r))
-
-## [Structures]
-(defstruct #export Cont/Functor (All [r]
- (Functor (Cont r)))
- (def (F;map f fa)
- (lambda [k]
- (k (fa f)))))
-
-(defstruct #export Cont/Monad (All [r]
- (Monad (Cont r)))
- (def M;_functor Cont/Functor)
-
- (def (M;wrap x)
- (lambda [k]
- (k x)))
-
- (def (M;join mma)
- (lambda [k]
- (mma (lambda [ma] (ma k))))))
-
-## [Functions]
-(def #export (call/cc body)
- (All [r a b]
- (-> (-> (-> a (Cont r b)) (Cont r a)) (Cont r a)))
- (lambda [k]
- (body k)))
diff --git a/source/lux/data/either.lux b/source/lux/data/either.lux
index a945c32b9..86d778965 100644
--- a/source/lux/data/either.lux
+++ b/source/lux/data/either.lux
@@ -4,7 +4,9 @@
## You can obtain one at http://mozilla.org/MPL/2.0/.
(;import lux
- (lux/data (list #refer (#exclude partition))))
+ (lux (control (functor #as F #refer #all)
+ (monad #as M #refer #all))
+ (data (list #refer (#exclude partition)))))
## [Types]
## (deftype (Either l r)
@@ -30,14 +32,32 @@
[rights b #;Right]
)
-(def #export (partition es)
+(def #export (partition xs)
(All [a b] (-> (List (Either a b)) (, (List a) (List b))))
- (foldL (: (All [a b]
- (-> (, (List a) (List b)) (Either a b) (, (List a) (List b))))
- (lambda [tails e]
- (let [[ltail rtail] tails]
- (case e
- (#;Left x) [(#;Cons [x ltail]) rtail]
- (#;Right x) [ltail (#;Cons [x rtail])]))))
- [(list) (list)]
- (reverse es)))
+ (case xs
+ #;Nil
+ [#;Nil #;Nil]
+
+ (#;Cons x xs')
+ (let [[lefts rights] (partition xs')]
+ (case x
+ (#;Left x') [(#;Cons x' lefts) rights]
+ (#;Right x') [lefts (#;Cons x' rights)]))))
+
+## [Structures]
+(defstruct #export Error/Functor (All [a] (Functor (Either a)))
+ (def (F;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 (M;wrap a)
+ (#;Right a))
+
+ (def (M;join mma)
+ (case mma
+ (#;Left msg) (#;Left msg)
+ (#;Right ma) ma)))
diff --git a/source/lux/data/error.lux b/source/lux/data/error.lux
deleted file mode 100644
index 9c595144b..000000000
--- a/source/lux/data/error.lux
+++ /dev/null
@@ -1,31 +0,0 @@
-## Copyright (c) Eduardo Julian. All rights reserved.
-## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-## If a copy of the MPL was not distributed with this file,
-## You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(;import lux
- (lux/control (functor #as F #refer #all)
- (monad #as M #refer #all)))
-
-## [Types]
-(deftype #export (Error a)
- (| (#Fail Text)
- (#Ok a)))
-
-## [Structures]
-(defstruct #export Error/Functor (Functor Error)
- (def (F;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 (M;wrap a)
- (#Ok a))
-
- (def (M;join mma)
- (case mma
- (#Fail msg) (#Fail msg)
- (#Ok ma) ma)))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index a4a6a6d0e..1277fc6ae 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -8,6 +8,7 @@
(functor #as F #refer #all)
(monad #as M #refer #all)
(eq #as E)
+ (ord #as O)
(dict #as D #refer #all)
(stack #as S))
(data (number (int #open ("i" Int/Number Int/Ord)))
@@ -248,9 +249,12 @@
## [#;Nil #;Nil]
## true
-## [(#;Cons [x xs']) (#;Cons [y ys'])]
+## [(#;Cons x xs') (#;Cons y ys')]
## (and (:: eq (E;= x y))
## (E;= xs' ys'))
+
+## [_ _]
+## false
## )))
(defstruct #export List/Monoid (All [a]
@@ -258,8 +262,8 @@
(def m;unit #;Nil)
(def (m;++ xs ys)
(case xs
- #;Nil ys
- (#;Cons [x xs']) (#;Cons [x (++ xs' ys)]))))
+ #;Nil ys
+ (#;Cons x xs') (#;Cons x (++ xs' ys)))))
(defstruct #export List/Functor (Functor List)
(def (F;map f ma)
@@ -327,3 +331,17 @@
(case xs
#;Nil #;None
(#;Cons x xs') (#;Some x))))
+
+## [Functions]
+(def #export (sort ord xs)
+ (All [a] (-> (O;Ord a) (List a) (List a)))
+ (case xs
+ #;Nil
+ #;Nil
+
+ (#;Cons x xs')
+ (using ord
+ (let [pre (filter (>= x) xs')
+ post (filter (< x) xs')
+ ++ (:: List/Monoid m;++)]
+ ($ ++ (sort ord pre) (list x) (sort ord post))))))