diff options
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 45 | ||||
| -rw-r--r-- | source/lux/data/cont.lux | 38 | ||||
| -rw-r--r-- | source/lux/data/either.lux | 42 | ||||
| -rw-r--r-- | source/lux/data/error.lux | 31 | ||||
| -rw-r--r-- | source/lux/data/list.lux | 24 | ||||
| -rw-r--r-- | src/lux/compiler/io.clj | 2 |
6 files changed, 94 insertions, 88 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)))))) diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj index e72f34a7b..93be57f17 100644 --- a/src/lux/compiler/io.clj +++ b/src/lux/compiler/io.clj @@ -12,4 +12,4 @@ (let [file (new java.io.File path)] (if (.exists file) (return (slurp file)) - (fail (str "[I/O] File doesn't exist: " path))))) + (fail (str "[I/O Error] File doesn't exist: " path))))) |