diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 261 | ||||
| -rw-r--r-- | stdlib/source/lux/macro.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/lux/type.lux | 77 | ||||
| -rw-r--r-- | stdlib/source/program/scriptum.lux | 4 |
5 files changed, 186 insertions, 188 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 0e231eb3a..5022eb2d3 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -782,11 +782,18 @@ (tuple$ (#Cons (text$ "a") #Nil))] default-def-meta-exported)))) -## (type: Macro +## (type: Macro' ## (-> (List Code) (Meta (List Code)))) +("lux def" Macro' + (#Named ["lux" "Macro'"] + (#Function Code-List (#Apply Code-List Meta))) + (record$ default-def-meta-exported)) + +## (type: Macro +## (primitive "#Macro")) ("lux def" Macro (#Named ["lux" "Macro"] - (#Function Code-List (#Apply Code-List Meta))) + (#Primitive "#Macro" #Nil)) (record$ (#Cons [(tag$ ["lux" "doc"]) (text$ "Functions that run at compile-time and allow you to transform and extend the language in powerful ways.")] default-def-meta-exported))) @@ -816,15 +823,8 @@ (#Left msg)))) (record$ #Nil)) -("lux def" default-macro-meta - ("lux check" (#Apply (#Product Code Code) List) - (#Cons [(tag$ ["lux" "macro?"]) - (bit$ #1)] - #Nil)) - (record$ #Nil)) - ("lux def" let'' - ("lux check" Macro + ("lux macro" ([_ tokens] ({(#Cons lhs (#Cons rhs (#Cons body #Nil))) (return (#Cons (form$ (#Cons (record$ (#Cons [lhs body] #Nil)) (#Cons rhs #Nil))) @@ -833,10 +833,10 @@ _ (fail "Wrong syntax for let''")} tokens))) - (record$ default-macro-meta)) + (record$ #.Nil)) ("lux def" function'' - ("lux check" Macro + ("lux macro" ([_ tokens] ({(#Cons [_ (#Tuple (#Cons arg args'))] (#Cons body #Nil)) (return (#Cons (_ann (#Form (#Cons (_ann (#Tuple (#Cons (_ann (#Identifier ["" ""])) @@ -869,7 +869,7 @@ _ (fail "Wrong syntax for function''")} tokens))) - (record$ default-macro-meta)) + (record$ #.Nil)) ("lux def" cursor-code ("lux check" Code @@ -903,11 +903,6 @@ (flag-meta "export?")) (record$ #Nil)) -("lux def" macro?-meta - ("lux check" Code - (flag-meta "macro?")) - (record$ #Nil)) - ("lux def" with-export-meta ("lux check" (#Function Code Code) (function'' [tail] @@ -916,126 +911,107 @@ (#Cons tail #Nil)))))) (record$ #Nil)) -("lux def" with-macro-meta - ("lux check" (#Function Code Code) - (function'' [tail] - (form$ (#Cons (tag$ ["lux" "Cons"]) - (#Cons macro?-meta - (#Cons tail #Nil)))))) - (record$ #Nil)) - ("lux def" doc-meta ("lux check" (#Function Text (#Product Code Code)) (function'' [doc] [(tag$ ["lux" "doc"]) (text$ doc)])) (record$ #Nil)) +("lux def" as-def + ("lux check" (#Function Code (#Function Code (#Function Code Code))) + (function'' [name value annotations] + (form$ (#Cons (text$ "lux def") (#Cons name (#Cons value (#Cons annotations #Nil))))))) + (record$ #Nil)) + +("lux def" as-checked + ("lux check" (#Function Code (#Function Code Code)) + (function'' [type value] + (form$ (#Cons (text$ "lux check") (#Cons type (#Cons value #Nil)))))) + (record$ #Nil)) + +("lux def" as-function + ("lux check" (#Function Code (#Function (#Apply Code List) (#Function Code Code))) + (function'' [self inputs output] + (form$ (#Cons (identifier$ ["lux" "function''"]) + (#Cons self + (#Cons (tuple$ inputs) + (#Cons output #Nil))))))) + (record$ #Nil)) + +("lux def" as-macro + ("lux check" (#Function Code Code) + (function'' [expression] + (form$ (#Cons (text$ "lux macro") + (#Cons expression + #Nil))))) + (record$ #Nil)) + ("lux def" def:'' - ("lux check" Macro + ("lux macro" (function'' [tokens] ({(#Cons [[_ (#Tag ["" "export"])] (#Cons [[_ (#Form (#Cons [name args]))] (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [(_ann (#Form (#Cons [(_ann (#Identifier ["lux" "function''"])) - (#Cons [name - (#Cons [(_ann (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons (form$ (#Cons (identifier$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))) - #Nil)])])]))) + (return (#Cons [(as-def name (as-checked type (as-function name args body)) + (form$ (#Cons (identifier$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil)))) #Nil])) (#Cons [[_ (#Tag ["" "export"])] (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons (form$ (#Cons (identifier$ ["lux" "record$"]) - (#Cons (with-export-meta meta) - #Nil))) - #Nil)])])]))) + (return (#Cons [(as-def name (as-checked type body) + (form$ (#Cons (identifier$ ["lux" "record$"]) + (#Cons (with-export-meta meta) + #Nil)))) #Nil])) (#Cons [[_ (#Form (#Cons [name args]))] (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [(_ann (#Form (#Cons [(_ann (#Identifier ["lux" "function''"])) - (#Cons [name - (#Cons [(_ann (#Tuple args)) - (#Cons [body #Nil])])])]))) - #Nil])])]))) - (#Cons (form$ (#Cons (identifier$ ["lux" "record$"]) - (#Cons meta - #Nil))) - #Nil)])])]))) + (return (#Cons [(as-def name (as-checked type (as-function name args body)) + (form$ (#Cons (identifier$ ["lux" "record$"]) + (#Cons meta + #Nil)))) #Nil])) (#Cons [name (#Cons [meta (#Cons [type (#Cons [body #Nil])])])]) - (return (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux def")) - (#Cons [name - (#Cons [(_ann (#Form (#Cons [(_ann (#Text "lux check")) - (#Cons [type - (#Cons [body - #Nil])])]))) - (#Cons (form$ (#Cons (identifier$ ["lux" "record$"]) - (#Cons meta - #Nil))) - #Nil)])])]))) + (return (#Cons [(as-def name (as-checked type body) + (form$ (#Cons (identifier$ ["lux" "record$"]) + (#Cons meta + #Nil)))) #Nil])) _ (fail "Wrong syntax for def''")} tokens))) - (record$ default-macro-meta)) - -(def:'' (macro:' tokens) - default-macro-meta - Macro - ({(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) - (return (#Cons (form$ (#Cons (identifier$ ["lux" "def:''"]) - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (identifier$ ["lux" "Macro"]) - (#Cons body - #Nil))) - ))) - #Nil)) - - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) - (return (#Cons (form$ (#Cons (identifier$ ["lux" "def:''"]) - (#Cons (local-tag$ "export") - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta (tag$ ["lux" "Nil"])) - (#Cons (identifier$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) - #Nil)) - - (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) - (return (#Cons (form$ (#Cons (identifier$ ["lux" "def:''"]) - (#Cons (local-tag$ "export") - (#Cons (form$ (#Cons name args)) - (#Cons (with-macro-meta meta-data) - (#Cons (identifier$ ["lux" "Macro"]) - (#Cons body - #Nil))) - )))) - #Nil)) + (record$ #.Nil)) - _ - (fail "Wrong syntax for macro:'")} - tokens)) +("lux def" macro:' + ("lux macro" + (function'' [tokens] + ({(#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil)) + (return (#Cons (as-def name (as-macro (as-function name args body)) + (form$ (#Cons (identifier$ ["lux" "record$"]) + (#Cons (tag$ ["lux" "Nil"]) + #Nil)))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons body #Nil))) + (return (#Cons (as-def name (as-macro (as-function name args body)) + (form$ (#Cons (identifier$ ["lux" "record$"]) + (#Cons (with-export-meta (tag$ ["lux" "Nil"])) + #Nil)))) + #Nil)) + + (#Cons [_ (#Tag ["" "export"])] (#Cons [_ (#Form (#Cons name args))] (#Cons meta-data (#Cons body #Nil)))) + (return (#Cons (as-def name (as-macro (as-function name args body)) + (form$ (#Cons (identifier$ ["lux" "record$"]) + (#Cons (with-export-meta meta-data) + #Nil)))) + #Nil)) + + _ + (fail "Wrong syntax for macro:'")} + tokens))) + (record$ #.Nil)) (macro:' #export (comment tokens) (#Cons [(tag$ ["lux" "doc"]) @@ -2624,6 +2600,16 @@ (-> Bit Bit) (if x #0 #1)) +(def:''' (macro-type? type) + (list) + (-> Type Bit) + ({(#Named ["lux" "Macro"] (#Primitive "#Macro" #Nil)) + #1 + + _ + #0} + type)) + (def:''' (find-macro' modules current-module module name) #Nil (-> ($' List (& Text Module)) @@ -2634,7 +2620,7 @@ gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] (get name bindings))] (let' [[def-type def-meta def-value] ("lux check" Definition gdef)] - ({(#Some [_ (#Bit #1)]) + ({#1 ({(#Some [_ (#Bit #1)]) (#Some ("lux coerce" Macro def-value)) @@ -2644,14 +2630,14 @@ #None)} (get-meta ["lux" "export?"] def-meta)) - _ + #0 ({(#Some [_ (#Identifier [r-module r-name])]) (find-macro' modules current-module r-module r-name) _ #None} (get-meta ["lux" "alias"] def-meta))} - (get-meta ["lux" "macro?"] def-meta))) + (macro-type? def-type))) )) (def:''' (normalize name) @@ -2719,7 +2705,7 @@ [macro-name' (normalize macro-name) ?macro (find-macro macro-name')] ({(#Some macro) - (macro args) + (("lux coerce" Macro' macro) args) #None (return (list token))} @@ -2738,7 +2724,7 @@ ?macro (find-macro macro-name')] ({(#Some macro) (do meta-monad - [expansion (macro args) + [expansion (("lux coerce" Macro' macro) args) expansion' (monad@map meta-monad macro-expand expansion)] (wrap (list@join expansion'))) @@ -2759,7 +2745,7 @@ ?macro (find-macro macro-name')] ({(#Some macro) (do meta-monad - [expansion (macro args) + [expansion (("lux coerce" Macro' macro) args) expansion' (monad@map meta-monad macro-expand-all expansion)] (wrap (list@join expansion'))) @@ -3455,36 +3441,39 @@ " _" ..new-line " (fail ''Wrong syntax for name-of'')))"))]) (let [[exported? tokens] (export^ tokens) - name+args+meta+body?? (: (Maybe [Name (List Code) Code Code]) + name+args+meta+body?? (: (Maybe [Name (List Code) (List [Code Code]) Code]) (case tokens (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] body)) - (#Some [name args (` {}) body]) + (#Some [name args (list) body]) (^ (list [_ (#Identifier name)] body)) - (#Some [name #Nil (` {}) body]) + (#Some [name #Nil (list) body]) - (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] [meta-rec-cursor (#Record meta-rec-parts)] body)) - (#Some [name args [meta-rec-cursor (#Record meta-rec-parts)] body]) + (^ (list [_ (#Form (list& [_ (#Identifier name)] args))] [_ (#Record meta-rec-parts)] body)) + (#Some [name args meta-rec-parts body]) - (^ (list [_ (#Identifier name)] [meta-rec-cursor (#Record meta-rec-parts)] body)) - (#Some [name #Nil [meta-rec-cursor (#Record meta-rec-parts)] body]) + (^ (list [_ (#Identifier name)] [_ (#Record meta-rec-parts)] body)) + (#Some [name #Nil meta-rec-parts body]) _ #None))] (case name+args+meta+body?? (#Some [name args meta body]) (let [name (identifier$ name) - def-sig (case args - #Nil name - _ (` ((~ name) (~+ args))))] - (return (list (` (..def: (~+ (export exported?)) - (~ def-sig) - (~ (meta-code-merge (` {#.macro? #1}) - meta)) - - ..Macro - (~ body)))))) - + body (case args + #Nil + body + + _ + (` ("lux macro" + (function ((~ name) (~+ args)) (~ body))))) + =meta (process-def-meta meta)] + (return (list (` ("lux def" (~ name) + (~ body) + [(~ cursor-code) + (#Record (~ (if exported? + (with-export-meta =meta) + =meta)))]))))) #None (fail "Wrong syntax for macro:")))) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index b05b0682f..e5ac9a87a 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -202,7 +202,6 @@ (flag-set? (name-of <tag>)))] [export? #.export? "exported"] - [macro? #.macro? "a macro"] [type? #.type? "a type"] [structure? #.struct? "a structure"] [recursive-type? #.type-rec? "a recursive type"] @@ -247,13 +246,22 @@ [declared-tags #.tags "Looks up the tags of a tagged (variant or record) type."] ) +(def: (macro-type? type) + (-> Type Bit) + (case type + (#.Named ["lux" "Macro"] (#.Primitive "#Macro" #.Nil)) + true + + _ + false)) + (def: (find-macro' modules this-module module name) (-> (List [Text Module]) Text Text Text (Maybe Macro)) (do maybe.monad [$module (get module modules) [def-type def-anns def-value] (: (Maybe Definition) (|> (: Module $module) (get@ #.definitions) (get name)))] - (if (macro? def-anns) + (if (macro-type? def-type) (#.Some (:coerce Macro def-value)) (case (get-identifier-ann (name-of #.alias) def-anns) (#.Some [r-module r-name]) @@ -294,7 +302,7 @@ [?macro (find-macro name)] (case ?macro (#.Some macro) - (macro args) + ((:coerce Macro' macro) args) #.None (:: ..monad wrap (list syntax)))) @@ -313,7 +321,7 @@ (case ?macro (#.Some macro) (do ..monad - [expansion (macro args) + [expansion ((:coerce Macro' macro) args) expansion' (monad.map ..monad expand expansion)] (wrap (list@join expansion'))) @@ -333,7 +341,7 @@ (case ?macro (#.Some macro) (do ..monad - [expansion (macro args) + [expansion ((:coerce Macro' macro) args) expansion' (monad.map ..monad expand-all expansion)] (wrap (list@join expansion'))) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux index dd645886f..c315f8d9d 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux @@ -115,16 +115,15 @@ [lux::coerce Any] ) -(def: lux::check::type - Handler +(def: (caster input output) + (-> Type Type Handler) (function (_ extension-name analyse args) (case args (^ (list valueC)) (do ////.monad - [_ (typeA.infer Type) - valueA (typeA.with-type Type - (analyse valueC))] - (wrap valueA)) + [_ (typeA.infer output)] + (typeA.with-type input + (analyse valueC))) _ (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)])))) @@ -136,7 +135,8 @@ (///bundle.install "try" lux::try) (///bundle.install "check" (lux::check eval)) (///bundle.install "coerce" (lux::coerce eval)) - (///bundle.install "check type" lux::check::type) + (///bundle.install "macro" (..caster .Macro' .Macro)) + (///bundle.install "check type" (..caster .Type .Type)) (///bundle.install "in-module" lux::in-module))) (def: bundle::io diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index c540e6499..fd02c1497 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -169,44 +169,45 @@ (structure: #export equivalence (Equivalence Type) (def: (= x y) - (case [x y] - [(#.Primitive xname xparams) (#.Primitive yname yparams)] - (and (text@= xname yname) - (n/= (list.size yparams) (list.size xparams)) - (list@fold (.function (_ [x y] prev) (and prev (= x y))) - #1 - (list.zip2 xparams yparams))) - - (^template [<tag>] - [(<tag> xid) (<tag> yid)] - (n/= yid xid)) - ([#.Var] [#.Ex] [#.Parameter]) - - (^or [(#.Function xleft xright) (#.Function yleft yright)] - [(#.Apply xleft xright) (#.Apply yleft yright)]) - (and (= xleft yleft) - (= xright yright)) - - [(#.Named xname xtype) (#.Named yname ytype)] - (and (name@= xname yname) - (= xtype ytype)) - - (^template [<tag>] - [(<tag> xL xR) (<tag> yL yR)] - (and (= xL yL) (= xR yR))) - ([#.Sum] [#.Product]) - - (^or [(#.UnivQ xenv xbody) (#.UnivQ yenv ybody)] - [(#.ExQ xenv xbody) (#.ExQ yenv ybody)]) - (and (n/= (list.size yenv) (list.size xenv)) - (= xbody ybody) - (list@fold (.function (_ [x y] prev) (and prev (= x y))) - #1 - (list.zip2 xenv yenv))) - - _ - #0 - ))) + (or (is? x y) + (case [x y] + [(#.Primitive xname xparams) (#.Primitive yname yparams)] + (and (text@= xname yname) + (n/= (list.size yparams) (list.size xparams)) + (list@fold (.function (_ [x y] prev) (and prev (= x y))) + #1 + (list.zip2 xparams yparams))) + + (^template [<tag>] + [(<tag> xid) (<tag> yid)] + (n/= yid xid)) + ([#.Var] [#.Ex] [#.Parameter]) + + (^or [(#.Function xleft xright) (#.Function yleft yright)] + [(#.Apply xleft xright) (#.Apply yleft yright)]) + (and (= xleft yleft) + (= xright yright)) + + [(#.Named xname xtype) (#.Named yname ytype)] + (and (name@= xname yname) + (= xtype ytype)) + + (^template [<tag>] + [(<tag> xL xR) (<tag> yL yR)] + (and (= xL yL) (= xR yR))) + ([#.Sum] [#.Product]) + + (^or [(#.UnivQ xenv xbody) (#.UnivQ yenv ybody)] + [(#.ExQ xenv xbody) (#.ExQ yenv ybody)]) + (and (n/= (list.size yenv) (list.size xenv)) + (= xbody ybody) + (list@fold (.function (_ [x y] prev) (and prev (= x y))) + #1 + (list.zip2 xenv yenv))) + + _ + #0 + )))) (def: #export (apply params func) (-> (List Type) Type (Maybe Type)) diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux index 37205402e..e37d69d1b 100644 --- a/stdlib/source/program/scriptum.lux +++ b/stdlib/source/program/scriptum.lux @@ -21,7 +21,7 @@ ["." sequence (#+ Sequence) ("#;." functor)] ["." list ("#;." functor fold)]]] ["." function] - ["." type] + ["." type ("#@." equivalence)] ["." macro] ["." io (#+ IO io)] [world @@ -280,7 +280,7 @@ (|>> (#.Cons [name def-annotations (:coerce Type def-value)]))) organization) - (macro.macro? def-annotations) + (type@= .Macro def-type) (update@ #macros (: (Mutation (List [Text Code])) (|>> (#.Cons [name def-annotations]))) |