From 99dd3b322777d5abdaa976aa9445c168c234e139 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 May 2015 16:48:54 -0400 Subject: - Fixed escaping in chars - Added 2 custom pattern-matchers (\ & \or) & gensym - Added signatures & structures ^_^ --- source/lux.lux | 206 +++++++++++++++++++++++++++++++++++++++++++---- src/lux/analyser/lux.clj | 6 +- src/lux/lexer.clj | 2 +- 3 files changed, 193 insertions(+), 21 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index 70ebaf67e..ebb801ba6 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -1609,6 +1609,195 @@ _ (fail "Wrong syntax for case"))) +(defmacro #export (\ tokens) + (case tokens + (#Cons [body (#Cons [pattern #Nil])]) + (do Lux:Monad + [pattern+ (macro-expand pattern)] + (case (: (List Syntax) pattern+) + (#Cons [pattern' #Nil]) + (;return (: (List Syntax) (list pattern' body))) + + _ + (fail "\\ can only expand to 1 pattern."))) + + _ + (fail "Wrong syntax for \\"))) + +(defmacro #export (\or tokens) + (case tokens + (#Cons [body patterns]) + (case patterns + #Nil + (fail "\\or can't have 0 patterns") + + _ + (do Lux:Monad + [patterns' (map% Lux:Monad macro-expand patterns)] + (;return (: (List Syntax) (list:join (map (: (-> Syntax (List Syntax)) + (lambda [pattern] + (list pattern body))) + (list:join (: (List (List Syntax)) patterns')))))))) + + _ + (fail "Wrong syntax for \\or"))) + +(do-template [ ] + [(def (int:+ ))] + + [inc 1] + [dec -1]) + +(def #export (int:show int) + (-> Int Text) + (jvm-invokevirtual java.lang.Object toString [] + int [])) + +(def #export (gensym prefix state) + (-> Text (Lux Syntax)) + (case state + {#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed seed} + (#Right [{#source source #modules modules #module-aliases module-aliases + #envs envs #types types #host host + #seed (inc seed)} + ($symbol ["__gensym__" (int:show seed)])]))) + +(def #export (macro-expand-1 token) + (-> Syntax (Lux Syntax)) + (do Lux:Monad + [token+ (macro-expand token)] + (case (: (List Syntax) token+) + (\ (list token')) + (;return token') + + _ + (fail "Macro expanded to more than 1 element.")))) + +(defmacro #export (sig tokens) + (do Lux:Monad + [tokens' (map% Lux:Monad macro-expand-1 tokens) + members (map% Lux:Monad + (: (-> Syntax (Lux (, Ident Syntax))) + (lambda [token] + (case token + (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" ":'"])]) type (#Meta [_ (#Symbol name)])))])) + (do Lux:Monad + [name' (normalize name)] + (;return (: (, Ident Syntax) [name' type]))) + + _ + (fail "Signatures require typed members!")))) + (: (List Syntax) tokens'))] + (;return (: (List Syntax) + (list (` (#;RecordT (list (~@ (map (: (-> (, Ident Syntax) Syntax) + (lambda [pair] + (let [[name type] pair] + (` [(~ (|> name ident->text $text)) + (~ type)])))) + (: (List (, Ident Syntax)) members))))))))))) + +(defmacro #export (defsig tokens) + (let [[export? tokens'] (: (, Bool (List Syntax)) + (case tokens + (\ (list& (#Meta [_ (#Tag ["" "export"])]) tokens')) + [true tokens'] + + _ + [false tokens])) + ?parts (: (Maybe (, Syntax (List Syntax) (List Syntax))) + (case tokens' + (\ (list& (#Meta [_ (#Form (list& name args))]) sigs)) + (#Some [name args sigs]) + + (\ (list& name sigs)) + (#Some [name #Nil sigs]) + + _ + #None))] + (case ?parts + (#Some [name args sigs]) + (let [sigs' (: Syntax (case args + #Nil + (` (;sig (~@ sigs))) + + _ + (` (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))] + (return (: (List Syntax) + (list& (` (def' (~ name) (~ sigs'))) + (if export? + (list (` (export' (~ name)))) + #Nil))))) + + #None + (fail "Wrong syntax for defsig")))) + +(defmacro #export (struct tokens) + (do Lux:Monad + [tokens' (map% Lux:Monad macro-expand-1 tokens) + members (map% Lux:Monad + (: (-> Syntax (Lux (, Syntax Syntax))) + (lambda [token] + (case token + (\ (#Meta [_ (#Form (list (#Meta [_ (#Symbol ["" "def'"])]) (#Meta [_ (#Symbol name)]) value))])) + (do Lux:Monad + [name' (normalize name)] + (;return (: (, Syntax Syntax) [($tag name') value]))) + + _ + (fail "Structures require defined members!")))) + (: (List Syntax) tokens'))] + (;return (: (List Syntax) + (list ($record members)))))) + +(defmacro #export (defstruct tokens) + (let [[export? tokens'] (: (, Bool (List Syntax)) + (case tokens + (\ (list& (#Meta [_ (#Tag ["" "export"])]) tokens')) + [true tokens'] + + _ + [false tokens])) + ?parts (: (Maybe (, Syntax (List Syntax) Syntax (List Syntax))) + (case tokens' + (\ (list& (#Meta [_ (#Form (list& name args))]) type defs)) + (#Some [name args type defs]) + + (\ (list& name type defs)) + (#Some [name #Nil type defs]) + + _ + #None))] + (case ?parts + (#Some [name args type defs]) + (let [defs' (: Syntax (case args + #Nil + (` (;struct (~@ defs))) + + _ + (` (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))] + (return (: (List Syntax) + (list& (` (def (~ name) (~ type) (~ defs'))) + (if export? + (list (` (export' (~ name)))) + #Nil))))) + + #None + (fail "Wrong syntax for defsig")))) + +(defsig #export (Eq a) + (: (-> a a Bool) + =)) + +(do-template [ ] + [(defstruct #export (Eq ) + (def (= x y) + ( x y)))] + + [Int:Eq Int jvm-leq] + [Real:Eq Real jvm-deq]) + ## (def #export (print x) ## (-> Text (IO (,))) ## (io (jvm-invokevirtual java.io.PrintStream print [java.lang.Object] @@ -1626,12 +1815,6 @@ ## ## (~ body))) ## ## (map second pairs)]))))))) -## ## ## (do-template [ ] -## ## ## (def (int+ )) - -## ## ## [inc 1] -## ## ## [dec -1]) - ## ## ## (defmacro (get@ tokens) ## ## ## (let [output (case' tokens ## ## ## (#Cons [tag (#Cons [record #Nil])]) @@ -1668,17 +1851,6 @@ ## ## ## (set@' (~ tag) (func (get@' (~ tag) record)) record))))] ## ## ## (return (list output)))) -## ## (def (show-int int) -## ## (-> Int Text) -## ## (jvm-invokevirtual java.lang.Object "toString" [] -## ## int [])) - -## ## (def gensym -## ## (LuxStateM Syntax) -## ## (lambda [state] -## ## [(update@ [#gen-seed] inc state) -## ## (_meta (#Symbol ($ text-++ "__" (show-int (get@ [#gen-seed] state)) "__")))])) - ## ## (do-template [ ] ## ## (def ( pair) ## ## (case' pair diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 62b99a5b7..b52b816a7 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -264,9 +264,9 @@ (matchv ::M/objects [$def] [["lux;MacroD" macro]] (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))] - (do (when (or (= "type`" ?name) - (= "deftype" ?name)) - (prn 'macro-expansion (str ?module ";" ?name) (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) + (do ;; (when (or (= "type`" ?name) + ;; (= "deftype" ?name)) + ;; (prn 'macro-expansion (str ?module ";" ?name) (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))) (&/flat-map% (partial analyse exo-type) macro-expansion))) [_] diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj index 983d94dc9..f0a8ba91a 100644 --- a/src/lux/lexer.clj +++ b/src/lux/lexer.clj @@ -70,7 +70,7 @@ (def ^:private lex-char (|do [[_ [meta _]] (&reader/read-text "#\"") - token (&/try-all% (&/|list (|do [escaped (&reader/read-regex #"^(\\.)")] + token (&/try-all% (&/|list (|do [[_ [_ escaped]] (&reader/read-regex #"^(\\.)")] (escape-char escaped)) (|do [[_ [_ char]] (&reader/read-regex #"^(.)")] (return char)))) -- cgit v1.2.3