diff options
Diffstat (limited to 'source/lux')
25 files changed, 452 insertions, 193 deletions
diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux new file mode 100644 index 000000000..3c40df188 --- /dev/null +++ b/source/lux/codata/function.lux @@ -0,0 +1,26 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + +(;import lux + (lux/control (monoid #as m))) + +## [Functions] +(def #export (flip f) + (All [a b c] + (-> (-> a b c) (-> b a c))) + (lambda [y x] (f x y))) + +(def #export (. f g) + (All [a b c] + (-> (-> b c) (-> a b) (-> a c))) + (lambda [x] (f (g x)))) + +## [Structures] +(defstruct #export Comp/Monoid (All [a] (m;Monoid (-> a a))) + (def m;unit id) + (def m;++ .)) diff --git a/source/lux/control/lazy.lux b/source/lux/codata/lazy.lux index 22dac74fe..94968de20 100644 --- a/source/lux/control/lazy.lux +++ b/source/lux/codata/lazy.lux @@ -7,10 +7,11 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/meta macro) - (.. (functor #as F #refer #all) - (monad #as M #refer #all)) - (lux/data list)) + (lux (meta macro) + (control (functor #as F #refer #all) + (monad #as M #refer #all)) + (data list)) + (.. function)) ## Types (deftype #export (Lazy a) diff --git a/source/lux/data/reader.lux b/source/lux/codata/reader.lux index e91687c3a..e91687c3a 100644 --- a/source/lux/data/reader.lux +++ b/source/lux/codata/reader.lux diff --git a/source/lux/data/state.lux b/source/lux/codata/state.lux index bc9858a29..bc9858a29 100644 --- a/source/lux/data/state.lux +++ b/source/lux/codata/state.lux diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux index 1d6dd1b50..2c854a61c 100644 --- a/source/lux/codata/stream.lux +++ b/source/lux/codata/stream.lux @@ -7,14 +7,15 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux (control (lazy #as L #refer #all) - (functor #as F #refer #all) + (lux (control (functor #as F #refer #all) (monad #as M #refer #all) (comonad #as CM #refer #all)) (meta lux macro syntax) - (data (list #as l #refer (#only list list& List/Monad))))) + (data (list #as l #refer (#only list list& List/Monad)) + (number (int #open ("i" Int/Number Int/Ord)))) + (codata (lazy #as L #refer #all)))) ## [Types] (deftype #export (Stream a) @@ -59,7 +60,7 @@ (All [a] (-> Int (Stream a) a)) (let [[h t] (! s)] (if (i> idx 0) - (@ (dec idx) t) + (@ (i+ -1 idx) t) h))) (do-template [<taker> <dropper> <splitter> <det-type> <det-test> <det-step>] @@ -89,7 +90,7 @@ [(list) xs])))] [take-while drop-while split-with (-> a Bool) (det x) det] - [take drop split Int (i> det 0) (dec det)] + [take drop split Int (i> det 0) (i+ -1 det)] ) (def #export (unfold step init) diff --git a/source/lux/data/bounded.lux b/source/lux/control/bounded.lux index 9d2dabde1..9d2dabde1 100644 --- a/source/lux/data/bounded.lux +++ b/source/lux/control/bounded.lux diff --git a/source/lux/control/dict.lux b/source/lux/control/dict.lux new file mode 100644 index 000000000..3089ec927 --- /dev/null +++ b/source/lux/control/dict.lux @@ -0,0 +1,21 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + +(;import lux) + +## Signatures +(defsig #export (Dict d) + (: (All [k v] + (-> k (d k v) (Maybe v))) + get) + (: (All [k v] + (-> k v (d k v) (d k v))) + put) + (: (All [k v] + (-> k (d k v) (d k v))) + remove)) diff --git a/source/lux/data/eq.lux b/source/lux/control/eq.lux index be3400208..be3400208 100644 --- a/source/lux/data/eq.lux +++ b/source/lux/control/eq.lux diff --git a/source/lux/control/number.lux b/source/lux/control/number.lux new file mode 100644 index 000000000..40906a8a8 --- /dev/null +++ b/source/lux/control/number.lux @@ -0,0 +1,28 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + +(;import lux + (lux/control (monoid #as m) + (eq #as E) + (ord #as O) + (bounded #as B) + (show #as S))) + +## [Signatures] +(defsig #export (Number n) + (do-template [<name>] + [(: (-> n n n) <name>)] + [+] [-] [*] [/] [%]) + + (do-template [<name>] + [(: (-> n n) <name>)] + [negate] [signum] [abs]) + + (: (-> Int n) + from-int) + ) diff --git a/source/lux/data/ord.lux b/source/lux/control/ord.lux index 80f2e4fb5..80f2e4fb5 100644 --- a/source/lux/data/ord.lux +++ b/source/lux/control/ord.lux diff --git a/source/lux/data/show.lux b/source/lux/control/show.lux index f4e1cf762..f4e1cf762 100644 --- a/source/lux/data/show.lux +++ b/source/lux/control/show.lux diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux index d4f223612..5f4427a2c 100644 --- a/source/lux/data/bool.lux +++ b/source/lux/data/bool.lux @@ -7,9 +7,9 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/control (monoid #as m)) - (.. (eq #as E) - (show #as S))) + (lux/control (monoid #as m) + (eq #as E) + (show #as S))) ## [Structures] (defstruct #export Bool/Eq (E;Eq Bool) diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux index 5a811c006..b97ec644d 100644 --- a/source/lux/data/char.lux +++ b/source/lux/data/char.lux @@ -7,9 +7,9 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (.. (eq #as E) - (show #as S) - (text #as T #open ("text:" Text/Monoid)))) + (lux/control (eq #as E) + (show #as S)) + (.. (text #as T #open ("text:" Text/Monoid)))) ## [Structures] (defstruct #export Char/Eq (E;Eq Char) diff --git a/source/lux/data/cont.lux b/source/lux/data/cont.lux new file mode 100644 index 000000000..51c6ece87 --- /dev/null +++ b/source/lux/data/cont.lux @@ -0,0 +1,41 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## 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))) + +## [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/dict.lux b/source/lux/data/dict.lux deleted file mode 100644 index 63a66d49b..000000000 --- a/source/lux/data/dict.lux +++ /dev/null @@ -1,83 +0,0 @@ -## Copyright (c) Eduardo Julian. All rights reserved. -## The use and distribution terms for this software are covered by the -## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -## which can be found in the file epl-v10.html at the root of this distribution. -## By using this software in any fashion, you are agreeing to be bound by -## the terms of this license. -## You must not remove this notice, or any other, from this software. - -(;import lux - (lux/data (eq #as E))) - -## Signatures -(defsig #export (Dict d) - (: (All [k v] - (-> k (d k v) (Maybe v))) - get) - (: (All [k v] - (-> k v (d k v) (d k v))) - put) - (: (All [k v] - (-> k (d k v) (d k v))) - remove)) - -## Types -(deftype #export (PList k v) - (| (#PList (, (E;Eq k) (List (, k v)))))) - -## Constructors -(def #export (plist eq) - (All [k v] - (-> (E;Eq k) (PList k v))) - (#PList [eq #;Nil])) - -## Utils -(def (pl-get eq k kvs) - (All [k v] - (-> (E;Eq k) k (List (, k v)) (Maybe v))) - (case kvs - #;Nil - #;None - - (#;Cons [[k' v'] kvs']) - (if (:: eq (E;= k k')) - (#;Some v') - (pl-get eq k kvs')))) - -(def (pl-put eq k v kvs) - (All [k v] - (-> (E;Eq k) k v (List (, k v)) (List (, k v)))) - (case kvs - #;Nil - (#;Cons [[k v] kvs]) - - (#;Cons [[k' v'] kvs']) - (if (:: eq (E;= k k')) - (#;Cons [[k v] kvs']) - (#;Cons [[k' v'] (pl-put eq k v kvs')])))) - -(def (pl-remove eq k kvs) - (All [k v] - (-> (E;Eq k) k (List (, k v)) (List (, k v)))) - (case kvs - #;Nil - kvs - - (#;Cons [[k' v'] kvs']) - (if (:: eq (E;= k k')) - kvs' - (#;Cons [[k' v'] (pl-remove eq k kvs')])))) - -## Structs -(defstruct #export PList/Dict (Dict PList) - (def (get k plist) - (let [(#PList [eq kvs]) plist] - (pl-get eq k kvs))) - - (def (put k v plist) - (let [(#PList [eq kvs]) plist] - (#PList [eq (pl-put eq k v kvs)]))) - - (def (remove k plist) - (let [(#PList [eq kvs]) plist] - (#PList [eq (pl-remove eq k kvs)])))) diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux index 0e3bdbee6..3ad6b056b 100644 --- a/source/lux/data/id.lux +++ b/source/lux/data/id.lux @@ -8,7 +8,8 @@ (;import lux (lux/control (functor #as F #refer #all) - (monad #as M #refer #all))) + (monad #as M #refer #all) + (comonad #as CM #refer #all))) ## [Types] (deftype #export (Id a) @@ -23,6 +24,9 @@ (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 (M;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))) diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux index 8fd5c2951..8d6296b14 100644 --- a/source/lux/data/list.lux +++ b/source/lux/data/list.lux @@ -7,17 +7,66 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/control (monoid #as m #refer #all) - (functor #as F #refer #all) - (monad #as M #refer #all)) - lux/meta/macro) + (lux (control (monoid #as m #refer #all) + (functor #as F #refer #all) + (monad #as M #refer #all) + (eq #as E) + (dict #as D #refer #all)) + (data/number (int #open ("i" Int/Number Int/Ord Int/Eq))) + meta/macro)) ## Types ## (deftype (List a) ## (| #Nil ## (#Cons (, a (List a))))) -## Functions +(deftype #export (PList k v) + (| (#PList (, (E;Eq k) (List (, k v)))))) + +## [Utils] +(def (pl-get eq k kvs) + (All [k v] + (-> (E;Eq k) k (List (, k v)) (Maybe v))) + (case kvs + #;Nil + #;None + + (#;Cons [[k' v'] kvs']) + (if (:: eq (E;= k k')) + (#;Some v') + (pl-get eq k kvs')))) + +(def (pl-put eq k v kvs) + (All [k v] + (-> (E;Eq k) k v (List (, k v)) (List (, k v)))) + (case kvs + #;Nil + (#;Cons [[k v] kvs]) + + (#;Cons [[k' v'] kvs']) + (if (:: eq (E;= k k')) + (#;Cons [[k v] kvs']) + (#;Cons [[k' v'] (pl-put eq k v kvs')])))) + +(def (pl-remove eq k kvs) + (All [k v] + (-> (E;Eq k) k (List (, k v)) (List (, k v)))) + (case kvs + #;Nil + kvs + + (#;Cons [[k' v'] kvs']) + (if (:: eq (E;= k k')) + kvs' + (#;Cons [[k' v'] (pl-remove eq k kvs')])))) + +## [Constructors] +(def #export (plist eq) + (All [k v] + (-> (E;Eq k) (PList k v))) + (#PList [eq #;Nil])) + +## [Functions] (def #export (foldL f init xs) (All [a b] (-> (-> a b a) a (List b) a)) @@ -38,6 +87,12 @@ (#;Cons [x xs']) (f x (foldR f init xs')))) +(def #export (fold mon xs) + (All [a] + (-> (m;Monoid a) (List a) a)) + (using mon + (foldL ++ unit xs))) + (def #export (reverse xs) (All [a] (-> (List a) (List a))) @@ -83,8 +138,8 @@ <then>) <else>))] - [take (#;Cons [x (take (dec n) xs')]) #;Nil] - [drop (drop (dec n) xs') xs] + [take (#;Cons [x (take (i+ -1 n) xs')]) #;Nil] + [drop (drop (i+ -1 n) xs') xs] ) (do-template [<name> <then> <else>] @@ -113,7 +168,7 @@ [#;Nil #;Nil] (#;Cons [x xs']) - (let [[tail rest] (split (dec n) xs')] + (let [[tail rest] (split (i+ -1 n) xs')] [(#;Cons [x tail]) rest])) [#;Nil xs])) @@ -139,7 +194,7 @@ (All [a] (-> Int a (List a))) (if (i> n 0) - (#;Cons [x (repeat (dec n) x)]) + (#;Cons [x (repeat (i+ -1 n) x)]) #;Nil)) (def #export (iterate f x) @@ -203,7 +258,7 @@ (#;Cons [x xs']) (if (i= 0 i) (#;Some x) - (@ (dec i) xs')))) + (@ (i+ -1 i) xs')))) ## Syntax (defmacro #export (list xs state) @@ -225,6 +280,17 @@ (#;Left "Wrong syntax for list&"))) ## Structures +## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a)))) +## (def (E;= xs ys) +## (case [xs ys] +## [#;Nil #;Nil] +## true + +## [(#;Cons [x xs']) (#;Cons [y ys'])] +## (and (:: eq (E;= x y)) +## (E;= xs' ys')) +## ))) + (defstruct #export List/Monoid (All [a] (Monoid (List a))) (def m;unit #;Nil) @@ -248,3 +314,16 @@ (def (M;join mma) (using List/Monoid (foldL ++ unit mma)))) + +(defstruct #export PList/Dict (Dict PList) + (def (D;get k plist) + (let [(#PList [eq kvs]) plist] + (pl-get eq k kvs))) + + (def (D;put k v plist) + (let [(#PList [eq kvs]) plist] + (#PList [eq (pl-put eq k v kvs)]))) + + (def (D;remove k plist) + (let [(#PList [eq kvs]) plist] + (#PList [eq (pl-remove eq k kvs)])))) diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux index faec53c2e..396ec470a 100644 --- a/source/lux/data/maybe.lux +++ b/source/lux/data/maybe.lux @@ -7,9 +7,12 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/control (monoid #as m #refer #all) - (functor #as F #refer #all) - (monad #as M #refer #all))) + (.. list) + (lux (control (monoid #as m #refer #all) + (functor #as F #refer #all) + (monad #as M #refer #all)) + (meta lux + syntax))) ## [Types] ## (deftype (Maybe a) @@ -40,3 +43,14 @@ (case mma #;None #;None (#;Some xs) xs))) + +## [Syntax] +(defsyntax #export (? maybe else) + (do Lux/Monad + [g!value (gensym "")] + (M;wrap (list (` (case (~ maybe) + (#;Some (~ g!value)) + (~ g!value) + + _ + (~ else))))))) diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux new file mode 100644 index 000000000..35c8d34bf --- /dev/null +++ b/source/lux/data/number/int.lux @@ -0,0 +1,89 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + +(;import lux + (lux/control (number #as N) + (monoid #as m) + (eq #as E) + (ord #as O) + (bounded #as B) + (show #as S))) + +## [Structures] +## 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) + (<from> x)) + (def (N;negate x) + (<*> <-1> x)) + (def (N;abs x) + (if (<<> x <0>) + (<*> <-1> x) + x)) + (def (N;signum x) + (cond (<=> x <0>) <0> + (<<> x <0>) <-1> + ## else + <1>)) + )] + + [ Int/Number Int _jvm_ladd _jvm_lsub _jvm_lmul _jvm_ldiv _jvm_lrem _jvm_leq _jvm_llt id 0 1 -1]) + +## Eq +(defstruct #export Int/Eq (E;Eq Int) + (def (E;= 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) + (or (<lt> x y) + (<=> x y))) + (def (O;> x y) (<gt> x y)) + (def (O;>= x y) + (or (<gt> x y) + (<=> x y))))] + + [ Int/Ord Int Int/Eq _jvm_leq _jvm_llt _jvm_lgt]) + +## Bounded +(do-template [<name> <type> <top> <bottom>] + [(defstruct #export <name> (B;Bounded <type>) + (def B;top <top>) + (def B;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)))] + + [ IntAdd/Monoid Int 0 _jvm_ladd] + [ IntMul/Monoid Int 1 _jvm_lmul] + [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)] + [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)] + ) + +## Show +(do-template [<name> <type> <body>] + [(defstruct #export <name> (S;Show <type>) + (def (S;show x) + <body>))] + + [ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] + ) diff --git a/source/lux/data/number.lux b/source/lux/data/number/real.lux index 8771ef06e..4f9e4fa5f 100644 --- a/source/lux/data/number.lux +++ b/source/lux/data/number/real.lux @@ -7,75 +7,57 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/control (monoid #as m)) - (.. (eq #as E) - (ord #as O) - (bounded #as B) - (show #as S))) - -## Signatures -(defsig #export (Number n) - (do-template [<name>] - [(: (-> n n n) <name>)] - [+] [-] [*] [/] [%]) - - (: (-> Int n) - from-int) - - (do-template [<name>] - [(: (-> n n) <name>)] - [negate] [signum] [abs]) - ) + (lux/control (number #as N) + (monoid #as m) + (eq #as E) + (ord #as O) + (bounded #as B) + (show #as S))) ## [Structures] ## Number (do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>] - [(defstruct #export <name> (Number <type>) - (def + <+>) - (def - <->) - (def * <*>) - (def / </>) - (def % <%>) - (def (from-int x) + [(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) (<from> x)) - (def (negate x) + (def (N;negate x) (<*> <-1> x)) - (def (abs x) + (def (N;abs x) (if (<<> x <0>) (<*> <-1> x) x)) - (def (signum x) + (def (N;signum x) (cond (<=> x <0>) <0> (<<> x <0>) <-1> ## else <1>)) )] - [ Int/Number Int i+ i- i* i/ i% i= i< id 0 1 -1] - [Real/Number Real r+ r- r* r/ r% r= r< _jvm_l2d 0.0 1.0 -1.0]) + [Real/Number Real _jvm_dadd _jvm_dsub _jvm_dmul _jvm_ddiv _jvm_drem _jvm_deq _jvm_dlt _jvm_l2d 0.0 1.0 -1.0]) ## Eq -(defstruct #export Int/Eq (E;Eq Int) - (def E;= i=)) - (defstruct #export Real/Eq (E;Eq Real) - (def E;= r=)) + (def (E;= x y) (_jvm_deq x y))) ## Ord -(do-template [<name> <type> <eq> <lt> <gt>] +(do-template [<name> <type> <eq> <=> <lt> <gt>] [(defstruct #export <name> (O;Ord <type>) (def O;_eq <eq>) - (def O;< <lt>) + (def (O;< x y) (<lt> x y)) (def (O;<= x y) (or (<lt> x y) - (:: <eq> (E;= x y)))) - (def O;> <gt>) + (<=> x y))) + (def (O;> x y) (<gt> x y)) (def (O;>= x y) (or (<gt> x y) - (:: <eq> (E;= x y)))))] + (<=> x y))))] - [ Int/Ord Int Int/Eq i< i>] - [Real/Ord Real Real/Eq r< r>]) + [Real/Ord Real Real/Eq _jvm_deq _jvm_dlt _jvm_dgt]) ## Bounded (do-template [<name> <type> <top> <bottom>] @@ -83,21 +65,16 @@ (def B;top <top>) (def B;bottom <bottom>))] - [ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")] [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;++ <++>))] + (def (m;++ x y) (<++> x y)))] - [ IntAdd/Monoid Int 0 i+] - [ IntMul/Monoid Int 1 i*] - [RealAdd/Monoid Real 0.0 r+] - [RealMul/Monoid Real 1.0 r*] - [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)] - [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)] + [RealAdd/Monoid Real 0.0 _jvm_dadd] + [RealMul/Monoid Real 1.0 _jvm_dmul] [RealMax/Monoid Real (:: Real/Bounded B;bottom) (O;max Real/Ord)] [RealMin/Monoid Real (:: Real/Bounded B;top) (O;min Real/Ord)] ) @@ -108,6 +85,5 @@ (def (S;show x) <body>))] - [ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] [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 6ad9cfd63..c3cb1ecfb 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -7,10 +7,11 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux/control (monoid #as m)) - (lux/data (eq #as E) - (ord #as O) - (show #as S))) + (lux (control (monoid #as m) + (eq #as E) + (ord #as O) + (show #as S)) + (data/number (int #open ("i" Int/Number Int/Ord Int/Eq))))) ## [Functions] (def #export (size x) diff --git a/source/lux/data/tuple.lux b/source/lux/data/tuple.lux new file mode 100644 index 000000000..5220ad4ac --- /dev/null +++ b/source/lux/data/tuple.lux @@ -0,0 +1,39 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + +(;import lux) + +## [Functions] +(do-template [<name> <type> <output>] + [(def #export (<name> xy) + (All [a b] (-> (, a b) <type>)) + (let [[x y] xy] + <output>))] + + [first a x] + [second b y]) + +(def #export (curry f) + (All [a b c] + (-> (-> (, a b) c) + (-> a b c))) + (lambda [x y] + (f [x y]))) + +(def #export (uncurry f) + (All [a b c] + (-> (-> a b c) + (-> (, a b) c))) + (lambda [xy] + (let [[x y] xy] + (f x y)))) + +(def #export (swap xy) + (All [a b] (-> (, a b) (, b a))) + (let [[x y] xy] + [y x])) diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 7af043969..2c90b1ba3 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -11,7 +11,8 @@ (functor #as F) (monad #as M #refer (#only do))) (data (list #as l #refer #all #open ("" List/Functor)) - (text #as text)) + (text #as text) + (number (int #open ("i" Int/Eq)))) (meta lux macro syntax))) @@ -236,3 +237,16 @@ (emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ m-classes))] [(~@ m-args)])))))) + +(defsyntax #export (->maybe expr) + (do Lux/Monad + [g!val (gensym "")] + (emit (list (` (;let [(~ g!val) (~ expr)] + (;if (null? (~ g!val)) + #;None + (#;Some (~ g!val))))))))) + +(defsyntax #export (try$ expr) + (emit (list (` (try (#;Right (~ expr)) + (~ (' (catch java.lang.Exception e + (#;Left (.! (getMessage [] []) e)))))))))) diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux index 19b7dd9df..13dcae284 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -10,12 +10,11 @@ (.. macro) (lux/control (monoid #as m) (functor #as F) - (monad #as M #refer (#only do))) + (monad #as M #refer (#only do)) + (show #as S)) (lux/data list - maybe - (show #as S) - (number #as N) - (text #as T #open ("text:" Text/Monoid Text/Eq)))) + (text #as T #open ("text:" Text/Monoid Text/Eq)) + (number/int #as I #open ("i" Int/Number)))) ## [Types] ## (deftype (Lux a) @@ -77,20 +76,27 @@ (def (find-macro' modules current-module module name) (-> (List (, Text (Module Compiler))) Text Text Text (Maybe Macro)) - (do Maybe/Monad - [$module (get module modules) - gdef (|> (: (Module Compiler) $module) (get@ #;defs) (get name))] - (case (: (, Bool (DefData' Macro)) gdef) - [exported? (#;MacroD macro')] - (if (or exported? (text:= module current-module)) - (#;Some macro') + (case (get module modules) + (#;Some $module) + (case (|> (: (Module Compiler) $module) (get@ #;defs) (get name)) + (#;Some gdef) + (case (: (, Bool (DefData' Macro)) gdef) + [exported? (#;MacroD macro')] + (if (or exported? (text:= module current-module)) + (#;Some macro') + #;None) + + [_ (#;AliasD [r-module r-name])] + (find-macro' modules current-module r-module r-name) + + _ #;None) - - [_ (#;AliasD [r-module r-name])] - (find-macro' modules current-module r-module r-name) _ - #;None))) + #;None) + + _ + #;None)) (def #export (find-macro ident) (-> Ident (Lux (Maybe Macro))) @@ -147,8 +153,8 @@ (def #export (gensym prefix state) (-> Text (Lux Syntax)) - (#;Right [(update@ #;seed inc state) - (symbol$ ["__gensym__" (:: N;Int/Show (S;show (get@ #;seed state)))])])) + (#;Right [(update@ #;seed (i+ 1) state) + (symbol$ ["__gensym__" (:: I;Int/Show (S;show (get@ #;seed state)))])])) (def #export (emit datum) (All [a] diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index 63ab81475..972999fcb 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -10,12 +10,14 @@ (.. (macro #as m #refer #all) (lux #as l #refer (#only Lux/Monad gensym))) (lux (control (functor #as F) - (monad #as M #refer (#only do))) - (data (eq #as E) - (bool #as b) + (monad #as M #refer (#only do)) + (eq #as E)) + (data (bool #as b) (char #as c) (text #as t #open ("text:" Text/Monoid Text/Eq)) - list))) + list + (number (int #open ("i" Int/Eq)) + (real #open ("r" Real/Eq)))))) ## [Utils] (def (first xy) |