From 0f358c4052cf766a74b0354124736cb3652cda1d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 15 Sep 2015 02:18:07 -0400 Subject: - :: no longer demands prefixes for the struct members - Fixed both lux/control/comonad;be & lux/codata/stream;\stream --- source/lux.lux | 4 ++-- source/lux/codata/stream.lux | 31 ++++++++++++++++++++----------- source/lux/control/comonad.lux | 19 +++++++++++-------- source/lux/control/monad.lux | 5 ++--- source/lux/control/ord.lux | 8 ++++---- source/lux/data/list.lux | 4 ++-- source/lux/data/number/int.lux | 8 ++++---- source/lux/data/number/real.lux | 8 ++++---- source/lux/data/text.lux | 2 +- source/lux/data/writer.lux | 4 ++-- source/lux/meta/ast.lux | 10 +++++----- source/lux/meta/lux.lux | 20 ++++++++++---------- source/lux/meta/syntax.lux | 6 +++--- 13 files changed, 70 insertions(+), 59 deletions(-) (limited to 'source') diff --git a/source/lux.lux b/source/lux.lux index e155af794..7d00cd077 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -3049,10 +3049,10 @@ (lambda [so-far part] (case part [_ (#SymbolS slot)] - (return (` (get@ (~ (tag$ slot)) (~ so-far)))) + (return (` (using (~ so-far) (~ (symbol$ slot))))) (\ [_ (#FormS (@list& [_ (#SymbolS slot)] args))]) - (return (` ((get@ (~ (tag$ slot)) (~ so-far)) + (return (` ((using (~ so-far) (~ (symbol$ slot))) (~@ args)))) _ diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux index 96de64fd4..1306e3d8b 100644 --- a/source/lux/codata/stream.lux +++ b/source/lux/codata/stream.lux @@ -9,11 +9,13 @@ (comonad #as CM #refer #all)) (meta lux syntax) - (data (list #as l #refer (#only @list @list& List/Monad)) + (data (list #as l #refer (#only @list @list& List/Monad) #open ("" List/Fold)) (number (int #open ("i" Int/Number Int/Ord))) bool) (codata (lazy #as L #refer #all)))) +(open List/Monad "list:") + ## [Types] (deftype #export (Stream a) (Lazy (, a (Stream a)))) @@ -117,15 +119,22 @@ (def _functor Stream/Functor) (def unwrap head) (def (split wa) - (:: Stream/Functor (F;map repeat wa)))) + (let [[head tail] (! wa)] + (... [wa (split tail)])))) ## [Pattern-matching] -(defsyntax #export (\stream body [patterns' (+^ id^)]) - (do Lux/Monad - [patterns (map% Lux/Monad macro-expand-1 patterns') - g!s (gensym "s") - #let [patterns+ (: (List AST) - (do List/Monad - [pattern (l;reverse patterns)] - (: (List AST) (@list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))))]] - (wrap (@list g!s (` (;let [(~@ patterns+)] (~ body))))))) +(defsyntax #export (\stream body [patterns (+^ id^)]) + (case (l;reverse patterns) + (\ (@list& last prevs)) + (do Lux/Monad + [prevs (map% Lux/Monad macro-expand-1 prevs) + g!s (gensym "s") + body+ (foldL (lambda [inner outer] + (` (let [[(~ outer) (~ g!s)] (! (~ g!s))] + (~ inner)))) + (` (let [(~ last) (~ g!s)] (~ body))) + prevs)] + (wrap (@list g!s body+))) + + _ + (fail "Wrong syntax for \\stream"))) diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux index 7ea3b58a9..2543f34da 100644 --- a/source/lux/control/comonad.lux +++ b/source/lux/control/comonad.lux @@ -28,22 +28,25 @@ ## [Syntax] (defmacro #export (be tokens state) (case tokens - (\ (@list comonad [_ (#;TupleS bindings)] body)) - (let [body' (foldL (: (-> AST (, AST AST) AST) + (#;Cons comonad (#;Cons [_ (#;TupleS bindings)] (#;Cons body #;Nil))) + (let [g!map (: AST [["" -1 -1] (#;SymbolS ["" " map "])]) + g!split (: AST [["" -1 -1] (#;SymbolS ["" " split "])]) + body' (foldL (: (-> AST (, AST AST) AST) (lambda [body' binding] (let [[var value] binding] (case var [_ (#;TagS ["" "let"])] - (` (;let (~ value) (~ body'))) + (` (let (~ value) (~ body'))) _ - (` (extend (;lambda [(~ var)] (~ body')) - (~ value))))))) + (` (|> (~ value) (~ g!split) ((~ g!map) (lambda [(~ var)] (~ body'))))) + )))) body (reverse (as-pairs bindings)))] - (#;Right [state (@list (` (;case (~ comonad) - {#;return ;return #;bind ;bind} - (~ body'))))])) + (#;Right [state (#;Cons (` (case (~ comonad) + {#_functor {#F;map (~ g!map)} #unwrap (~ (' unwrap)) #split (~ g!split)} + (~ body'))) + #;Nil)])) _ (#;Left "Wrong syntax for be"))) diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux index 0c7827c34..e5c5989cf 100644 --- a/source/lux/control/monad.lux +++ b/source/lux/control/monad.lux @@ -83,7 +83,7 @@ (-> (Monad M) (List (M a)) (M (List a)))) (case xs #;Nil - (:: monad (;;wrap #;Nil)) + (:: monad (wrap #;Nil)) (#;Cons x xs') (do monad @@ -95,10 +95,9 @@ (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 - (:: monad (;;wrap #;Nil)) + (:: monad (wrap #;Nil)) (#;Cons x xs') (do monad diff --git a/source/lux/control/ord.lux b/source/lux/control/ord.lux index 987356d22..cb77e7042 100644 --- a/source/lux/control/ord.lux +++ b/source/lux/control/ord.lux @@ -24,11 +24,11 @@ (def < <) (def (<= x y) (or (< x y) - (:: eq (E;= x y)))) + (:: eq (= x y)))) (def > >) (def (>= x y) (or (> x y) - (:: eq (E;= x y)))))) + (:: eq (= x y)))))) ## [Functions] (do-template [ ] @@ -37,5 +37,5 @@ (-> (Ord a) a a a)) (if (:: ord ( x y)) x y))] - [max ;;>] - [min ;;<]) + [max >] + [min <]) diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux index e538007bf..7b9d4a60b 100644 --- a/source/lux/data/list.lux +++ b/source/lux/data/list.lux @@ -242,7 +242,7 @@ true [(#;Cons x xs') (#;Cons y ys')] - (and (:: eq (E;= x y)) + (and (:: eq (= x y)) (= xs' ys')) [_ _] @@ -284,7 +284,7 @@ (using ord (let [pre (filter (>= x) xs') post (filter (< x) xs') - ++ (:: List/Monoid m;++)] + ++ (:: List/Monoid ++)] ($ ++ (sort ord pre) (@list x) (sort ord post)))))) ## [Syntax] diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux index ea58cac17..1e71b8a5a 100644 --- a/source/lux/data/number/int.lux +++ b/source/lux/data/number/int.lux @@ -60,8 +60,8 @@ ## Enum (defstruct #export Int/Enum (EN;Enum Int) (def _ord Int/Ord) - (def succ (lambda [n] (:: Int/Number (N;+ n 1)))) - (def pred (lambda [n] (:: Int/Number (N;- n 1))))) + (def succ (lambda [n] (:: Int/Number (+ n 1)))) + (def pred (lambda [n] (:: Int/Number (- n 1))))) ## Bounded (do-template [ ] @@ -79,8 +79,8 @@ [ 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)] + [ IntMax/Monoid Int (:: Int/Bounded bottom) (O;max Int/Ord)] + [ IntMin/Monoid Int (:: Int/Bounded top) (O;min Int/Ord)] ) ## Show diff --git a/source/lux/data/number/real.lux b/source/lux/data/number/real.lux index 7301f2932..7d5243385 100644 --- a/source/lux/data/number/real.lux +++ b/source/lux/data/number/real.lux @@ -60,8 +60,8 @@ ## Enum (defstruct Real/Enum (EN;Enum Real) (def _ord Real/Ord) - (def succ (lambda [n] (:: Real/Number (N;+ n 1.0)))) - (def pred (lambda [n] (:: Real/Number (N;- n 1.0))))) + (def succ (lambda [n] (:: Real/Number (+ n 1.0)))) + (def pred (lambda [n] (:: Real/Number (- n 1.0))))) ## Bounded (do-template [ ] @@ -79,8 +79,8 @@ [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)] + [RealMax/Monoid Real (:: Real/Bounded bottom) (O;max Real/Ord)] + [RealMin/Monoid Real (:: Real/Bounded top) (O;min Real/Ord)] ) ## Show diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux index bbcb42d71..744a22f2e 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -174,7 +174,7 @@ (case tokens (#;Cons [_ (#;TextS template)] #;Nil) (let [++ (symbol$ ["" ""])] - (#;Right state (#;Cons (` (;let [(~ ++) (;:: Text/Monoid m;++)] + (#;Right state (#;Cons (` (;let [(~ ++) (get@ #m;++ Text/Monoid)] (;$ (~ ++) (~@ (unravel-template template))))) #;Nil))) diff --git a/source/lux/data/writer.lux b/source/lux/data/writer.lux index bf26eac9a..3bf99c1ad 100644 --- a/source/lux/data/writer.lux +++ b/source/lux/data/writer.lux @@ -24,8 +24,8 @@ (def _functor Writer/Functor) (def (wrap x) - [(:: mon m;unit) x]) + [(:: mon unit) x]) (def (join mma) (let [[log1 [log2 a]] mma] - [(:: mon (m;++ log1 log2)) a]))) + [(:: mon (++ log1 log2)) a]))) diff --git a/source/lux/meta/ast.lux b/source/lux/meta/ast.lux index 6d9271847..a9bc8b588 100644 --- a/source/lux/meta/ast.lux +++ b/source/lux/meta/ast.lux @@ -58,7 +58,7 @@ (case ast (\template [ ] [[_ ( value)] - (:: (S;show value))]) + (:: (show value))]) [[#;BoolS Bool/Show] [#;IntS Int/Show] [#;RealS Real/Show] @@ -67,7 +67,7 @@ (\template [ ] [[_ ( ident)] - (text:++ (:: Ident/Show (S;show ident)))]) + (text:++ (:: Ident/Show (show ident)))]) [[#;SymbolS ""] [#;TagS "#"]] (\template [ ] @@ -84,7 +84,7 @@ (case [x y] (\template [ ] [[[_ ( x')] [_ ( y')]] - (:: (E;= x' y'))]) + (:: (= x' y'))]) [[#;BoolS Bool/Eq] [#;IntS Int/Eq] [#;RealS Real/Eq] @@ -95,7 +95,7 @@ (\template [] [[[_ ( xs')] [_ ( ys')]] - (and (:: Int/Eq (E;= (size xs') (size ys'))) + (and (:: Int/Eq (= (size xs') (size ys'))) (foldL (lambda [old [x' y']] (and old (= x' y'))) true @@ -103,7 +103,7 @@ [[#;FormS] [#;TupleS]] [[_ (#;RecordS xs')] [_ (#;RecordS ys')]] - (and (:: Int/Eq (E;= (size xs') (size ys'))) + (and (:: Int/Eq (= (size xs') (size ys'))) (foldL (lambda [old [[xl' xr'] [yl' yr']]] (and old (= xl' yl') (= xr' yr'))) true diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux index 66f1a554b..b9e07083f 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -113,7 +113,7 @@ (wrap [module-name name])) _ - (:: Lux/Monad (M;wrap ident)))) + (:: Lux/Monad (wrap ident)))) (def #export (macro-expand syntax) (-> AST (Lux (List AST))) @@ -127,13 +127,13 @@ (do Lux/Monad [expansion (macro args) expansion' (M;map% Lux/Monad macro-expand expansion)] - (wrap (:: List/Monad (M;join expansion')))) + (wrap (:: List/Monad (join expansion')))) #;None - (:: Lux/Monad (M;wrap (@list syntax))))) + (:: Lux/Monad (wrap (@list syntax))))) _ - (:: Lux/Monad (M;wrap (@list syntax))))) + (:: Lux/Monad (wrap (@list syntax))))) (def #export (macro-expand-all syntax) (-> AST (Lux (List AST))) @@ -147,31 +147,31 @@ (do Lux/Monad [expansion (macro args) expansion' (M;map% Lux/Monad macro-expand-all expansion)] - (wrap (:: List/Monad (M;join expansion')))) + (wrap (:: List/Monad (join expansion')))) #;None (do Lux/Monad [parts' (M;map% Lux/Monad macro-expand-all (@list& (symbol$ macro-name) args))] - (wrap (@list (form$ (:: List/Monad (M;join parts')))))))) + (wrap (@list (form$ (:: List/Monad (join parts')))))))) [_ (#;FormS (#;Cons [harg targs]))] (do Lux/Monad [harg+ (macro-expand-all harg) targs+ (M;map% Lux/Monad macro-expand-all targs)] - (wrap (@list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+)))))))) + (wrap (@list (form$ (list:++ harg+ (:: List/Monad (join (: (List (List AST)) targs+)))))))) [_ (#;TupleS members)] (do Lux/Monad [members' (M;map% Lux/Monad macro-expand-all members)] - (wrap (@list (tuple$ (:: List/Monad (M;join members')))))) + (wrap (@list (tuple$ (:: List/Monad (join members')))))) _ - (:: Lux/Monad (M;wrap (@list syntax))))) + (:: Lux/Monad (wrap (@list syntax))))) (def #export (gensym prefix state) (-> Text (Lux AST)) (#;Right [(update@ #;seed (i+ 1) state) - (symbol$ ["" ($ text:++ "__gensym__" prefix (:: I;Int/Show (S;show (get@ #;seed state))))])])) + (symbol$ ["" ($ text:++ "__gensym__" prefix (:: I;Int/Show (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 d47780798..3b9149a74 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -128,11 +128,11 @@ _ (#;Some [tokens false])))] - [ bool?^ Bool #;BoolS (:: b;Bool/Eq E;=)] + [ bool?^ Bool #;BoolS (:: b;Bool/Eq =)] [ int?^ Int #;IntS i=] [ real?^ Real #;RealS r=] - [ char?^ Char #;CharS (:: c;Char/Eq E;=)] - [ text?^ Text #;TextS (:: t;Text/Eq E;=)] + [ char?^ Char #;CharS (:: c;Char/Eq =)] + [ text?^ Text #;TextS (:: t;Text/Eq =)] [symbol?^ Ident #;SymbolS ident:=] [ tag?^ Ident #;TagS ident:=] ) -- cgit v1.2.3