diff options
Diffstat (limited to '')
-rw-r--r-- | source/lux.lux | 84 |
1 files changed, 23 insertions, 61 deletions
diff --git a/source/lux.lux b/source/lux.lux index e9b4484c5..32fde1d8a 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -752,10 +752,6 @@ #Nil ys)) -## (: (All [a b] -## (-> (-> a b) (List a) (List b))) -## map) - (def (splice untemplate tag elems) (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax) (case' (any? spliced? elems) @@ -779,29 +775,6 @@ false (wrap-meta ($form (list tag (untemplate-list (map untemplate elems))))))) -## (def (splice untemplate tag elems) -## (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax) -## (case' (any? spliced? elems) -## true -## (let [elems' (map (:' (->' Syntax Syntax) -## (lambda [elem] -## (case' elem -## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))]) -## spliced - -## _ -## ($form (list ($symbol ["" ":'"]) -## ($symbol ["lux" "SyntaxList"]) -## ($form (list ($symbol ["lux" "list"]) (untemplate elem)))))))) -## elems)] -## (wrap-meta ($form (list tag -## ($form (list& ($symbol ["lux" "$"]) -## ($symbol ["lux" "list:++"]) -## elems')))))) - -## false -## (wrap-meta ($form (list tag (untemplate-list (map untemplate elems))))))) - (def (untemplate token) (->' Syntax Syntax) (case' token @@ -939,18 +912,6 @@ (return (:' SyntaxList (list (` (#TupleT (list (~@ tokens)))))))) -## (: (All [a b] -## (-> (-> a b a) a (List b) a)) -## fold) - -## (: (All [a] -## (-> (List a) (List a))) -## reverse) - -## (: (All [a] -## (-> (List a) (List (, a a)))) -## as-pairs) - (defmacro (do tokens) (case' tokens (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])]) @@ -979,33 +940,39 @@ (-> (B' a) ($' (B' m) (B' b))) ($' List (B' a)) ($' (B' m) ($' List (B' b))))) - (let [{#;return ;return #;bind ;bind} m] + (let [{#;return ;return #;bind _} m] (case' xs #Nil - (;return #Nil) + (;return (:' List #Nil)) (#Cons [x xs']) (do m [y (f x) ys (map% m f xs')] - (;return (#Cons [y ys]))) + (;return (:' List (#Cons [y ys])))) ))) +(def (ident->text ident) + (-> Ident Text) + (let [[module name] ident] + ($ text:++ module ";" name))) + (defmacro #export (| tokens) (do Lux:Monad [pairs (map% Lux:Monad - (lambda [token] - (case' token - (#Tag ident) - (;return (` [(~ ($text (ident->text ident))) (,)])) - - (#Form (#Cons [(#Tag ident) (#Cons [value #Nil])])) - (;return (` [(~ ($text (ident->text ident))) (~ value)])) - - _ - (fail "Wrong syntax for |"))) + (:' (-> Syntax ($' Lux Syntax)) + (lambda [token] + (case' token + (#Meta [_ (#Tag ident)]) + (;return (:' Syntax (` [(~ ($text (ident->text ident))) (,)]))) + + (#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag ident)]) (#Cons [value #Nil])]))]) + (;return (:' Syntax (` [(~ ($text (ident->text ident))) (~ value)]))) + + _ + (fail "Wrong syntax for |")))) tokens)] - (` (#VariantT (list (~@ pairs)))))) + (;return (:' SyntaxList (list (` (#VariantT (list (~@ pairs))))))))) (defmacro #export (& tokens) (if (not (int:= 2 (length tokens))) @@ -1014,13 +981,13 @@ [pairs (map% Lux:Monad (lambda [pair] (case' pair - [(#Tag ident) value] - (;return (` [(~ ($text (ident->text ident))) (~ value)])) + [(#Meta [_ (#Tag ident)]) value] + (;return (:' Syntax (` [(~ ($text (ident->text ident))) (~ value)]))) _ (fail "Wrong syntax for &"))) (as-pairs tokens))] - (` (#RecordT (list (~@ pairs))))))) + (;return (:' SyntaxList (list (` (#RecordT (list (~@ pairs)))))))))) ## (defmacro #export (All tokens) ## (case' (:' (, Ident SyntaxList) @@ -1061,11 +1028,6 @@ ## (fail "Wrong syntax for All")) ## )) -## (def (ident->text ident) -## (->' Ident Text) -## (let [[module name] ident] -## ($ text:++ module ";" name))) - ## (def #export (find-macro ident state) ## (->' Ident ($' Lux Macro)) ## (let [[module name] ident] |