diff options
Diffstat (limited to '')
| -rw-r--r-- | source/lux.lux | 16 | ||||
| -rw-r--r-- | source/lux/control/enum.lux | 25 | ||||
| -rw-r--r-- | source/lux/control/fold.lux | 42 | ||||
| -rw-r--r-- | source/lux/control/monad.lux | 51 | ||||
| -rw-r--r-- | source/lux/data/ident.lux | 33 | ||||
| -rw-r--r-- | source/lux/data/list.lux | 88 | ||||
| -rw-r--r-- | source/lux/data/maybe.lux | 3 | ||||
| -rw-r--r-- | source/lux/data/text.lux | 14 | ||||
| -rw-r--r-- | source/lux/data/tuple.lux | 3 | ||||
| -rw-r--r-- | source/lux/math.lux | 22 | ||||
| -rw-r--r-- | source/lux/meta/ast.lux | 72 | ||||
| -rw-r--r-- | source/program.lux | 5 |
12 files changed, 332 insertions, 42 deletions
diff --git a/source/lux.lux b/source/lux.lux index 5f5c6925b..164dea835 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -2932,23 +2932,23 @@ _ (fail "Can only \"use\" records."))) + + [_ (#TupleS members)] + (return (@list (foldL (: (-> AST AST AST) + (lambda [body' struct'] (` (;;using (~ struct') (~ body'))))) + body + members))) _ (let [dummy (symbol$ ["" ""])] (return (@list (` (;_lux_case (~ struct) (~ dummy) - (;using (~ dummy) - (~ body)))))))) + (;;using (~ dummy) + (~ body)))))))) _ (fail "Wrong syntax for using"))) -(def (flip f) - (All [a b c] - (-> (-> a b c) (-> b a c))) - (lambda [y x] - (f x y))) - (defmacro #export (cond tokens) (if (i= 0 (i% (length tokens) 2)) (fail "cond requires an even number of arguments.") diff --git a/source/lux/control/enum.lux b/source/lux/control/enum.lux new file mode 100644 index 000000000..34910c837 --- /dev/null +++ b/source/lux/control/enum.lux @@ -0,0 +1,25 @@ +## 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 ord)) + +## [Signatures] +(defsig #export (Enum e) + (: (Ord e) _ord) + (: (-> e e) succ) + (: (-> e e) pre)) + +## [Functions] +(def #export (range' <= succ from to) + (All [a] (-> (-> a a Bool) (-> a a) a a (List a))) + (if (<= from to) + (#;Cons from (range' <= succ (succ from) to)) + #;Nil)) + +(def #export (range enum from to) + (All [a] (-> (Enum a) a a (List a))) + (using enum + (range' <= succ from to))) diff --git a/source/lux/control/fold.lux b/source/lux/control/fold.lux new file mode 100644 index 000000000..d0aef1576 --- /dev/null +++ b/source/lux/control/fold.lux @@ -0,0 +1,42 @@ +## 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 monoid + eq) + (data/number/int #open ("i" Int/Number Int/Eq)))) + +## [Signatures] +(defsig #export (Fold F) + (: (All [a b] + (-> (-> a b a) a (F b) a)) + foldL) + (: (All [a b] + (-> (-> b a a) a (F b) a)) + foldR)) + +## [Functions] +(def #export (foldM mon fold xs) + (All [F a] (-> (Monoid a) (Fold F) (F a) a)) + (using [mon fold] + (foldL ++ unit xs))) + +(def #export (size fold xs) + (All [F a] (-> (Fold F) (F a) Int)) + (using fold + (foldL (lambda [count _] (i+ 1 count)) + 0 + xs))) + +(def #export (member? eq fold x xs) + (All [F a] (-> (Eq a) (Fold F) a (F a) Bool)) + (using [eq fold] + (foldL (lambda [prev x'] (or prev (= x x'))) + false + xs))) + +(def #export (empty? fold xs) + (All [F a] (-> (Fold F) (F a) Bool)) + (i= 0 (size fold xs))) diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux index 8e59ae941..b286545a7 100644 --- a/source/lux/control/monad.lux +++ b/source/lux/control/monad.lux @@ -6,8 +6,7 @@ (;import lux (.. (functor #as F) (monoid #as M)) - (lux/meta macro - ast)) + (lux/meta macro)) ## [Utils] (def (foldL f init xs) @@ -17,21 +16,21 @@ #;Nil init - (#;Cons [x xs']) + (#;Cons x xs') (foldL f (f init x) xs'))) (def (reverse xs) (All [a] (-> (List a) (List a))) - (foldL (lambda [tail head] (#;Cons [head tail])) + (foldL (lambda [tail head] (#;Cons head tail)) #;Nil xs)) (def (as-pairs xs) (All [a] (-> (List a) (List (, a a)))) (case xs - (#;Cons [x1 (#;Cons [x2 xs'])]) - (#;Cons [[x1 x2] (as-pairs xs')]) + (#;Cons x1 (#;Cons x2 xs')) + (#;Cons [x1 x2] (as-pairs xs')) _ #;Nil)) @@ -50,10 +49,9 @@ ## [Syntax] (defmacro #export (do tokens state) (case tokens - ## (\ (list monad [_ (#;TupleS bindings)] body)) - (#;Cons [monad (#;Cons [[_ (#;TupleS bindings)] (#;Cons [body #;Nil])])]) - (let [g!map (symbol$ ["" " map "]) - g!join (symbol$ ["" " join "]) + (#;Cons monad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil))) + (let [g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])]) + g!join (: AST [["" -1 -1] (#;SymbolS ["" " join "])]) body' (foldL (: (-> AST (, AST AST) AST) (lambda [body' binding] (let [[var value] binding] @@ -82,16 +80,31 @@ (using m (join (map f ma)))) -(def #export (map% m f xs) - (All [m a b] - (-> (Monad m) (-> a (m b)) (List a) (m (List b)))) +(def #export (seq% monad xs) + (All [M a] + (-> (Monad M) (List (M a)) (M (List a)))) + (case xs + #;Nil + (:: monad (;;wrap #;Nil)) + + (#;Cons x xs') + (do monad + [_x x + _xs (seq% monad xs')] + (wrap (#;Cons _x _xs))) + )) + +(def #export (map% monad f xs) + (All [M a b] + (-> (Monad M) (-> a (M b)) (List a) (M (List b)))) + ## (seq% monad (:: monad ;;_functor (F;map f xs))) (case xs #;Nil - (:: m (;;wrap #;Nil)) + (:: monad (;;wrap #;Nil)) - (#;Cons [x xs']) - (do m - [y (f x) - ys (map% m f xs')] - (wrap (#;Cons [y ys]))) + (#;Cons x xs') + (do monad + [_x (f x) + _xs (map% monad f xs')] + (wrap (#;Cons _x _xs))) )) diff --git a/source/lux/data/ident.lux b/source/lux/data/ident.lux new file mode 100644 index 000000000..cb2353e43 --- /dev/null +++ b/source/lux/data/ident.lux @@ -0,0 +1,33 @@ +## 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 (eq #as E) + (show #as S)) + (data (text #open ("text:" Text/Monoid Text/Eq))))) + +## [Types] +## (deftype Ident +## (, Text Text)) + +## [Functions] +(do-template [<name> <side>] + [(def #export (<name> [left right]) + (-> Ident Text) + <side>)] + + [module left] + [name right] + ) + +## [Structures] +(defstruct #export Ident/Eq (E;Eq Ident) + (def (= [xmodule xname] [ymodule yname]) + (and (text:= xmodule ymodule) + (text:= xname yname)))) + +(defstruct #export Ident/Show (S;Show Ident) + (def (show [module name]) + ($ text:++ module ";" name))) diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux index 489ac5b4f..b2049d419 100644 --- a/source/lux/data/list.lux +++ b/source/lux/data/list.lux @@ -8,7 +8,8 @@ (functor #as F #refer #all) (monad #as M #refer #all) (eq #as E) - (ord #as O)) + (ord #as O) + (fold #as f)) (data (number (int #open ("i" Int/Number Int/Ord))) bool) meta/macro)) @@ -39,6 +40,23 @@ (#;Cons [x xs']) (f x (foldR f init xs')))) +(defstruct #export List/Fold (f;Fold List) + (def (foldL f init xs) + (case xs + #;Nil + init + + (#;Cons [x xs']) + (foldL f (f init x) xs'))) + + (def (foldR f init xs) + (case xs + #;Nil + init + + (#;Cons [x xs']) + (f x (foldR f init xs'))))) + (def #export (fold mon xs) (All [a] (-> (m;Monoid a) (List a) a)) @@ -224,13 +242,75 @@ (case (reverse xs) (#;Cons last init) (#;Right state (@list (foldL (: (-> AST AST AST) - (lambda [tail head] (` (#;Cons (~ head) (~ tail))))) - last - init))) + (lambda [tail head] (` (#;Cons (~ head) (~ tail))))) + last + init))) _ (#;Left "Wrong syntax for @list&"))) +## (defmacro #export (zip tokens state) +## (if (i> (size tokens) 0) +## (using List/Functor +## (let [indices (range 0 (i+ 1 (size tokens))) +## vars+lists (map (lambda [idx] +## (let [base (text:++ "_" idx)] +## [[["" -1 -1] (#SymbolS "" base)] +## [["" -1 -1] (#SymbolS "" (text:++ base "s"))]])) +## indices) +## pattern (` [(~@ (map (lambda [[v vs]] (` (#;Cons (~ v) (~ vs)))) +## vars+lists))]) +## g!step [["" -1 -1] (#SymbolS "" "\tstep\t")] +## g!arg [["" -1 -1] (#SymbolS "" "\targ\t")] +## g!blank [["" -1 -1] (#SymbolS "" "\t_\t")] +## code (` ((lambda (~ g!step) [(~ g!arg)] +## (case (~ g!arg) +## (~ pattern) +## (#;Cons [(~@ vars)] ((~ g!step) [(~ (map second vars))])) + +## (~ g!blank) +## #;Nil)) +## [(~@ tokens)]))] +## (#;Right state (@list code)))) +## (#;Left "Can't zip no lists."))) + +## (defmacro #export (zip-with tokens state) +## (case tokens +## (@list& _f tokens) +## (case _f +## [_ (#;SymbolS _)] +## (if (i> (size tokens) 0) +## (using List/Functor +## (let [indices (range 0 (i+ 1 (size tokens))) +## vars+lists (map (lambda [idx] +## (let [base (text:++ "_" idx)] +## [[["" -1 -1] (#SymbolS "" base)] +## [["" -1 -1] (#SymbolS "" (text:++ base "s"))]])) +## indices) +## pattern (` [(~@ (map (lambda [[v vs]] (` (#;Cons (~ v) (~ vs)))) +## vars+lists))]) +## g!step [["" -1 -1] (#SymbolS "" "\tstep\t")] +## g!arg [["" -1 -1] (#SymbolS "" "\targ\t")] +## g!blank [["" -1 -1] (#SymbolS "" "\t_\t")] +## code (` ((lambda (~ g!step) [(~ g!arg)] +## (case (~ g!arg) +## (~ pattern) +## (#;Cons ((~ _f) (~@ vars)) ((~ g!step) [(~ (map second vars))])) + +## (~ g!blank) +## #;Nil)) +## [(~@ tokens)]))] +## (#;Right state (@list code)))) +## (#;Left "Can't zip-with no lists.")) + +## _ +## (let [g!temp [["" -1 -1] (#SymbolS "" "\ttemp\t")]] +## (#;Right state (@list (` (let [(~ g!temp) (~ _f)] +## (;;zip-with (~@ (@list& g!temp tokens))))))))) + +## _ +## (#;Left "Wrong syntax for zip-with"))) + ## [Structures] ## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a)))) ## (def (= xs ys) diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux index 7c0affd68..2db3d768d 100644 --- a/source/lux/data/maybe.lux +++ b/source/lux/data/maybe.lux @@ -4,8 +4,7 @@ ## You can obtain one at http://mozilla.org/MPL/2.0/. (;import lux - (lux (meta macro - ast) + (lux (meta macro) (control (monoid #as m #refer #all) (functor #as F #refer #all) (monad #as M #refer #all))) diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux index e54dff5c0..f701f6079 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -4,8 +4,7 @@ ## You can obtain one at http://mozilla.org/MPL/2.0/. (;import lux - (lux (meta macro - ast) + (lux (meta macro) (control (monoid #as m) (eq #as E) (ord #as O) @@ -151,9 +150,18 @@ [_ in] (split 2 in) post-idx (index-of "}" in) [var post] (split post-idx in) - [_ post] (split 1 post)] + #let [[_ post] (? (: (, Text Text) ["" ""]) + (split 1 post))]] (wrap [pre var post]))) +(do-template [<name> <type> <tag>] + [(def (<name> value) + (-> <type> AST) + [["" -1 -1] (<tag> value)])] + + [text$ Text #;TextS] + [symbol$ Ident #;SymbolS]) + (def (unravel-template template) (-> Text (List AST)) (case (extract-var template) diff --git a/source/lux/data/tuple.lux b/source/lux/data/tuple.lux index f89f9b5ee..6eef74670 100644 --- a/source/lux/data/tuple.lux +++ b/source/lux/data/tuple.lux @@ -24,8 +24,7 @@ (def #export (uncurry f) (All [a b c] - (-> (-> a b c) - (-> (, a b) c))) + (-> (-> a b c) (-> (, a b) c))) (lambda [xy] (let [[x y] xy] (f x y)))) diff --git a/source/lux/math.lux b/source/lux/math.lux index f6fad566f..0f247cea8 100644 --- a/source/lux/math.lux +++ b/source/lux/math.lux @@ -3,7 +3,8 @@ ## 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) +(;import lux + (lux/data/number/int #open ("i:" Int/Number))) ## [Constants] (do-template [<name> <value>] @@ -58,3 +59,22 @@ [atan2 "atan2"] [pow "pow"] ) + +(def (gcd' a b) + (-> Int Int Int) + (case b + 0 a + _ (gcd' b (i:% a b)))) + +(def #export (gcd a b) + (-> Int Int Int) + (gcd' (i:abs a) (i:abs b))) + +(def #export (lcm x y) + (-> Int Int Int) + (case (: (, Int Int) [x y]) + (\or [_ 0] [0 _]) + 0 + + _ + (i:abs (i:* (i:/ x (gcd x y)) y)))) diff --git a/source/lux/meta/ast.lux b/source/lux/meta/ast.lux index a601739a1..78882c854 100644 --- a/source/lux/meta/ast.lux +++ b/source/lux/meta/ast.lux @@ -3,7 +3,17 @@ ## 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) +(;import lux + (lux (control (show #as S #refer #all) + (eq #as E #refer #all)) + (data bool + (number int + real) + char + (text #refer #all #open ("text:" Text/Monoid)) + ident + (list #refer (#only List interpose) #open ("" List/Functor List/Fold)) + ))) ## [Types] ## (deftype (AST' w) @@ -41,3 +51,63 @@ [tuple$ (List AST) #;TupleS] [record$ (List (, AST AST)) #;RecordS] ) + +## [Structures] +(defstruct #export AST/Show (Show AST) + (def (show ast) + (case ast + (\template [<tag> <struct>] + [[_ (<tag> value)] + (:: <struct> (S;show value))]) + [[#;BoolS Bool/Show] + [#;IntS Int/Show] + [#;RealS Real/Show] + [#;CharS Char/Show] + [#;TextS Text/Show]] + + (\template [<tag> <prefix>] + [[_ (<tag> ident)] + (text:++ <prefix> (:: Ident/Show (S;show ident)))]) + [[#;SymbolS ""] [#;TagS "#"]] + + (\template [<tag> <open> <close>] + [[_ (<tag> members)] + ($ text:++ <open> (|> members (map show) (interpose "") (foldL text:++ text:unit)) <close>)]) + [[#;FormS "(" ")"] [#;TupleS "[" "]"]] + + [_ (#;RecordS pairs)] + ($ text:++ "{" (|> pairs (map (lambda [[left right]] ($ text:++ (show left) " " (show right)))) (interpose "") (foldL text:++ text:unit)) "}") + ))) + +## (defstruct #export AST/Eq (Eq AST) +## (def (eq x y) +## (case [x y] +## (\template [<tag> <struct>] +## [[(<tag> x') (<tag> y')] +## (:: <struct> (E;eq x' y'))]) +## [[#;BoolS Bool/Eq] +## [#;IntS Int/Eq] +## [#;RealS Real/Eq] +## [#;CharS Char/Eq] +## [#;TextS Text/Eq] +## [#;SymbolS Ident/Eq] +## [#;TagS Ident/Eq]] + +## (\template [<tag>] +## [[(<tag> xs') (<tag> ys')] +## (and (:: Int/Eq (E;= (size xs') (size ys'))) +## (foldL (lambda [old [x' y']] +## (and old (= x' y'))) +## true +## (zip2 xs' ys')))]) +## [[#;FormS] [#;TupleS]] + +## [(#;RecordS xs') (#;RecordS ys')] +## (and (:: Int/Eq (E;= (size xs') (size ys'))) +## (foldL (lambda [old [[xl' xr'] [yl' yr']]] +## (and old (= xl' yl') (= xr' yr'))) +## true +## (zip2 xs' ys'))) + +## _ +## false))) diff --git a/source/program.lux b/source/program.lux index 69b9e811d..140710a4a 100644 --- a/source/program.lux +++ b/source/program.lux @@ -13,7 +13,8 @@ hash (ord #as O) (show #as S) - number) + number + enum) (data bool char (either #as e) @@ -21,7 +22,7 @@ io list maybe - (number (int #refer (#only)) + (number (int #refer (#only) #open ("i:" Int/Show)) (real #refer (#only))) (text #refer (#only <>) #open ("text:" Text/Monoid)) (writer #refer (#only)) |