From 4f35491020fba914b746b4109f4362de603288bc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 21 Mar 2015 18:17:24 -0400 Subject: - Added module-name aliasing. --- source/lux.lux | 214 ++++++++++++++++++++++++++++++--------------------------- 1 file changed, 112 insertions(+), 102 deletions(-) (limited to 'source') diff --git a/source/lux.lux b/source/lux.lux index 427057386..fd895f25c 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -9,7 +9,11 @@ (case' tokens (#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])]) (#Right [state - (#Cons [(#Form (#Cons [(#Symbol "case'") (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])) + (#Cons [(#Form (#Cons [(#Symbol ["" "case'"]) + (#Cons [rhs + (#Cons [lhs + (#Cons [body + #Nil])])])])) #Nil])])) ))) (declare-macro let') @@ -19,21 +23,21 @@ (lambda' _ state (let' output (case' tokens (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])]) - (#Form (#Cons [(#Symbol "lambda'") - (#Cons [(#Symbol "") + (#Form (#Cons [(#Symbol ["" "lambda'"]) + (#Cons [(#Symbol ["" ""]) (#Cons [arg (#Cons [(case' args' #Nil body _ - (#Form (#Cons [(#Symbol "lux;lambda") + (#Form (#Cons [(#Symbol ["lux" "lambda"]) (#Cons [(#Tuple args') (#Cons [body #Nil])])]))) #Nil])])])])) (#Cons [(#Symbol self) (#Cons [(#Tuple (#Cons [arg args'])) (#Cons [body #Nil])])]) - (#Form (#Cons [(#Symbol "lambda'") + (#Form (#Cons [(#Symbol ["" "lambda'"]) (#Cons [(#Symbol self) (#Cons [arg (#Cons [(case' args' @@ -41,7 +45,7 @@ body _ - (#Form (#Cons [(#Symbol "lux;lambda") + (#Form (#Cons [(#Symbol ["lux" "lambda"]) (#Cons [(#Tuple args') (#Cons [body #Nil])])]))) #Nil])])])]))) @@ -53,13 +57,13 @@ (lambda [tokens state] (let' output (case' tokens (#Cons [(#Symbol name) (#Cons [body #Nil])]) - (#Form (#Cons [(#Symbol "def'") tokens])) + (#Form (#Cons [(#Symbol ["lux" "def'"]) tokens])) (#Cons [(#Form (#Cons [(#Symbol name) args])) (#Cons [body #Nil])]) - (#Form (#Cons [(#Symbol "def'") + (#Form (#Cons [(#Symbol ["lux" "def'"]) (#Cons [(#Symbol name) - (#Cons [(#Form (#Cons [(#Symbol "lux;lambda") + (#Cons [(#Form (#Cons [(#Symbol ["lux" "lambda"]) (#Cons [(#Symbol name) (#Cons [(#Tuple args) (#Cons [body #Nil])])])])) @@ -69,14 +73,14 @@ (def (defmacro tokens state) (let' [fn-name fn-def] (case' tokens - (#Cons [(#Form (#Cons [(#Symbol name) args])) + (#Cons [(#Form (#Cons [(#Symbol fn-name) args])) (#Cons [body #Nil])]) - [name - (#Form (#Cons [(#Symbol "lux;def") - (#Cons [(#Form (#Cons [(#Symbol name) args])) + [fn-name + (#Form (#Cons [(#Symbol ["lux" "def"]) + (#Cons [(#Form (#Cons [(#Symbol fn-name) args])) (#Cons [body #Nil])])]))]) - (let' declaration (#Form (#Cons [(#Symbol "declare-macro") (#Cons [(#Symbol fn-name) #Nil])])) + (let' declaration (#Form (#Cons [(#Symbol ["lux" "declare-macro"]) (#Cons [(#Symbol fn-name) #Nil])])) (#Right [state (#Cons [fn-def (#Cons [declaration #Nil])])])))) (declare-macro defmacro) @@ -114,10 +118,10 @@ (defmacro (list xs state) (let' xs' (reverse xs) (let' output (fold (lambda [tail head] - (#Form (#Cons [(#Tag "Cons") + (#Form (#Cons [(#Tag ["lux" "Cons"]) (#Cons [(#Tuple (#Cons [head (#Cons [tail #Nil])])) #Nil])]))) - (#Tag "Nil") + (#Tag ["lux" "Nil"]) xs') (#Right [state (#Cons [output #Nil])])))) @@ -128,7 +132,7 @@ (#Cons [last init']) (let' output (fold (lambda [tail head] - (#Form (list (#Tag "Cons") (#Tuple (list head tail))))) + (#Form (list (#Tag ["lux" "Cons"]) (#Tuple (list head tail))))) last init') (#Right [state (#Cons [output #Nil])])))) @@ -147,7 +151,7 @@ (let' output (fold (lambda [body binding] (case' binding [label value] - (#Form (list (#Symbol "lux;let'") label value body)))) + (#Form (list (#Symbol ["lux" "let'"]) label value body)))) body (reverse (as-pairs bindings))) (#Right [state (list output)])))) @@ -179,44 +183,44 @@ (def (untemplate-list tokens) (case' tokens #Nil - (#Tag "Nil") + (#Tag ["lux" "Nil"]) (#Cons [token tokens']) - (#Form (#Cons [(#Tag "Cons") + (#Form (#Cons [(#Tag ["lux" "Cons"]) (#Cons [(#Tuple (#Cons [token (#Cons [(untemplate-list tokens') #Nil])])) #Nil])])))) (def (untemplate token) (case' token (#Bool value) - (#Form (list (#Tag "Bool") (#Bool value))) + (#Form (list (#Tag ["lux" "Bool"]) (#Bool value))) (#Int value) - (#Form (list (#Tag "Int") (#Int value))) + (#Form (list (#Tag ["lux" "Int"]) (#Int value))) (#Real value) - (#Form (list (#Tag "Real") (#Real value))) + (#Form (list (#Tag ["lux" "Real"]) (#Real value))) (#Char value) - (#Form (list (#Tag "Char") (#Char value))) + (#Form (list (#Tag ["lux" "Char"]) (#Char value))) (#Text value) - (#Form (list (#Tag "Text") (#Text value))) + (#Form (list (#Tag ["lux" "Text"]) (#Text value))) - (#Tag value) - (#Form (list (#Tag "Tag") (#Text value))) + (#Tag [module name]) + (#Form (list (#Tag ["lux" "Tag"]) (#Tuple (list (#Text module) (#Text name))))) - (#Symbol value) - (#Form (list (#Tag "Symbol") (#Text value))) + (#Symbol [module name]) + (#Form (list (#Tag ["lux" "Symbol"]) (#Tuple (list (#Text module) (#Text name))))) (#Tuple elems) - (#Form (list (#Tag "Tuple") (untemplate-list (map untemplate elems)))) + (#Form (list (#Tag ["lux" "Tuple"]) (untemplate-list (map untemplate elems)))) - (#Form (#Cons [(#Symbol "~") (#Cons [unquoted #Nil])])) + (#Form (#Cons [(#Symbol [_ "~"]) (#Cons [unquoted #Nil])])) unquoted (#Form elems) - (#Form (list (#Tag "Form") (untemplate-list (map untemplate elems)))) + (#Form (list (#Tag ["lux" "Form"]) (untemplate-list (map untemplate elems)))) )) (defmacro (` tokens state) @@ -273,8 +277,8 @@ (case' tokens (#Cons [bindings (#Cons [body #Nil])]) (let [pairs (as-pairs bindings)] - (return (list (#Form (#Cons [(` (lambda (~ (#Symbol "recur")) (~ (#Tuple (map first pairs))) - (~ body))) + (return (list (#Form (#Cons [(` (lambda (~ (#Symbol ["lux" "recur"])) (~ (#Tuple (map first pairs))) + (~ body))) (map second pairs)]))))))) (defmacro (export tokens) @@ -404,14 +408,14 @@ #Nil true _ false)) -## (do-template [ ] -## (def ( p xs) -## (case xs -## #Nil true -## (#Cons [x xs']) ( (p x) ( p xs')))) +## ## (do-template [ ] +## ## (def ( p xs) +## ## (case xs +## ## #Nil true +## ## (#Cons [x xs']) ( (p x) ( p xs')))) -## [every? and] -## [any? or]) +## ## [every? and] +## ## [any? or]) (def (range from to) (if (int< from to) @@ -444,7 +448,7 @@ (def (get-ident x) (case' x - (#Symbol ident) + (#Symbol [_ ident]) ident)) (def (text-++ x y) @@ -456,7 +460,7 @@ (def (apply-template env template) (case' template - (#Symbol ident) + (#Symbol [_ ident]) (case' (get ident env) (#Some subst) subst @@ -490,11 +494,11 @@ (map (. apply (zip2 bindings-list))) return)))) -## (do-template [ ] -## (def (int+ )) +## ## (do-template [ ] +## ## (def (int+ )) -## [inc 1] -## [dec -1]) +## ## [inc 1] +## ## [dec -1]) (def (int= x y) (jvm-leq x y)) @@ -587,19 +591,19 @@ (jvm-invokevirtual java.lang.Object "toString" [] int [])) -## (def gensym -## (lambda [state] -## [(update@ #gen-seed inc state) -## (#Symbol ($ text-++ "__" (show-int (get@ #gen-seed state)) "__"))])) +## ## (def gensym +## ## (lambda [state] +## ## [(update@ #gen-seed inc state) +## ## (#Symbol ($ text-++ "__" (show-int (get@ #gen-seed state)) "__"))])) -## ## (do-template [ ] -## ## (def ( pair) -## ## (case' pair -## ## [f s] -## ## )) +## ## ## (do-template [ ] +## ## ## (def ( pair) +## ## ## (case' pair +## ## ## [f s] +## ## ## )) -## ## [first f] -## ## [second s]) +## ## ## [first f] +## ## ## [second s]) (def (show-syntax syntax) (case' syntax @@ -623,11 +627,11 @@ (jvm-invokevirtual java.lang.Object "toString" [] value []) - (#Symbol ident) - ident + (#Symbol [module name]) + ($ text-++ module ";" name) - (#Tag tag) - (text-++ "#" tag) + (#Tag [module name]) + ($ text-++ "#" module ";" name) (#Tuple members) ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]") @@ -663,8 +667,8 @@ (#Cons [(#Tuple fields) #Nil]) (return (list (#Record (map (lambda [slot] (case' slot - (#Tag name) - [(#Tag name) (#Symbol name)])) + (#Tag [module name]) + [($ text-++ module ";" name) (#Symbol [module name])])) fields)))))) (defmacro ($or tokens) @@ -677,30 +681,33 @@ (defmacro (^ tokens) (case' tokens - (#Cons [(#Symbol class-name) #Nil]) - (return (list (` (#Data [(~ (#Text class-name)) (list)])))))) + (#Cons [(#Symbol [_ class-name]) #Nil]) + (return (list (` (#Data [(~ (#Text class-name)) (list)])))) + + (#Cons [(#Symbol [_ class-name]) (#Cons [(#Tuple params) #Nil])]) + (return (list (` (#Data [(~ (#Text class-name)) (~ (untemplate-list params))])))))) (defmacro (, members) - (return (list (#Form (list+ (#Tag "Tuple") (untemplate-list members)))))) + (return (list (#Form (list+ (#Tag ["lux" "TTuple"]) (untemplate-list members)))))) (defmacro (| members) (let [members' (map (lambda [m] (case' m - (#Tag tag) - [tag (` (#Tuple (list)))] + (#Tag [module name]) + [($ text-++ module ";" name) (` (#Tuple (list)))] - (#Form (#Cons [tag (#Cons [value #Nil])])) - [tag (` (#Tuple (~ value)))])) + (#Form (#Cons [(#Tag [module name]) (#Cons [value #Nil])])) + [($ text-++ module ";" name) (` (#Tuple (~ value)))])) members)] - (return (list (#Form (list+ (#Tag "Variant") (untemplate-list members))))))) + (return (list (#Form (list+ (#Tag ["lux" "TVariant"]) (untemplate-list members))))))) (defmacro (& members) (let [members' (map (lambda [m] (case' m - (#Form (#Cons [tag (#Cons [value #Nil])])) - [tag (` (#Tuple (~ value)))])) + (#Form (#Cons [(#Tag [module name]) (#Cons [value #Nil])])) + [($ text-++ module ";" name) (` (#Tuple (~ value)))])) members)] - (return (list (#Form (list+ (#Tag "Record") (untemplate-list members))))))) + (return (list (#Form (list+ (#Tag ["lux" "TRecord"]) (untemplate-list members))))))) (defmacro (-> tokens) (case' (reverse tokens) @@ -714,43 +721,46 @@ x [y])) (def (replace-ident ident value syntax) - (case' syntax - (#Symbol test) - (if (text= test ident) - value - syntax) - - (#Form members) - (#Form (map (replace-ident ident value) members)) - - (#Tuple members) - (#Tuple (map (replace-ident ident value) members)) - - (#Record members) - (#Record (map (lambda [kv] - (case' kv - [k v] - [k (replace-ident ident value v)])) - members)) - - _ - syntax)) + (let [[module name] ident] + (case' syntax + (#Symbol [?module ?name]) + (if (and (text= module ?module) + (text= name ?name)) + value + syntax) + + (#Form members) + (#Form (map (replace-ident ident value) members)) + + (#Tuple members) + (#Tuple (map (replace-ident ident value) members)) + + (#Record members) + (#Record (map (lambda [kv] + (case' kv + [k v] + [k (replace-ident ident value v)])) + members)) + + _ + syntax))) (defmacro (All tokens) (let [[name args body] (case' tokens - (#Cons [(#Symbol name) (#Cons [(#Tuple args) (#Cons [body #Nil])])]) + (#Cons [(#Symbol [_ name]) (#Cons [(#Tuple args) (#Cons [body #Nil])])]) [name args body] (#Cons [(#Tuple args) (#Cons [body #Nil])]) ["" args body]) rolled (fold (lambda [body arg] (case' arg - (#Symbol arg-name) - (` (#All (list) (~ (#Text "")) (~ (#Text arg-name)) (~ (replace-ident arg-name (` (#Bound (~ (#Text arg-name)))) + (#Symbol [arg-module arg-name]) + (` (#All (list) (~ (#Text "")) (~ (#Text arg-name)) (~ (replace-ident [arg-module arg-name] + (` (#Bound (~ (#Text arg-name)))) body)))))) body args)] (case' rolled - (#Form (#Cons [(#Tag "All") (#Cons [env (#Cons [(#Test "") (#Cons [(#Text arg-name) (#Cons [body #Nil])])])])])) + (#Form (#Cons [(#Tag ["lux" "TAll"]) (#Cons [env (#Cons [(#Test "") (#Cons [(#Text arg-name) (#Cons [body #Nil])])])])])) (return (list (` (#All (~ env) (~ (#Text name)) (~ (#Text arg-name)) (~ (replace-ident arg-name (` (#Bound (~ (#Text name)))) body))))))))) @@ -853,7 +863,7 @@ ## (case tokens ## (list+ (#Symbol name) tokens') ## [tokens' [(#Symbol name) (list)]] - + ## (list+ (#Form (list+ (#Symbol name) args)) tokens') ## [tokens' [(#Symbol name) args]])) @@ -882,7 +892,7 @@ ## (defstruct ListMonad (Monad List) ## (def (return x) ## (list x)) - + ## (def bind (. concat map))) ## (defsig (Eq a) -- cgit v1.2.3