diff options
author | Eduardo Julian | 2015-07-19 23:43:37 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-07-19 23:43:37 -0400 |
commit | 3a760fa6c0f47f7621970b9747779f3edcc96286 (patch) | |
tree | de0e08366eae38ae4602862a39c2829bb5a8fab4 /input | |
parent | f5e3afe5a5337b5dc840ed0fd6a76244cf0aac6b (diff) |
- Added a few more modules.
- Added some type-tags to avoid reflection inside the compiler.
Diffstat (limited to '')
-rw-r--r-- | input/lux/data/bool.lux | 33 | ||||
-rw-r--r-- | input/lux/data/bounded.lux | 9 | ||||
-rw-r--r-- | input/lux/data/char.lux | 20 | ||||
-rw-r--r-- | input/lux/data/eq.lux | 12 | ||||
-rw-r--r-- | input/lux/data/number.lux | 53 | ||||
-rw-r--r-- | input/lux/data/ord.lux | 21 | ||||
-rw-r--r-- | input/lux/data/show.lux | 13 | ||||
-rw-r--r-- | input/lux/data/text.lux | 19 | ||||
-rw-r--r-- | input/lux/host/java.lux | 15 | ||||
-rw-r--r-- | input/lux/meta/lux.lux | 5 | ||||
-rw-r--r-- | input/lux/meta/syntax.lux | 18 | ||||
-rw-r--r-- | input/program.lux | 4 |
12 files changed, 141 insertions, 81 deletions
diff --git a/input/lux/data/bool.lux b/input/lux/data/bool.lux new file mode 100644 index 000000000..d4f223612 --- /dev/null +++ b/input/lux/data/bool.lux @@ -0,0 +1,33 @@ +## 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) + (show #as S))) + +## [Structures] +(defstruct #export Bool/Eq (E;Eq Bool) + (def (E;= x y) + (if x + y + (not y)))) + +(defstruct #export Bool/Show (S;Show Bool) + (def (S;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) + (<op> x y)))] + + [ Or/Monoid false or] + [And/Monoid true and] + ) diff --git a/input/lux/data/bounded.lux b/input/lux/data/bounded.lux index 458fbc0df..9d2dabde1 100644 --- a/input/lux/data/bounded.lux +++ b/input/lux/data/bounded.lux @@ -15,12 +15,3 @@ (: a bottom)) - -## Structure -(do-template [<name> <type> <top> <bottom>] - [(defstruct #export <name> (Bounded <type>) - (def top <top>) - (def 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)]) diff --git a/input/lux/data/char.lux b/input/lux/data/char.lux new file mode 100644 index 000000000..42e57509e --- /dev/null +++ b/input/lux/data/char.lux @@ -0,0 +1,20 @@ +## 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 + (.. (eq #as E) + (show #as S))) + +## [Structures] +(defstruct #export Char/Eq (E;Eq Char) + (def (E;= x y) + (_jvm_ceq x y))) + +(defstruct #export Char/Show (S;Show Char) + (def (S;show x) + ($ text:++ "#\"" (_jvm_invokevirtual java.lang.Object toString [] x []) "\""))) diff --git a/input/lux/data/eq.lux b/input/lux/data/eq.lux index 191e6a885..be3400208 100644 --- a/input/lux/data/eq.lux +++ b/input/lux/data/eq.lux @@ -8,17 +8,7 @@ (;import lux) -## Signatures +## [Signatures] (defsig #export (Eq a) (: (-> a a Bool) =)) - -## Structures -(defstruct #export Bool/Eq (Eq Bool) - (def (= x y) - (case (: (, Bool Bool) [x y]) - (\or [true true] [false false]) - true - - _ - false))) diff --git a/input/lux/data/number.lux b/input/lux/data/number.lux index e1c10d6b0..8da674d88 100644 --- a/input/lux/data/number.lux +++ b/input/lux/data/number.lux @@ -10,7 +10,8 @@ (lux/control (monoid #as m)) (lux/data (eq #as E) (ord #as O) - (bounded #as B))) + (bounded #as B) + (show #as S))) ## Signatures (defsig #export (Number n) @@ -61,11 +62,35 @@ (def E;= r=)) ## Ord -(def #export Int/Ord (O;Ord Int) - (O;ord$ Int/Eq i< i>)) +## (def #export Int/Ord (O;Ord Int) +## (O;ord$ Int/Eq i< i>)) -(def #export Real/Ord (O;Ord Real) - (O;ord$ Real/Eq r< r>)) +## (def #export Real/Ord (O;Ord Real) +## (O;ord$ Real/Eq r< r>)) + +(do-template [<name> <type> <eq> <lt> <gt>] + [(defstruct #export <name> (O;Ord <type>) + (def O;_eq <eq>) + (def O;< <lt>) + (def (O;<= x y) + (or (<lt> x y) + (using <eq> (E;= x y)))) + (def O;> <gt>) + (def (O;>= x y) + (or (<gt> x y) + (using <eq> (E;= x y)))))] + + [ Int/Ord Int Int/Eq i< i>] + [Real/Ord Real Real/Eq r< r>]) + +## 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)] + [Real/Bounded Real (_jvm_getstatic java.lang.Double MAX_VALUE) (_jvm_getstatic java.lang.Double MIN_VALUE)]) ## Monoid (do-template [<name> <type> <unit> <++>] @@ -77,8 +102,18 @@ [ IntMul/Monoid Int 1 i*] [RealAdd/Monoid Real 0.0 r+] [RealMul/Monoid Real 1.0 r*] - [ IntMax/Monoid Int (:: B;Int/Bounded B;bottom) (O;max Int/Ord)] - [ IntMin/Monoid Int (:: B;Int/Bounded B;top) (O;min Int/Ord)] - [RealMax/Monoid Real (:: B;Real/Bounded B;bottom) (O;max Real/Ord)] - [RealMin/Monoid Real (:: B;Real/Bounded B;top) (O;min Real/Ord)] + [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)] + [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)] + [RealMax/Monoid Real (:: Real/Bounded B;bottom) (O;max Real/Ord)] + [RealMin/Monoid Real (:: Real/Bounded B;top) (O;min Real/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 [])] + [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])] ) diff --git a/input/lux/data/ord.lux b/input/lux/data/ord.lux index 60a6cc0a8..80f2e4fb5 100644 --- a/input/lux/data/ord.lux +++ b/input/lux/data/ord.lux @@ -9,20 +9,16 @@ (;import lux (../eq #as E)) -## Signatures +## [Signatures] (defsig #export (Ord a) (: (E;Eq a) _eq) - (: (-> a a Bool) - <) - (: (-> a a Bool) - <=) - (: (-> a a Bool) - >) - (: (-> a a Bool) - >=)) + (do-template [<name>] + [(: (-> a a Bool) <name>)] -## Constructors + [<] [<=] [>] [>=])) + +## [Constructors] (def #export (ord$ eq < >) (All [a] (-> (E;Eq a) (-> a a Bool) (-> a a Bool) (Ord a))) @@ -37,13 +33,12 @@ (or (> x y) (:: eq (E;= x y)))))) -## Functions +## [Functions] (do-template [<name> <op>] [(def #export (<name> ord x y) (All [a] (-> (Ord a) a a a)) - (using ord - (if (<op> x y) x y)))] + (if (:: ord (<op> x y)) x y))] [max ;;>] [min ;;<]) diff --git a/input/lux/data/show.lux b/input/lux/data/show.lux index e081b9239..f4e1cf762 100644 --- a/input/lux/data/show.lux +++ b/input/lux/data/show.lux @@ -12,16 +12,3 @@ (defsig #export (Show a) (: (-> a Text) show)) - -## Structures -(do-template [<name> <type> <body>] - [(defstruct #export <name> (Show <type>) - (def (show x) - <body>))] - - [Bool/Show Bool (_jvm_invokevirtual java.lang.Object toString [] x [])] - [ Int/Show Int (_jvm_invokevirtual java.lang.Object toString [] x [])] - [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])] - [Char/Show Char (let [char (_jvm_invokevirtual java.lang.Object toString [] x [])] - ($ text:++ "#\"" char "\""))] - [Text/Show Text x]) diff --git a/input/lux/data/text.lux b/input/lux/data/text.lux index 5f2203376..a3192a1d5 100644 --- a/input/lux/data/text.lux +++ b/input/lux/data/text.lux @@ -7,8 +7,10 @@ ## 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))) + (ord #as O) + (show #as S))) ## [Functions] (def #export (size x) @@ -24,11 +26,6 @@ x [(_jvm_l2i idx)])) #;None)) -(def #export (++ x y) - (-> Text Text Text) - (_jvm_invokevirtual java.lang.String concat [java.lang.String] - x [y])) - (def #export (contains? x y) (-> Text Text Bool) (_jvm_invokevirtual java.lang.String contains [java.lang.CharSequence] @@ -137,3 +134,13 @@ (i>= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] x [y])) 0))) + +(defstruct #export Text/Show (S;Show Text) + (def (S;show x) + x)) + +(defstruct #export Text/Monoid (m;Monoid Text) + (def m;unit "") + (def (m;++ x y) + (_jvm_invokevirtual java.lang.String concat [java.lang.String] + x [y]))) diff --git a/input/lux/host/java.lux b/input/lux/host/java.lux index 52391201d..12525d3f2 100644 --- a/input/lux/host/java.lux +++ b/input/lux/host/java.lux @@ -7,10 +7,11 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux (data list - (text #as text)) - (control (functor #as F) + (lux (control (monoid #as m) + (functor #as F) (monad #as M #refer (#only do))) + (data list + (text #as text)) (meta lux macro syntax))) @@ -124,8 +125,8 @@ (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) (do Lux/Monad [current-module get-module-name - #let [full-name (text;++ (text;replace "/" "." current-module) - name)]] + #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) + name))]] (let [members' (:: List/Functor (F;map (: (-> (, (List Text) Text (List Text) Text) Syntax) (lambda [member] (let [[modifiers name inputs output] member] @@ -139,8 +140,8 @@ [methods (*^ method-def^)]) (do Lux/Monad [current-module get-module-name - #let [full-name (text;++ (text;replace "/" "." current-module) - name) + #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) + name)) fields' (:: List/Functor (F;map (: (-> (, (List Text) Text Text) Syntax) (lambda [field] (let [[modifiers name class] field] diff --git a/input/lux/meta/lux.lux b/input/lux/meta/lux.lux index 1fc739403..db3c700e6 100644 --- a/input/lux/meta/lux.lux +++ b/input/lux/meta/lux.lux @@ -13,7 +13,8 @@ (monad #as M #refer (#only do))) (lux/data list maybe - (show #as S))) + (show #as S) + (number #as N))) ## [Types] ## (deftype (Lux a) @@ -146,7 +147,7 @@ (def #export (gensym prefix state) (-> Text (Lux Syntax)) (#;Right [(update@ #;seed inc state) - (symbol$ ["__gensym__" (:: S;Int/Show (S;show (get@ #;seed state)))])])) + (symbol$ ["__gensym__" (:: N;Int/Show (S;show (get@ #;seed state)))])])) (def #export (emit datum) (All [a] diff --git a/input/lux/meta/syntax.lux b/input/lux/meta/syntax.lux index 3c9a9ce2e..1fe85c32f 100644 --- a/input/lux/meta/syntax.lux +++ b/input/lux/meta/syntax.lux @@ -11,7 +11,11 @@ (lux #as l #refer (#only Lux/Monad gensym))) (lux (control (functor #as F) (monad #as M #refer (#only do))) - (data list))) + (data (eq #as E) + (bool #as b) + (char #as c) + (text #as t) + list))) ## [Utils] (def (first xy) @@ -95,12 +99,6 @@ [ local-tag^ #;TagS] ) -(def (bool:= x y) - (-> Bool Bool Bool) - (if x - y - (not y))) - (def (ident:= x y) (-> Ident Ident Bool) (let [[x1 x2] x @@ -120,11 +118,11 @@ _ #;None))] - [ bool?^ Bool #;BoolS bool:=] + [ bool?^ Bool #;BoolS (:: b;Bool/Eq E;=)] [ int?^ Int #;IntS i=] [ real?^ Real #;RealS r=] - ## [ char?^ Char #;CharS char:=] - [ text?^ Text #;TextS text:=] + [ char?^ Char #;CharS (:: c;Char/Eq E;=)] + [ text?^ Text #;TextS (:: t;Text/Eq E;=)] [symbol?^ Ident #;SymbolS ident:=] [ tag?^ Ident #;TagS ident:=] ) diff --git a/input/program.lux b/input/program.lux index 1bdb237b1..984d8610f 100644 --- a/input/program.lux +++ b/input/program.lux @@ -13,7 +13,9 @@ monad lazy comonad) - (data bounded + (data bool + bounded + char ## cont dict (either #as e) |