aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-05-02 22:31:07 -0400
committerEduardo Julian2019-05-02 22:31:07 -0400
commitc28e3c730241b9a0245aed0725eb0f85491f5c18 (patch)
treeba81976fd4a630f0aa67082f15aca7f252075e3f /stdlib
parent6e14d46da33a9aa5f5627475ac52b84101b234d6 (diff)
Introduced the "#Macro" type and got rid of the "#lux.macro?" annotation type and its "magical" compiler behavior.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux261
-rw-r--r--stdlib/source/lux/macro.lux18
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux14
-rw-r--r--stdlib/source/lux/type.lux77
-rw-r--r--stdlib/source/program/scriptum.lux4
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])))