(.module: [lux #* [abstract ["." monad (#+ do)]] [control ["<>" parser ["" code]]] [data ["." maybe] ["." error (#+ Error)] [number ["." nat] ["." int] ["." rev] ["." frac]] ["." text ("#@." monoid)] [collection ["." list ("#@." functor)]]]] ["." // (#+ with-gensyms) ["." code]]) (def: (join-pairs pairs) (All [a] (-> (List [a a]) (List a))) (case pairs #.Nil #.Nil (#.Cons [[x y] pairs']) (list& x y (join-pairs pairs')))) (macro: #export (syntax: tokens) {#.doc (doc "A more advanced way to define macros than 'macro:'." "The inputs to the macro can be parsed in complex ways through the use of syntax parsers." "The macro body is also (implicitly) run in the Meta monad, to save some typing." "Also, the compiler state can be accessed through the *compiler* binding." (syntax: #export (object {#let [imports (class-imports *compiler*)]} {#let [class-vars (list)]} {super (opt (super-class-decl^ imports class-vars))} {interfaces (tuple (some (super-class-decl^ imports class-vars)))} {constructor-args (constructor-args^ imports class-vars)} {methods (some (overriden-method-def^ imports))}) (let [def-code ($_ text@compose "anon-class:" (spaced (list (super-class-decl$ (maybe.default object-super-class super)) (with-brackets (spaced (list@map super-class-decl$ interfaces))) (with-brackets (spaced (list@map constructor-arg$ constructor-args))) (with-brackets (spaced (list@map (method-def$ id) methods))))))] (wrap (list (` ((~ (code.text def-code)))))))))} (let [[exported? tokens] (: [Bit (List Code)] (case tokens (^ (list& [_ (#.Tag ["" "export"])] tokens')) [#1 tokens'] _ [#0 tokens])) ?parts (: (Maybe [Text (List Code) Code Code]) (case tokens (^ (list [_ (#.Form (list& [_ (#.Identifier ["" name])] args))] body)) (#.Some name args (` {}) body) (^ (list [_ (#.Form (list& [_ (#.Identifier ["" name])] args))] meta-data body)) (#.Some name args meta-data body) _ #.None))] (case ?parts (#.Some [name args meta body]) (with-gensyms [g!tokens g!body g!error] (do //.monad [vars+parsers (monad.map @ (: (-> Code (Meta [Code Code])) (function (_ arg) (case arg (^ [_ (#.Record (list [var parser]))]) (wrap [var parser]) [_ (#.Identifier var-name)] (wrap [(code.identifier var-name) (` (~! .any))]) _ (//.fail "Syntax pattern expects records or identifiers.")))) args) this-module //.current-module-name #let [g!state (code.identifier ["" "*compiler*"]) error-msg (code.text (//.wrong-syntax-error [this-module name])) export-ast (: (List Code) (if exported? (list (' #export)) (list)))]] (wrap (list (` (macro: (~+ export-ast) ((~ (code.identifier ["" name])) (~ g!tokens) (~ g!state)) (~ meta) ({(#.Right (~ g!body)) ((~ g!body) (~ g!state)) (#.Left (~ g!error)) (#.Left ((~! text.join-with) ": " (list (~ error-msg) (~ g!error))))} ((~! .run) (~ g!tokens) (: ((~! .Parser) (Meta (List Code))) ((~! do) (~! <>.monad) [(~+ (join-pairs vars+parsers))] ((~' wrap) ((~! do) (~! //.monad) [] (~ body))))))))))))) _ (//.fail (//.wrong-syntax-error (name-of ..syntax:))))))