From a8ac885a008f519816d747eca0f894ec9794e938 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 4 Aug 2015 19:40:58 -0400 Subject: - Renamed the Syntax type to AST. - Created the lux/meta/ast module. --- source/lux.lux | 316 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 158 insertions(+), 158 deletions(-) (limited to 'source/lux.lux') 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))] -- cgit v1.2.3