aboutsummaryrefslogtreecommitdiff
path: root/source/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux.lux')
-rw-r--r--source/lux.lux214
1 files changed, 112 insertions, 102 deletions
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 [<name> <op>]
-## (def (<name> p xs)
-## (case xs
-## #Nil true
-## (#Cons [x xs']) (<op> (p x) (<name> p xs'))))
+## ## (do-template [<name> <op>]
+## ## (def (<name> p xs)
+## ## (case xs
+## ## #Nil true
+## ## (#Cons [x xs']) (<op> (p x) (<name> 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 [<name> <offset>]
-## (def <name> (int+ <offset>))
+## ## (do-template [<name> <offset>]
+## ## (def <name> (int+ <offset>))
-## [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 [<name> <member>]
-## ## (def (<name> pair)
-## ## (case' pair
-## ## [f s]
-## ## <member>))
+## ## ## (do-template [<name> <member>]
+## ## ## (def (<name> pair)
+## ## ## (case' pair
+## ## ## [f s]
+## ## ## <member>))
-## ## [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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-27 19:31:06 +0000