aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux316
-rw-r--r--source/lux/codata/lazy.lux11
-rw-r--r--source/lux/codata/stream.lux2
-rw-r--r--source/lux/control/comonad.lux8
-rw-r--r--source/lux/control/monad.lux2
-rw-r--r--source/lux/data/io.lux15
-rw-r--r--source/lux/data/list.lux6
-rw-r--r--source/lux/data/maybe.lux3
-rw-r--r--source/lux/data/text.lux5
-rw-r--r--source/lux/host/jvm.lux20
-rw-r--r--source/lux/meta/ast.lux46
-rw-r--r--source/lux/meta/lux.lux13
-rw-r--r--source/lux/meta/macro.lux35
-rw-r--r--source/lux/meta/syntax.lux25
-rw-r--r--source/program.lux5
-rw-r--r--src/lux/type.clj30
16 files changed, 286 insertions, 256 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 798742e6f..deb6025ad 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -135,7 +135,7 @@
#Nil]))])]))
(_lux_export Meta)
-## (deftype (Syntax' w)
+## (deftype (AST' w)
## (| (#BoolS Bool)
## (#IntS Int)
## (#RealS Real)
@@ -143,17 +143,17 @@
## (#TextS Text)
## (#SymbolS Text Text)
## (#TagS Text Text)
-## (#FormS (List (w (Syntax' w))))
-## (#TupleS (List (w (Syntax' w))))
-## (#RecordS (List (, (w (Syntax' w)) (w (Syntax' w)))))))
-(_lux_def Syntax'
+## (#FormS (List (w (AST' w))))
+## (#TupleS (List (w (AST' w))))
+## (#RecordS (List (, (w (AST' w)) (w (AST' w)))))))
+(_lux_def AST'
(_lux_case (#AppT [(#BoundT "w")
- (#AppT [(#BoundT "lux;Syntax'")
+ (#AppT [(#BoundT "lux;AST'")
(#BoundT "w")])])
- Syntax
- (_lux_case (#AppT [List Syntax])
- SyntaxList
- (#AllT [(#Some #Nil) "lux;Syntax'" "w"
+ AST
+ (_lux_case (#AppT [List AST])
+ ASTList
+ (#AllT [(#Some #Nil) "lux;AST'" "w"
(#VariantT (#Cons [["lux;BoolS" Bool]
(#Cons [["lux;IntS" Int]
(#Cons [["lux;RealS" Real]
@@ -161,23 +161,23 @@
(#Cons [["lux;TextS" Text]
(#Cons [["lux;SymbolS" Ident]
(#Cons [["lux;TagS" Ident]
- (#Cons [["lux;FormS" SyntaxList]
- (#Cons [["lux;TupleS" SyntaxList]
- (#Cons [["lux;RecordS" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
+ (#Cons [["lux;FormS" ASTList]
+ (#Cons [["lux;TupleS" ASTList]
+ (#Cons [["lux;RecordS" (#AppT [List (#TupleT (#Cons [AST (#Cons [AST #Nil])]))])]
#Nil])
])])])])])])])])])
)]))))
-(_lux_export Syntax')
+(_lux_export AST')
-## (deftype Syntax
-## (Meta Cursor (Syntax' (Meta Cursor))))
-(_lux_def Syntax
+## (deftype AST
+## (Meta Cursor (AST' (Meta Cursor))))
+(_lux_def AST
(_lux_case (#AppT [Meta Cursor])
w
- (#AppT [w (#AppT [Syntax' w])])))
-(_lux_export Syntax)
+ (#AppT [w (#AppT [AST' w])])))
+(_lux_export AST)
-(_lux_def SyntaxList (#AppT [List Syntax]))
+(_lux_def ASTList (#AppT [List AST]))
## (deftype (Either l r)
## (| (#Left l)
@@ -246,16 +246,16 @@
## (deftype (Module Compiler)
## (& #module-aliases (List (, Text Text))
-## #defs (List (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax)))))))
+## #defs (List (, Text (, Bool (DefData' (-> (List AST) (StateE Compiler (List AST)))))))
## #imports (List Text)
## ))
(_lux_def Module
(#AllT [(#Some #Nil) "lux;Module" "Compiler"
(#RecordT (#Cons [["lux;module-aliases" (#AppT [List (#TupleT (#Cons [Text (#Cons [Text #Nil])]))])]
(#Cons [["lux;defs" (#AppT [List (#TupleT (#Cons [Text
- (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [SyntaxList
+ (#Cons [(#TupleT (#Cons [Bool (#Cons [(#AppT [DefData' (#LambdaT [ASTList
(#AppT [(#AppT [StateE (#BoundT "Compiler")])
- SyntaxList])])])
+ ASTList])])])
#Nil])]))
#Nil])]))])]
(#Cons [["lux;imports" (#AppT [List Text])]
@@ -289,11 +289,11 @@
(_lux_export Compiler)
## (deftype Macro
-## (-> (List Syntax) (StateE Compiler (List Syntax))))
+## (-> (List AST) (StateE Compiler (List AST))))
(_lux_def Macro
- (#LambdaT [SyntaxList
+ (#LambdaT [ASTList
(#AppT [(#AppT [StateE Compiler])
- SyntaxList])]))
+ ASTList])]))
(_lux_export Macro)
## Base functions & macros
@@ -304,12 +304,12 @@
(_lux_: Cursor ["" -1 -1]))
## (def (_meta data)
-## (-> (Syntax' (Meta Cursor)) Syntax)
+## (-> (AST' (Meta Cursor)) AST)
## (#Meta [["" -1 -1] data]))
(_lux_def _meta
- (_lux_: (#LambdaT [(#AppT [Syntax'
+ (_lux_: (#LambdaT [(#AppT [AST'
(#AppT [Meta Cursor])])
- Syntax])
+ AST])
(_lux_lambda _ data
(#Meta [_cursor data]))))
@@ -348,37 +348,37 @@
(#Left msg)))))
(_lux_def text$
- (_lux_: (#LambdaT [Text Syntax])
+ (_lux_: (#LambdaT [Text AST])
(_lux_lambda _ text
(_meta (#TextS text)))))
(_lux_def int$
- (_lux_: (#LambdaT [Int Syntax])
+ (_lux_: (#LambdaT [Int AST])
(_lux_lambda _ value
(_meta (#IntS value)))))
(_lux_def symbol$
- (_lux_: (#LambdaT [Ident Syntax])
+ (_lux_: (#LambdaT [Ident AST])
(_lux_lambda _ ident
(_meta (#SymbolS ident)))))
(_lux_def tag$
- (_lux_: (#LambdaT [Ident Syntax])
+ (_lux_: (#LambdaT [Ident AST])
(_lux_lambda _ ident
(_meta (#TagS ident)))))
(_lux_def form$
- (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+ (_lux_: (#LambdaT [(#AppT [List AST]) AST])
(_lux_lambda _ tokens
(_meta (#FormS tokens)))))
(_lux_def tuple$
- (_lux_: (#LambdaT [(#AppT [List Syntax]) Syntax])
+ (_lux_: (#LambdaT [(#AppT [List AST]) AST])
(_lux_lambda _ tokens
(_meta (#TupleS tokens)))))
(_lux_def record$
- (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))]) Syntax])
+ (_lux_: (#LambdaT [(#AppT [List (#TupleT (#Cons [AST (#Cons [AST #Nil])]))]) AST])
(_lux_lambda _ tokens
(_meta (#RecordS tokens)))))
@@ -638,7 +638,7 @@
(fail "Wrong syntax for list&")))
(defmacro (lambda' tokens)
- (let'' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax)))
+ (let'' [name tokens'] (_lux_: (#TupleT (list Ident ($' List AST)))
(_lux_case tokens
(#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
[name tokens']
@@ -722,8 +722,8 @@
(defmacro (let' tokens)
(_lux_case tokens
(#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])
- (return (list (foldL (_lux_: (->' Syntax (#TupleT (list Syntax Syntax))
- Syntax)
+ (return (list (foldL (_lux_: (->' AST (#TupleT (list AST AST))
+ AST)
(lambda' [body binding]
(_lux_case binding
[label value]
@@ -757,7 +757,7 @@
false (any? p xs'))))
(def''' (spliced? token)
- (->' Syntax Bool)
+ (->' AST Bool)
(_lux_case token
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))])
true
@@ -766,13 +766,13 @@
false))
(def''' (wrap-meta content)
- (->' Syntax Syntax)
+ (->' AST AST)
(_meta (#FormS (list (_meta (#TagS ["lux" "Meta"]))
(_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1)))))
content)))))))
(def''' (untemplate-list tokens)
- (->' ($' List Syntax) Syntax)
+ (->' ($' List AST) AST)
(_lux_case tokens
#Nil
(_meta (#TagS ["lux" "Nil"]))
@@ -801,7 +801,7 @@
(fail "Wrong syntax for $")))
(def''' (splice replace? untemplate tag elems)
- (->' Bool (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
+ (->' Bool (->' AST AST) AST ($' List AST) AST)
(_lux_case replace?
true
(_lux_case (any? spliced? elems)
@@ -813,7 +813,7 @@
_
(form$ (list (symbol$ ["" "_lux_:"])
- (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "Syntax"])))))
+ (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "AST"])))))
(form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list (untemplate elem)
(tag$ ["lux" "Nil"])))))))))
elems)]
@@ -828,8 +828,8 @@
(wrap-meta (form$ (list tag (untemplate-list (map untemplate elems)))))))
(def''' (untemplate replace? subst token)
- (->' Bool Text Syntax Syntax)
- (_lux_case (_lux_: (#TupleT (list Bool Syntax)) [replace? token])
+ (->' Bool Text AST AST)
+ (_lux_case (_lux_: (#TupleT (list Bool AST)) [replace? token])
[_ (#Meta [_ (#BoolS value)])]
(wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))
@@ -875,7 +875,7 @@
[_ (#Meta [_ (#RecordS fields)])]
(wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
- (untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax)
+ (untemplate-list (map (_lux_: (->' (#TupleT (list AST AST)) AST)
(lambda' [kv]
(let' [[k v] kv]
(tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
@@ -1000,7 +1000,7 @@
(defmacro (do tokens)
(_lux_case tokens
(#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])])
- (let' [body' (foldL (_lux_: (-> Syntax (, Syntax Syntax) Syntax)
+ (let' [body' (foldL (_lux_: (-> AST (, AST AST) AST)
(lambda' [body' binding]
(let' [[var value] binding]
(_lux_case var
@@ -1048,7 +1048,7 @@
(f (g x))))
(def''' (get-ident x)
- (-> Syntax ($' Maybe Ident))
+ (-> AST ($' Maybe Ident))
(_lux_case x
(#Meta [_ (#SymbolS sname)])
(#Some sname)
@@ -1057,7 +1057,7 @@
#None))
(def''' (get-name x)
- (-> Syntax ($' Maybe Text))
+ (-> AST ($' Maybe Text))
(_lux_case x
(#Meta [_ (#SymbolS ["" sname])])
(#Some sname)
@@ -1066,7 +1066,7 @@
#None))
(def''' (tuple->list tuple)
- (-> Syntax ($' Maybe ($' List Syntax)))
+ (-> AST ($' Maybe ($' List AST)))
(_lux_case tuple
(#Meta [_ (#TupleS members)])
(#Some members)
@@ -1076,11 +1076,11 @@
(def''' RepEnv
Type
- ($' List (, Text Syntax)))
+ ($' List (, Text AST)))
(def''' (make-env xs ys)
- (-> ($' List Text) ($' List Syntax) RepEnv)
- (_lux_case (_lux_: (, ($' List Text) ($' List Syntax))
+ (-> ($' List Text) ($' List AST) RepEnv)
+ (_lux_case (_lux_: (, ($' List Text) ($' List AST))
[xs ys])
[(#Cons [x xs']) (#Cons [y ys'])]
(#Cons [[x y] (make-env xs' ys')])
@@ -1094,7 +1094,7 @@
x [y]))
(def''' (get-rep key env)
- (-> Text RepEnv ($' Maybe Syntax))
+ (-> Text RepEnv ($' Maybe AST))
(_lux_case env
#Nil
#None
@@ -1105,7 +1105,7 @@
(get-rep key env'))))
(def''' (apply-template env template)
- (-> RepEnv Syntax Syntax)
+ (-> RepEnv AST AST)
(_lux_case template
(#Meta [_ (#SymbolS ["" sname])])
(_lux_case (get-rep sname env)
@@ -1122,7 +1122,7 @@
(form$ (map (apply-template env) elems))
(#Meta [_ (#RecordS members)])
- (record$ (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
+ (record$ (map (_lux_: (-> (, AST AST) (, AST AST))
(lambda' [kv]
(let' [[slot value] kv]
[(apply-template env slot) (apply-template env value)])))
@@ -1144,11 +1144,11 @@
(defmacro #export (do-template tokens)
(_lux_case tokens
(#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS templates)]) data])])
- (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax))))
+ (_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List AST))))
[(map% Maybe/Monad get-name bindings)
(map% Maybe/Monad tuple->list data)])
[(#Some bindings') (#Some data')]
- (let' [apply (_lux_: (-> RepEnv ($' List Syntax))
+ (let' [apply (_lux_: (-> RepEnv ($' List AST))
(lambda' [env] (map (apply-template env) templates)))]
(|> data'
(join-map (. apply (make-env bindings')))
@@ -1226,7 +1226,7 @@
($ text:++ module ";" name)))
(def''' (replace-syntax reps syntax)
- (-> RepEnv Syntax Syntax)
+ (-> RepEnv AST AST)
(_lux_case syntax
(#Meta [_ (#SymbolS ["" name])])
(_lux_case (get-rep name reps)
@@ -1243,7 +1243,7 @@
(#Meta [_ (#TupleS (map (replace-syntax reps) members))])
(#Meta [_ (#RecordS slots)])
- (#Meta [_ (#RecordS (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
+ (#Meta [_ (#RecordS (map (_lux_: (-> (, AST AST) (, AST AST))
(lambda' [slot]
(let' [[k v] slot]
[(replace-syntax reps k) (replace-syntax reps v)])))
@@ -1254,7 +1254,7 @@
)
(defmacro #export (All tokens)
- (let' [[self-ident tokens'] (_lux_: (, Text SyntaxList)
+ (let' [[self-ident tokens'] (_lux_: (, Text ASTList)
(_lux_case tokens
(#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens'])
[self-ident tokens']
@@ -1270,7 +1270,7 @@
(return (list body))
(#Cons [harg targs])
- (let' [replacements (map (_lux_: (-> Text (, Text Syntax))
+ (let' [replacements (map (_lux_: (-> Text (, Text AST))
(lambda' [ident] [ident (`' (#;BoundT (~ (text$ ident))))]))
(list& self-ident idents))
body' (foldL (lambda' [body' arg']
@@ -1377,7 +1377,7 @@
(defmacro #export (| tokens)
(do Lux/Monad
[pairs (map% Lux/Monad
- (_lux_: (-> Syntax ($' Lux Syntax))
+ (_lux_: (-> AST ($' Lux AST))
(lambda' [token]
(_lux_case token
(#Meta [_ (#TagS ident)])
@@ -1388,7 +1388,7 @@
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) values]))])
(do Lux/Monad
[ident (normalize ident)
- #let [case-body (_lux_: Syntax
+ #let [case-body (_lux_: AST
(_lux_case values
#Nil (`' Unit)
(#Cons value #Nil) value
@@ -1405,7 +1405,7 @@
(fail "& expects an even number of arguments.")
(do Lux/Monad
[pairs (map% Lux/Monad
- (_lux_: (-> (, Syntax Syntax) ($' Lux Syntax))
+ (_lux_: (-> (, AST AST) ($' Lux AST))
(lambda' [pair]
(_lux_case pair
[(#Meta [_ (#TagS ident)]) value]
@@ -1436,7 +1436,7 @@
(list& x sep (interpose sep xs'))))
(def''' (macro-expand token)
- (-> Syntax ($' Lux ($' List Syntax)))
+ (-> AST ($' Lux ($' List AST)))
(_lux_case token
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
(do Lux/Monad
@@ -1456,7 +1456,7 @@
(return (list token))))
(def''' (macro-expand-all syntax)
- (-> Syntax ($' Lux ($' List Syntax)))
+ (-> AST ($' Lux ($' List AST)))
(_lux_case syntax
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
(do Lux/Monad
@@ -1489,7 +1489,7 @@
(return (list syntax))))
(def''' (walk-type type)
- (-> Syntax Syntax)
+ (-> AST AST)
(_lux_case type
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS tag)]) parts]))])
(form$ (#Cons [(tag$ tag) (map walk-type parts)]))
@@ -1543,21 +1543,21 @@
_ false))
(defmacro #export (deftype tokens)
- (let' [[export? tokens'] (: (, Bool (List Syntax))
+ (let' [[export? tokens'] (: (, Bool (List AST))
(_lux_case tokens
(#Cons (#Meta _ (#TagS "" "export")) tokens')
[true tokens']
_
[false tokens]))
- [rec? tokens'] (: (, Bool (List Syntax))
+ [rec? tokens'] (: (, Bool (List AST))
(_lux_case tokens'
(#Cons (#Meta _ (#TagS "" "rec")) tokens')
[true tokens']
_
[false tokens']))
- parts (: (Maybe (, Text (List Syntax) Syntax))
+ parts (: (Maybe (, Text (List AST) AST))
(_lux_case tokens'
(#Cons (#Meta _ (#SymbolS "" name)) (#Cons type #Nil))
(#Some name #Nil type)
@@ -1569,11 +1569,11 @@
#None))]
(_lux_case parts
(#Some name args type)
- (let' [with-export (: (List Syntax)
+ (let' [with-export (: (List AST)
(if export?
(list (`' (_lux_export (~ (symbol$ ["" name])))))
#Nil))
- type' (: (Maybe Syntax)
+ type' (: (Maybe AST)
(if rec?
(if (empty? args)
(let' [g!param (symbol$ ["" ""])
@@ -1600,14 +1600,14 @@
(fail "Wrong syntax for deftype"))
))
## (defmacro #export (deftype tokens)
-## (let' [[export? tokens'] (: (, Bool (List Syntax))
-## (_lux_case (:! (List Syntax) tokens)
+## (let' [[export? tokens'] (: (, Bool (List AST))
+## (_lux_case (:! (List AST) tokens)
## (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
-## [true (:! (List Syntax) tokens')]
+## [true (:! (List AST) tokens')]
## _
-## [false (:! (List Syntax) tokens)]))
-## parts (: (Maybe (, Syntax (List Syntax) Syntax))
+## [false (:! (List AST) tokens)]))
+## parts (: (Maybe (, AST (List AST) AST))
## (_lux_case tokens'
## (#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
## (#Some [(symbol$ name) #Nil type])
@@ -1619,11 +1619,11 @@
## #None))]
## (_lux_case parts
## (#Some name args type])
-## (let' [with-export (: (List Syntax)
+## (let' [with-export (: (List AST)
## (if export?
## (list (`' (_lux_export (~ name))))
## #Nil))
-## type' (: Syntax
+## type' (: AST
## (_lux_case args
## #Nil
## type
@@ -1649,14 +1649,14 @@
(fail "Wrong syntax for exec")))
(defmacro (def' tokens)
- (let' [[export? tokens'] (: (, Bool (List Syntax))
+ (let' [[export? tokens'] (: (, Bool (List AST))
(_lux_case tokens
(#Cons (#Meta _ (#TagS "" "export")) tokens')
[true tokens']
_
[false tokens]))
- parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+ parts (: (Maybe (, AST (List AST) (Maybe AST) AST))
(_lux_case tokens'
(#Cons (#Meta _ (#FormS (#Cons name args))) (#Cons type (#Cons body #Nil)))
(#Some name args (#Some type) body)
@@ -1674,14 +1674,14 @@
#None))]
(_lux_case parts
(#Some name args ?type body)
- (let' [body' (: Syntax
+ (let' [body' (: AST
(_lux_case args
#Nil
body
_
(`' (;lambda' (~ name) [(~@ args)] (~ body)))))
- body'' (: Syntax
+ body'' (: AST
(_lux_case ?type
(#Some type)
(`' (: (~ type) (~ body')))
@@ -1697,7 +1697,7 @@
(fail "Wrong syntax for def'"))))
(def' (rejoin-pair pair)
- (-> (, Syntax Syntax) (List Syntax))
+ (-> (, AST AST) (List AST))
(let' [[left right] pair]
(list left right)))
@@ -1706,7 +1706,7 @@
(#Cons value branches)
(do Lux/Monad
[expansions (map% Lux/Monad
- (: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
+ (: (-> (, AST AST) (Lux (List (, AST AST))))
(lambda' expander [branch]
(let' [[pattern body] branch]
(_lux_case pattern
@@ -1767,7 +1767,7 @@
(fail "Wrong syntax for `"))))
(def' (symbol? ast)
- (-> Syntax Bool)
+ (-> AST Bool)
(case ast
(#Meta _ (#SymbolS _))
true
@@ -1780,7 +1780,7 @@
(\ (list (#Meta _ (#TupleS bindings)) body))
(if (multiple? 2 (length bindings))
(|> bindings as-pairs reverse
- (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (foldL (: (-> AST (, AST AST) AST)
(lambda' [body' lr]
(let' [[l r] lr]
(if (symbol? l)
@@ -1795,7 +1795,7 @@
(fail "Wrong syntax for let")))
(def' (ast:show ast)
- (-> Syntax Text)
+ (-> AST Text)
(case ast
(#Meta _ ast)
(case ast
@@ -1823,7 +1823,7 @@
(#RecordS kvs)
($ text:++ "{"
(|> kvs
- (map (: (-> (, Syntax Syntax) Text)
+ (map (: (-> (, AST AST) Text)
(lambda' [kv] (let [[k v] kv] ($ text:++ (ast:show k) " " (ast:show v))))))
(interpose " ")
(foldL text:++ ""))
@@ -1831,7 +1831,7 @@
)))
(defmacro #export (lambda tokens)
- (case (: (Maybe (, Ident Syntax (List Syntax) Syntax))
+ (case (: (Maybe (, Ident AST (List AST) AST))
(case tokens
(\ (list (#Meta _ (#TupleS (#Cons head tail))) body))
(#Some ["" ""] head tail body)
@@ -1844,7 +1844,7 @@
(#Some ident head tail body)
(let [g!blank (symbol$ ["" ""])
g!name (symbol$ ident)
- body+ (: Syntax (foldL (: (-> Syntax Syntax Syntax)
+ body+ (: AST (foldL (: (-> AST AST AST)
(lambda' [body' arg]
(if (symbol? arg)
(` (_lux_lambda (~ g!blank) (~ arg) (~ body')))
@@ -1860,14 +1860,14 @@
(fail "Wrong syntax for lambda")))
(defmacro #export (def tokens)
- (let [[export? tokens'] (: (, Bool (List Syntax))
+ (let [[export? tokens'] (: (, Bool (List AST))
(case tokens
(#Cons (#Meta _ (#TagS "" "export")) tokens')
[true tokens']
_
[false tokens]))
- parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+ parts (: (Maybe (, AST (List AST) (Maybe AST) AST))
(case tokens'
(\ (list (#Meta _ (#FormS (#Cons name args))) type body))
(#Some name args (#Some type) body)
@@ -1885,14 +1885,14 @@
#None))]
(case parts
(#Some name args ?type body)
- (let [body (: Syntax
+ (let [body (: AST
(case args
#Nil
body
_
(` (;lambda (~ name) [(~@ args)] (~ body)))))
- body (: Syntax
+ body (: AST
(case ?type
(#Some type)
(` (: (~ type) (~ body)))
@@ -1908,7 +1908,7 @@
(fail "Wrong syntax for def"))))
(def (gensym prefix state)
- (-> Text (Lux Syntax))
+ (-> Text (Lux AST))
(case state
{#source source #modules modules
#envs envs #types types #host host
@@ -1922,18 +1922,18 @@
(do Lux/Monad
[tokens' (map% Lux/Monad macro-expand tokens)
members (map% Lux/Monad
- (: (-> Syntax (Lux (, Ident Syntax)))
+ (: (-> AST (Lux (, Ident AST)))
(lambda [token]
(case token
(\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_:")) type (#Meta _ (#SymbolS name))))))
(do Lux/Monad
[name' (normalize name)]
- (;return (: (, Ident Syntax) [name' type])))
+ (;return (: (, Ident AST) [name' type])))
_
(fail "Signatures require typed members!"))))
(list:join tokens'))]
- (;return (list (` (#;RecordT (~ (untemplate-list (map (: (-> (, Ident Syntax) Syntax)
+ (;return (list (` (#;RecordT (~ (untemplate-list (map (: (-> (, Ident AST) AST)
(lambda [pair]
(let [[name type] pair]
(` [(~ (|> name ident->text text$))
@@ -1941,14 +1941,14 @@
members)))))))))
(defmacro #export (defsig tokens)
- (let [[export? tokens'] (: (, Bool (List Syntax))
+ (let [[export? tokens'] (: (, Bool (List AST))
(case tokens
(\ (list& (#Meta _ (#TagS "" "export")) tokens'))
[true tokens']
_
[false tokens]))
- ?parts (: (Maybe (, Syntax (List Syntax) (List Syntax)))
+ ?parts (: (Maybe (, AST (List AST) (List AST)))
(case tokens'
(\ (list& (#Meta _ (#FormS (list& name args))) sigs))
(#Some name args sigs)
@@ -1960,7 +1960,7 @@
#None))]
(case ?parts
(#Some name args sigs)
- (let [sigs' (: Syntax
+ (let [sigs' (: AST
(case args
#Nil
(` (;sig (~@ sigs)))
@@ -1979,13 +1979,13 @@
(do Lux/Monad
[tokens' (map% Lux/Monad macro-expand tokens)
members (map% Lux/Monad
- (: (-> Syntax (Lux (, Syntax Syntax)))
+ (: (-> AST (Lux (, AST AST)))
(lambda [token]
(case token
(\ (#Meta _ (#FormS (list (#Meta _ (#SymbolS _ "_lux_def")) (#Meta _ (#SymbolS name)) value))))
(do Lux/Monad
[name' (normalize name)]
- (;return (: (, Syntax Syntax) [(tag$ name') value])))
+ (;return (: (, AST AST) [(tag$ name') value])))
_
(fail "Structures require defined members"))))
@@ -1993,14 +1993,14 @@
(;return (list (record$ members)))))
(defmacro #export (defstruct tokens)
- (let [[export? tokens'] (: (, Bool (List Syntax))
+ (let [[export? tokens'] (: (, Bool (List AST))
(case tokens
(\ (list& (#Meta _ (#TagS "" "export")) tokens'))
[true tokens']
_
[false tokens]))
- ?parts (: (Maybe (, Syntax (List Syntax) Syntax (List Syntax)))
+ ?parts (: (Maybe (, AST (List AST) AST (List AST)))
(case tokens'
(\ (list& (#Meta _ (#FormS (list& name args))) type defs))
(#Some name args type defs)
@@ -2012,7 +2012,7 @@
#None))]
(case ?parts
(#Some name args type defs)
- (let [defs' (: Syntax
+ (let [defs' (: AST
(case args
#Nil
(` (;struct (~@ defs)))
@@ -2058,9 +2058,9 @@
(, Text (Maybe Text) Referrals (Maybe Openings)))
(def (extract-defs defs)
- (-> (List Syntax) (Lux (List Text)))
+ (-> (List AST) (Lux (List Text)))
(map% Lux/Monad
- (: (-> Syntax (Lux Text))
+ (: (-> AST (Lux Text))
(lambda [def]
(case def
(#Meta _ (#SymbolS "" name))
@@ -2071,40 +2071,40 @@
defs))
(def (parse-alias tokens)
- (-> (List Syntax) (Lux (, (Maybe Text) (List Syntax))))
+ (-> (List AST) (Lux (, (Maybe Text) (List AST))))
(case tokens
(\ (list& (#Meta _ (#TagS "" "as")) (#Meta _ (#SymbolS "" alias)) tokens'))
- (return (: (, (Maybe Text) (List Syntax)) [(#Some alias) tokens']))
+ (return (: (, (Maybe Text) (List AST)) [(#Some alias) tokens']))
_
- (return (: (, (Maybe Text) (List Syntax)) [#None tokens]))))
+ (return (: (, (Maybe Text) (List AST)) [#None tokens]))))
(def (parse-referrals tokens)
- (-> (List Syntax) (Lux (, Referrals (List Syntax))))
+ (-> (List AST) (Lux (, Referrals (List AST))))
(case tokens
(\ (list& (#Meta _ (#TagS "" "refer")) referral tokens'))
(case referral
(#Meta _ (#TagS "" "all"))
- (return (: (, Referrals (List Syntax)) [#All tokens']))
+ (return (: (, Referrals (List AST)) [#All tokens']))
(\ (#Meta _ (#FormS (list& (#Meta _ (#TagS "" "only")) defs))))
(do Lux/Monad
[defs' (extract-defs defs)]
- (return (: (, Referrals (List Syntax)) [(#Only defs') tokens'])))
+ (return (: (, Referrals (List AST)) [(#Only defs') tokens'])))
(\ (#Meta _ (#FormS (list& (#Meta _ (#TagS "" "exclude")) defs))))
(do Lux/Monad
[defs' (extract-defs defs)]
- (return (: (, Referrals (List Syntax)) [(#Exclude defs') tokens'])))
+ (return (: (, Referrals (List AST)) [(#Exclude defs') tokens'])))
_
(fail "Incorrect syntax for referral."))
_
- (return (: (, Referrals (List Syntax)) [#Nothing tokens]))))
+ (return (: (, Referrals (List AST)) [#Nothing tokens]))))
(def (extract-symbol syntax)
- (-> Syntax (Lux Ident))
+ (-> AST (Lux Ident))
(case syntax
(#Meta _ (#SymbolS ident))
(return ident)
@@ -2113,20 +2113,20 @@
(fail "Not a symbol.")))
(def (parse-openings tokens)
- (-> (List Syntax) (Lux (, (Maybe Openings) (List Syntax))))
+ (-> (List AST) (Lux (, (Maybe Openings) (List AST))))
(case tokens
(\ (list& (#Meta _ (#TagS "" "open")) (#Meta _ (#FormS (list& (#Meta _ (#TextS prefix)) structs))) tokens'))
(do Lux/Monad
[structs' (map% Lux/Monad extract-symbol structs)]
- (return (: (, (Maybe Openings) (List Syntax)) [(#Some prefix structs') tokens'])))
+ (return (: (, (Maybe Openings) (List AST)) [(#Some prefix structs') tokens'])))
_
- (return (: (, (Maybe Openings) (List Syntax)) [#None tokens]))))
+ (return (: (, (Maybe Openings) (List AST)) [#None tokens]))))
(def (decorate-imports super-name tokens)
- (-> Text (List Syntax) (Lux (List Syntax)))
+ (-> Text (List AST) (Lux (List AST)))
(map% Lux/Monad
- (: (-> Syntax (Lux Syntax))
+ (: (-> AST (Lux AST))
(lambda [token]
(case token
(#Meta _ (#SymbolS "" sub-name))
@@ -2140,10 +2140,10 @@
tokens))
(def (parse-imports imports)
- (-> (List Syntax) (Lux (List Import)))
+ (-> (List AST) (Lux (List Import)))
(do Lux/Monad
[imports' (map% Lux/Monad
- (: (-> Syntax (Lux (List Import)))
+ (: (-> AST (Lux (List Import)))
(lambda [token]
(case token
(#Meta _ (#SymbolS "" m-name))
@@ -2190,7 +2190,7 @@
#seed seed #eval? eval? #expected expected}
(case (get module modules)
(#Some =module)
- (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List Syntax) (StateE Compiler (List Syntax))))))
+ (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List AST) (StateE Compiler (List AST))))))
(List Text))
(lambda [gdef]
(let [[name [export? _]] gdef]
@@ -2341,7 +2341,7 @@
#Nil
(do Lux/Monad
[output' (map% Lux/Monad
- (: (-> Import (Lux (List Syntax)))
+ (: (-> Import (Lux (List AST)))
(lambda [import]
(case import
[m-name m-alias m-referrals m-openings]
@@ -2362,13 +2362,13 @@
#Nothing
(;return (list)))
- #let [openings (: (List Syntax)
+ #let [openings (: (List AST)
(case m-openings
#None
(list)
(#Some prefix structs)
- (map (: (-> Ident Syntax)
+ (map (: (-> Ident AST)
(lambda [struct]
(let [[_ name] struct]
(` (open (~ (symbol$ [m-name name])) (~ (text$ prefix)))))))
@@ -2378,7 +2378,7 @@
(case m-alias
#None (list)
(#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name))))))
- (map (: (-> Text Syntax)
+ (map (: (-> Text AST)
(lambda [def]
(` (_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
defs)
@@ -2387,7 +2387,7 @@
(;return (list:join output')))
_
- (;return (: (List Syntax)
+ (;return (: (List AST)
(list:++ (map (lambda [m-name] (` (_lux_import (~ (text$ m-name)))))
unknowns)
(list (` (import (~@ tokens))))))))))
@@ -2675,12 +2675,12 @@
(#Right state expected))))
(def (use-field field-name type)
- (-> Text Type (, Syntax Syntax))
+ (-> Text Type (, AST AST))
(let [[module name] (split-slot field-name)
- pattern (: Syntax
+ pattern (: AST
(case (resolve-struct-type type)
(#Some (#RecordT slots))
- (record$ (map (: (-> (, Text Type) (, Syntax Syntax))
+ (record$ (map (: (-> (, Text Type) (, AST AST))
(lambda [[sname stype]] (use-field sname stype)))
slots))
@@ -2697,7 +2697,7 @@
[struct-type (find-var-type name)]
(case (resolve-struct-type struct-type)
(#Some (#RecordT slots))
- (let [pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax))
+ (let [pattern (record$ (map (: (-> (, Text Type) (, AST AST))
(lambda [[sname stype]] (use-field sname stype)))
slots))]
(return (list (` (_lux_case (~ struct) (~ pattern) (~ body))))))
@@ -2726,7 +2726,7 @@
(fail "cond requires an even number of arguments.")
(case (reverse tokens)
(\ (list& else branches'))
- (return (list (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (return (list (foldL (: (-> AST (, AST AST) AST)
(lambda [else branch]
(let [[right left] branch]
(` (if (~ left) (~ right) (~ else))))))
@@ -2750,7 +2750,7 @@
(do Lux/Monad
[slot (normalize slot')]
(let [[s-prefix s-name] (: Ident slot)
- pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax))
+ pattern (record$ (map (: (-> (, Text Type) (, AST AST))
(lambda [slot]
(let [[r-slot-name r-type] slot
[r-prefix r-name] (split-slot r-slot-name)]
@@ -2774,12 +2774,12 @@
(fail "Wrong syntax for get@")))
(def (open-field prefix field-name source type)
- (-> Text Text Syntax Type (List Syntax))
+ (-> Text Text AST Type (List AST))
(let [[module name] (split-slot field-name)
- source+ (: Syntax (` (get@ (~ (tag$ [module name])) (~ source))))]
+ source+ (: AST (` (get@ (~ (tag$ [module name])) (~ source))))]
(case (resolve-struct-type type)
(#Some (#RecordT slots))
- (list:join (map (: (-> (, Text Type) (List Syntax))
+ (list:join (map (: (-> (, Text Type) (List AST))
(lambda [[sname stype]] (open-field prefix sname source+ stype)))
slots))
@@ -2800,7 +2800,7 @@
#let [source (symbol$ struct-name)]]
(case (resolve-struct-type struct-type)
(#Some (#RecordT slots))
- (return (list:join (map (: (-> (, Text Type) (List Syntax))
+ (return (list:join (map (: (-> (, Text Type) (List AST))
(lambda [[sname stype]] (open-field prefix sname source stype)))
slots)))
@@ -2828,7 +2828,7 @@
(\ (list& start parts))
(do Lux/Monad
[output (foldL% Lux/Monad
- (: (-> Syntax Syntax (Lux Syntax))
+ (: (-> AST AST (Lux AST))
(lambda [so-far part]
(case part
(#Meta _ (#SymbolS slot))
@@ -2857,7 +2857,7 @@
(#Some (#RecordT slots))
(do Lux/Monad
[pattern' (map% Lux/Monad
- (: (-> (, Text Type) (Lux (, Text Syntax)))
+ (: (-> (, Text Type) (Lux (, Text AST)))
(lambda [slot]
(let [[r-slot-name r-type] slot]
(do Lux/Monad
@@ -2866,12 +2866,12 @@
slots)
slot (normalize slot')]
(let [[s-prefix s-name] (: Ident slot)
- pattern (record$ (map (: (-> (, Text Syntax) (, Syntax Syntax))
+ pattern (record$ (map (: (-> (, Text AST) (, AST AST))
(lambda [slot]
(let [[r-slot-name r-var] slot]
[(tag$ (split-slot r-slot-name)) r-var])))
pattern'))
- output (record$ (map (: (-> (, Text Syntax) (, Syntax Syntax))
+ output (record$ (map (: (-> (, Text AST) (, AST AST))
(lambda [slot]
(let [[r-slot-name r-var] slot
[r-prefix r-name] (split-slot r-slot-name)]
@@ -2905,7 +2905,7 @@
(#Some (#RecordT slots))
(do Lux/Monad
[pattern' (map% Lux/Monad
- (: (-> (, Text Type) (Lux (, Text Syntax)))
+ (: (-> (, Text Type) (Lux (, Text AST)))
(lambda [slot]
(let [[r-slot-name r-type] slot]
(do Lux/Monad
@@ -2914,12 +2914,12 @@
slots)
slot (normalize slot')]
(let [[s-prefix s-name] (: Ident slot)
- pattern (record$ (map (: (-> (, Text Syntax) (, Syntax Syntax))
+ pattern (record$ (map (: (-> (, Text AST) (, AST AST))
(lambda [slot]
(let [[r-slot-name r-var] slot]
[(tag$ (split-slot r-slot-name)) r-var])))
pattern'))
- output (record$ (map (: (-> (, Text Syntax) (, Syntax Syntax))
+ output (record$ (map (: (-> (, Text AST) (, AST AST))
(lambda [slot]
(let [[r-slot-name r-var] slot
[r-prefix r-name] (split-slot r-slot-name)]
@@ -2947,11 +2947,11 @@
(\ (list (#Meta _ (#TupleS data))
(#Meta _ (#TupleS bindings))
(#Meta _ (#TupleS templates))))
- (case (: (Maybe (List Syntax))
+ (case (: (Maybe (List AST))
(do Maybe/Monad
[bindings' (map% Maybe/Monad get-name bindings)
data' (map% Maybe/Monad tuple->list data)]
- (let [apply (: (-> RepEnv (List Syntax))
+ (let [apply (: (-> RepEnv (List AST))
(lambda [env] (map (apply-template env) templates)))]
(|> data'
(join-map (. apply (make-env bindings')))
@@ -2996,7 +2996,7 @@
[every? true and])
(def (type->syntax type)
- (-> Type Syntax)
+ (-> Type AST)
(case type
(#DataT name)
(` (#DataT (~ (text$ name))))
@@ -3005,13 +3005,13 @@
(` (#TupleT (~ (untemplate-list (map type->syntax parts)))))
(#VariantT cases)
- (` (#VariantT (~ (untemplate-list (map (: (-> (, Text Type) Syntax)
+ (` (#VariantT (~ (untemplate-list (map (: (-> (, Text Type) AST)
(lambda [[label type]]
(tuple$ (list (text$ label) (type->syntax type)))))
cases)))))
(#RecordT fields)
- (` (#RecordT (~ (untemplate-list (map (: (-> (, Text Type) Syntax)
+ (` (#RecordT (~ (untemplate-list (map (: (-> (, Text Type) AST)
(lambda [[label type]]
(tuple$ (list (text$ label) (type->syntax type)))))
fields)))))
@@ -3029,10 +3029,10 @@
(` (#ExT (~ (int$ id))))
(#AllT env name arg type)
- (let [env' (: Syntax
+ (let [env' (: AST
(case env
#None (` #None)
- (#Some _env) (` (#Some (~ (untemplate-list (map (: (-> (, Text Type) Syntax)
+ (#Some _env) (` (#Some (~ (untemplate-list (map (: (-> (, Text Type) AST)
(lambda [[label type]]
(tuple$ (list (text$ label) (type->syntax type)))))
_env)))))))]
@@ -3062,7 +3062,7 @@
(~@ inits))))))
(do Lux/Monad
[aliases (map% Lux/Monad
- (: (-> Syntax (Lux Syntax))
+ (: (-> AST (Lux AST))
(lambda [_] (gensym "")))
inits)]
(return (list (` (let [(~@ (interleave aliases inits))]
diff --git a/source/lux/codata/lazy.lux b/source/lux/codata/lazy.lux
index 94968de20..dbb1c13ad 100644
--- a/source/lux/codata/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -7,18 +7,19 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (meta macro)
+ (lux (meta macro
+ ast)
(control (functor #as F #refer #all)
(monad #as M #refer #all))
(data list))
(.. function))
-## Types
+## [Types]
(deftype #export (Lazy a)
(All [b]
(-> (-> a b) b)))
-## Syntax
+## [Syntax]
(defmacro #export (... tokens state)
(case tokens
(\ (list value))
@@ -28,13 +29,13 @@
_
(#;Left "Wrong syntax for ...")))
-## Functions
+## [Functions]
(def #export (! thunk)
(All [a]
(-> (Lazy a) a))
(thunk id))
-## Structs
+## [Structs]
(defstruct #export Lazy/Functor (Functor Lazy)
(def (F;map f ma)
(lambda [k] (ma (. k f)))))
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 3bce9ee77..251d77815 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -128,7 +128,7 @@
(do Lux/Monad
[patterns (map% Lux/Monad macro-expand-1 patterns')
g!s (gensym "s")
- #let [patterns+ (: (List Syntax)
+ #let [patterns+ (: (List AST)
(do List/Monad
[pattern (l;reverse patterns)]
(list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s))))))]]
diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux
index a1168a3cd..e82d079f6 100644
--- a/source/lux/control/comonad.lux
+++ b/source/lux/control/comonad.lux
@@ -11,7 +11,7 @@
lux/data/list
lux/meta/macro)
-## Signatures
+## [Signatures]
(defsig #export (CoMonad w)
(: (F;Functor w)
_functor)
@@ -22,18 +22,18 @@
(-> (w a) (w (w a))))
split))
-## Functions
+## [Functions]
(def #export (extend w f ma)
(All [w a b]
(-> (CoMonad w) (-> (w a) b) (w a) (w b)))
(using w
(map f (split ma))))
-## Syntax
+## [Syntax]
(defmacro #export (be tokens state)
(case tokens
(\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
- (let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (let [body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux
index 4e4786b63..53ab7301b 100644
--- a/source/lux/control/monad.lux
+++ b/source/lux/control/monad.lux
@@ -54,7 +54,7 @@
(case tokens
## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
(#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
- (let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (let [body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body' binding]
(let [[var value] binding]
(case var
diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux
index e5b265959..f03dbddc6 100644
--- a/source/lux/data/io.lux
+++ b/source/lux/data/io.lux
@@ -7,17 +7,18 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/meta macro)
- (lux/control (functor #as F)
- (monad #as M))
+ (lux (meta macro
+ ast)
+ (control (functor #as F)
+ (monad #as M)))
(.. list
(text #as T #open ("text:" Text/Monoid))))
-## Types
+## [Types]
(deftype #export (IO a)
(-> (,) a))
-## Syntax
+## [Syntax]
(defmacro #export (io tokens state)
(case tokens
(\ (list value))
@@ -27,7 +28,7 @@
_
(#;Left "Wrong syntax for io")))
-## Structures
+## [Structures]
(defstruct #export IO/Functor (F;Functor IO)
(def (F;map f ma)
(io (f (ma [])))))
@@ -41,7 +42,7 @@
(def (M;join mma)
(mma [])))
-## Functions
+## [Functions]
(def #export (print x)
(-> Text (IO (,)))
(io (_jvm_invokevirtual "java.io.PrintStream" "print" ["java.lang.Object"]
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 1b1711ca7..5b579e243 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -17,7 +17,7 @@
bool)
meta/macro))
-## Types
+## [Types]
## (deftype (List a)
## (| #Nil
## (#Cons (, a (List a)))))
@@ -225,7 +225,7 @@
(#;Some x)
(@ (i+ -1 i) xs'))))
-## Syntax
+## [Syntax]
(defmacro #export (list xs state)
(#;Right [state (#;Cons [(foldL (lambda [tail head]
(` (#;Cons [(~ head) (~ tail)])))
@@ -244,7 +244,7 @@
_
(#;Left "Wrong syntax for list&")))
-## Structures
+## [Structures]
## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a))))
## (def (E;= xs ys)
## (case [xs ys]
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
index a6019e256..bba85daf7 100644
--- a/source/lux/data/maybe.lux
+++ b/source/lux/data/maybe.lux
@@ -7,7 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (meta macro)
+ (lux (meta macro
+ ast)
(control (monoid #as m #refer #all)
(functor #as F #refer #all)
(monad #as M #refer #all)))
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index d0a6c46d1..3f6f5d085 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -7,7 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (meta macro)
+ (lux (meta macro
+ ast)
(control (monoid #as m)
(eq #as E)
(ord #as O)
@@ -157,7 +158,7 @@
(M;wrap [pre var post])))
(def (unravel-template template)
- (-> Text (List Syntax))
+ (-> Text (List AST))
(case (extract-var template)
(#;Some [pre var post])
(list& (text$ pre) (symbol$ ["" var])
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 2c90b1ba3..f136bd73b 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -14,20 +14,20 @@
(text #as text)
(number (int #open ("i" Int/Eq))))
(meta lux
- macro
+ ast
syntax)))
## [Utils]
## Parsers
(def finally^
- (Parser Syntax)
+ (Parser AST)
(form^ (do Parser/Monad
[_ (symbol?^ ["" "finally"])
expr id^]
(M;wrap expr))))
(def catch^
- (Parser (, Text Ident Syntax))
+ (Parser (, Text Ident AST))
(form^ (do Parser/Monad
[_ (symbol?^ ["" "catch"])
ex-class local-symbol^
@@ -60,7 +60,7 @@
(M;wrap [arg-name arg-class]))))
(def method-def^
- (Parser (, (List Text) Text (List (, Text Text)) Text Syntax))
+ (Parser (, (List Text) Text (List (, Text Text)) Text AST))
(form^ (do Parser/Monad
[modifiers (*^ local-tag^)
name local-symbol^
@@ -70,7 +70,7 @@
(M;wrap [modifiers name inputs output body]))))
(def method-call^
- (Parser (, Text (List Text) (List Syntax)))
+ (Parser (, Text (List Text) (List AST)))
(form^ (do Parser/Monad
[method local-symbol^
arity-classes (tuple^ (*^ local-symbol^))
@@ -89,7 +89,7 @@
(defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)])
(emit (list (` (_jvm_try (~ body)
- (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident Syntax) Syntax)
+ (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST)
(lambda [catch]
(let [[class ex body] catch]
(` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
@@ -102,7 +102,7 @@
(list (` (_jvm_finally (~ finally)))))))))))))
(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
- (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax)
+ (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST)
(lambda [member]
(let [[modifiers name inputs output] member]
(` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))])))))
@@ -115,18 +115,18 @@
[methods (*^ method-def^)])
(do Lux/Monad
[current-module get-module-name
- #let [fields' (map (: (-> (, (List Text) Text Text) Syntax)
+ #let [fields' (map (: (-> (, (List Text) Text Text) AST)
(lambda [field]
(let [[modifiers name class] field]
(` ((~ (text$ name))
(~ (text$ class))
[(~@ (map text$ modifiers))])))))
fields)
- methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax)
+ methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text AST) AST)
(lambda [methods]
(let [[modifiers name inputs output body] methods]
(` ((~ (text$ name))
- [(~@ (map (: (-> (, Text Text) Syntax)
+ [(~@ (map (: (-> (, Text Text) AST)
(lambda [in]
(let [[left right] in]
(form$ (list (symbol$ ["" left])
diff --git a/source/lux/meta/ast.lux b/source/lux/meta/ast.lux
new file mode 100644
index 000000000..f01f08af1
--- /dev/null
+++ b/source/lux/meta/ast.lux
@@ -0,0 +1,46 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## The use and distribution terms for this software are covered by the
+## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+## which can be found in the file epl-v10.html at the root of this distribution.
+## By using this software in any fashion, you are agreeing to be bound by
+## the terms of this license.
+## You must not remove this notice, or any other, from this software.
+
+(;import lux)
+
+## [Types]
+## (deftype (AST' w)
+## (| (#;BoolS Bool)
+## (#;IntS Int)
+## (#;RealS Real)
+## (#;CharS Char)
+## (#;TextS Text)
+## (#;SymbolS Text Text)
+## (#;TagS Text Text)
+## (#;FormS (List (w (AST' w))))
+## (#;TupleS (List (w (AST' w))))
+## (#;RecordS (List (, (w (AST' w)) (w (AST' w)))))))
+
+## (deftype AST
+## (Meta Cursor (AST' (Meta Cursor))))
+
+## [Utils]
+(def _cursor Cursor ["" -1 -1])
+
+## [Functions]
+(do-template [<name> <type> <tag>]
+ [(def #export (<name> x)
+ (-> <type> AST)
+ (#;Meta _cursor (<tag> x)))]
+
+ [bool$ Bool #;BoolS]
+ [int$ Int #;IntS]
+ [real$ Real #;RealS]
+ [char$ Char #;CharS]
+ [text$ Text #;TextS]
+ [symbol$ Ident #;SymbolS]
+ [tag$ Ident #;TagS]
+ [form$ (List AST) #;FormS]
+ [tuple$ (List AST) #;TupleS]
+ [record$ (List (, AST AST)) #;RecordS]
+ )
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index e1d821ff0..bc859b823 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -7,7 +7,8 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (.. macro)
+ (.. macro
+ ast)
(lux/control (monoid #as m)
(functor #as F)
(monad #as M #refer (#only do))
@@ -119,7 +120,7 @@
(:: Lux/Monad (M;wrap ident))))
(def #export (macro-expand syntax)
- (-> Syntax (Lux (List Syntax)))
+ (-> AST (Lux (List AST)))
(case syntax
(#;Meta [_ (#;FormS (#;Cons [(#;Meta [_ (#;SymbolS macro-name)]) args]))])
(do Lux/Monad
@@ -139,7 +140,7 @@
(:: Lux/Monad (M;wrap (list syntax)))))
(def #export (macro-expand-all syntax)
- (-> Syntax (Lux (List Syntax)))
+ (-> AST (Lux (List AST)))
(case syntax
(#;Meta [_ (#;FormS (#;Cons [(#;Meta [_ (#;SymbolS macro-name)]) args]))])
(do Lux/Monad
@@ -161,7 +162,7 @@
(do Lux/Monad
[harg+ (macro-expand-all harg)
targs+ (M;map% Lux/Monad macro-expand-all targs)]
- (M;wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List Syntax)) targs+))))))))
+ (M;wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List AST)) targs+))))))))
(#;Meta [_ (#;TupleS members)])
(do Lux/Monad
@@ -172,7 +173,7 @@
(:: Lux/Monad (M;wrap (list syntax)))))
(def #export (gensym prefix state)
- (-> Text (Lux Syntax))
+ (-> Text (Lux AST))
(#;Right [(update@ #;seed (i+ 1) state)
(symbol$ ["__gensym__" (:: I;Int/Show (S;show (get@ #;seed state)))])]))
@@ -189,7 +190,7 @@
(#;Left msg)))
(def #export (macro-expand-1 token)
- (-> Syntax (Lux Syntax))
+ (-> AST (Lux AST))
(do Lux/Monad
[token+ (macro-expand token)]
(case token+
diff --git a/source/lux/meta/macro.lux b/source/lux/meta/macro.lux
index 22aeaf874..15f3582fa 100644
--- a/source/lux/meta/macro.lux
+++ b/source/lux/meta/macro.lux
@@ -8,47 +8,24 @@
(;import lux)
-## [Utils]
-(def (_meta x)
- (-> (Syntax' (Meta Cursor)) Syntax)
- (#;Meta [["" -1 -1] x]))
-
## [Syntax]
(def #export (defmacro tokens state)
Macro
(case tokens
(#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])
- (#;Right [state (#;Cons [(` ((~ (_meta (#;SymbolS ["lux" "def"]))) ((~ name) (~@ args))
- (~ (_meta (#;SymbolS ["lux" "Macro"])))
+ (#;Right [state (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "def"]))) ((~ name) (~@ args))
+ (~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "Macro"])))
(~ body)))
- (#;Cons [(` ((~ (_meta (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
+ (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
#;Nil])])])
(#;Cons [(#;Meta [_ (#;TagS ["" "export"])]) (#;Cons [(#;Meta [_ (#;FormS (#;Cons [name args]))]) (#;Cons [body #;Nil])])])
- (#;Right [state (#;Cons [(` ((~ (_meta (#;SymbolS ["lux" "def"]))) (~ (_meta (#;TagS ["" "export"]))) ((~ name) (~@ args))
- (~ (_meta (#;SymbolS ["lux" "Macro"])))
+ (#;Right [state (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "def"]))) (~ (#;Meta ["" -1 -1] (#;TagS ["" "export"]))) ((~ name) (~@ args))
+ (~ (#;Meta ["" -1 -1] (#;SymbolS ["lux" "Macro"])))
(~ body)))
- (#;Cons [(` ((~ (_meta (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
+ (#;Cons [(` ((~ (#;Meta ["" -1 -1] (#;SymbolS ["" "_lux_declare-macro"]))) (~ name)))
#;Nil])])])
_
(#;Left "Wrong syntax for defmacro")))
(_lux_declare-macro defmacro)
-
-## [Functions]
-(do-template [<name> <type> <tag>]
- [(def #export (<name> x)
- (-> <type> Syntax)
- (#;Meta [["" -1 -1] (<tag> x)]))]
-
- [bool$ Bool #;BoolS]
- [int$ Int #;IntS]
- [real$ Real #;RealS]
- [char$ Char #;CharS]
- [text$ Text #;TextS]
- [symbol$ Ident #;SymbolS]
- [tag$ Ident #;TagS]
- [form$ (List Syntax) #;FormS]
- [tuple$ (List Syntax) #;TupleS]
- [record$ (List (, Syntax Syntax)) #;RecordS]
- )
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index 972999fcb..beb2c9e7a 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -8,6 +8,7 @@
(;import lux
(.. (macro #as m #refer #all)
+ ast
(lux #as l #refer (#only Lux/Monad gensym)))
(lux (control (functor #as F)
(monad #as M #refer (#only do))
@@ -31,11 +32,11 @@
#;Nil #;Nil
(#;Cons [[x y] pairs']) (list& x y (join-pairs pairs'))))
-## Types
+## [Types]
(deftype #export (Parser a)
- (-> (List Syntax) (Maybe (, (List Syntax) a))))
+ (-> (List AST) (Maybe (, (List AST) a))))
-## Structures
+## [Structures]
(defstruct #export Parser/Functor (F;Functor Parser)
(def (F;map f ma)
(lambda [tokens]
@@ -61,9 +62,9 @@
(#;Some [tokens' ma])
(ma tokens')))))
-## Parsers
+## [Parsers]
(def #export (id^ tokens)
- (Parser Syntax)
+ (Parser AST)
(case tokens
#;Nil #;None
(#;Cons [t tokens']) (#;Some [tokens' t])))
@@ -155,7 +156,7 @@
(def (run-parser p tokens)
(All [a]
- (-> (Parser a) (List Syntax) (Maybe (, (List Syntax) a))))
+ (-> (Parser a) (List AST) (Maybe (, (List AST) a))))
(p tokens))
(def #export (*^ p tokens)
@@ -210,9 +211,9 @@
#;Nil (#;Some [tokens []])
_ #;None))
-## Syntax
+## [Syntax]
(defmacro #export (defsyntax tokens)
- (let [[exported? tokens] (: (, Bool (List Syntax))
+ (let [[exported? tokens] (: (, Bool (List AST))
(case tokens
(\ (list& (#;Meta [_ (#;TagS ["" "export"])]) tokens'))
[true tokens']
@@ -224,7 +225,7 @@
body))
(do Lux/Monad
[names+parsers (M;map% Lux/Monad
- (: (-> Syntax (Lux (, Syntax Syntax)))
+ (: (-> AST (Lux (, AST AST)))
(lambda [arg]
(case arg
(\ (#;Meta [_ (#;TupleS (list (#;Meta [_ (#;SymbolS var-name)])
@@ -241,7 +242,7 @@
g!_ (gensym "_")
#let [names (:: List/Functor (F;map first names+parsers))
error-msg (text$ (text:++ "Wrong syntax for " name))
- body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ body' (foldL (: (-> AST (, AST AST) AST)
(lambda [body name+parser]
(let [[name parser] name+parser]
(` (_lux_case ((~ parser) (~ g!tokens))
@@ -251,8 +252,8 @@
(~ g!_)
(l;fail (~ error-msg)))))))
body
- (: (List (, Syntax Syntax)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
- macro-def (: Syntax
+ (: (List (, AST AST)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers))))
+ macro-def (: AST
(` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
(~ body'))))]]
(M;wrap (list& macro-def
diff --git a/source/program.lux b/source/program.lux
index b7cce5714..02ec633fb 100644
--- a/source/program.lux
+++ b/source/program.lux
@@ -29,7 +29,7 @@
maybe
(number int
real)
- (text #as t #refer (#only <>) #open ("text:" Text/Monoid))
+ (text #refer (#only <>))
writer
tuple)
(codata (stream #as S)
@@ -38,7 +38,8 @@
(reader #as r)
state)
(host jvm)
- (meta lux
+ (meta ast
+ lux
macro
syntax)
(math #as m)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index f40996d7e..18f618b43 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -91,12 +91,12 @@
(def Ident (&/V "lux;TupleT" (&/|list Text Text)))
-(def Syntax*
- (let [Syntax* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
- (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;Syntax'")
+(def AST*
+ (let [AST* (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "w")
+ (&/V "lux;AppT" (&/T (&/V "lux;BoundT" "lux;AST'")
(&/V "lux;BoundT" "w")))))
- Syntax*List (&/V "lux;AppT" (&/T List Syntax*))]
- (fAll "lux;Syntax'" "w"
+ AST*List (&/V "lux;AppT" (&/T List AST*))]
+ (fAll "lux;AST'" "w"
(&/V "lux;VariantT" (&/|list (&/T "lux;BoolS" Bool)
(&/T "lux;IntS" Int)
(&/T "lux;RealS" Real)
@@ -104,16 +104,16 @@
(&/T "lux;TextS" Text)
(&/T "lux;SymbolS" Ident)
(&/T "lux;TagS" Ident)
- (&/T "lux;FormS" Syntax*List)
- (&/T "lux;TupleS" Syntax*List)
- (&/T "lux;RecordS" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list Syntax* Syntax*))))))
+ (&/T "lux;FormS" AST*List)
+ (&/T "lux;TupleS" AST*List)
+ (&/T "lux;RecordS" (&/V "lux;AppT" (&/T List (&/V "lux;TupleT" (&/|list AST* AST*))))))
))))
-(def Syntax
+(def AST
(let [w (&/V "lux;AppT" (&/T Meta Cursor))]
- (&/V "lux;AppT" (&/T w (&/V "lux;AppT" (&/T Syntax* w))))))
+ (&/V "lux;AppT" (&/T w (&/V "lux;AppT" (&/T AST* w))))))
-(def ^:private SyntaxList (&/V "lux;AppT" (&/T List Syntax)))
+(def ^:private ASTList (&/V "lux;AppT" (&/T List AST)))
(def Either
(fAll "lux;Either" "l"
@@ -159,9 +159,9 @@
(&/|list Text
(&/V "lux;TupleT" (&/|list Bool
(&/V "lux;AppT" (&/T DefData*
- (&/V "lux;LambdaT" (&/T SyntaxList
+ (&/V "lux;LambdaT" (&/T ASTList
(&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE (&/V "lux;BoundT" "Compiler")))
- SyntaxList)))))))))))))
+ ASTList)))))))))))))
(&/T "lux;imports" (&/V "lux;AppT" (&/T List Text)))))))
(def $Compiler
@@ -183,9 +183,9 @@
$Void)))
(def Macro
- (&/V "lux;LambdaT" (&/T SyntaxList
+ (&/V "lux;LambdaT" (&/T ASTList
(&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T StateE $Compiler))
- SyntaxList)))))
+ ASTList)))))
(defn bound? [id]
(fn [state]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 06:06:12 +0000