aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to 'source')
-rw-r--r--source/lux.lux312
1 files changed, 184 insertions, 128 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 30a0c6628..b400e0da8 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -277,18 +277,6 @@
(~ body)))
(map second pairs)])))))))
-## (defmacro (do tokens)
-## (case tokens
-## (list (#Tuple bindings) body)
-## (let [output (fold (lambda [inner binding]
-## (case binding
-## [lhs rhs]
-## (' (bind (lambda [(~ lhs)] (~ body))
-## (~ rhs)))))
-## body
-## (reverse (as-pairs bindings)))]
-## (return (list output)))))
-
(defmacro (export tokens)
(return (map (lambda [t] (` (export' (~ t))))
tokens)))
@@ -432,36 +420,6 @@
(#Cons [from (range (inc from) to)])
#Nil))
-## (defmacro (case tokens)
-## (case' tokens
-## (#Cons value branches)
-## (loop [kind #Pattern
-## pieces branches
-## new-pieces (list)]
-## (case' pieces
-## #Nil
-## (return (list (' (case' (~ value) (~@ new-pieces)))))
-
-## (#Cons piece pieces')
-## (let [[kind' expanded more-pieces] (case' kind
-## #Body
-## [#Pattern (list piece) #Nil]
-
-## #Pattern
-## (do [expansion (macro-expand piece)]
-## (case' expansion
-## #Nil
-## [#Pattern #Nil #Nil]
-
-## (#Cons exp #Nil)
-## [#Body (list exp) #Nil]
-
-## (#Cons exp exps)
-## [#Body (list exp) exps]))
-## )]
-## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces))))
-## )))
-
(def (tuple->list tuple)
(case' tuple
(#Tuple list)
@@ -593,23 +551,23 @@
(defmacro (get@ tokens)
(let [output (case' tokens
- (#Cons [(#Tag tag) (#Cons [record #Nil])])
- (` (get@' (~ (#Tag tag)) (~ record)))
+ (#Cons [tag (#Cons [record #Nil])])
+ (` (get@' (~ tag) (~ record)))
- (#Cons [(#Tag tag) #Nil])
- (` (lambda [record] (get@' (~ (#Tag tag)) record))))]
+ (#Cons [tag #Nil])
+ (` (lambda [record] (get@' (~ tag) record))))]
(return (list output))))
(defmacro (set@ tokens)
(let [output (case' tokens
- (#Cons [(#Tag tag) (#Cons [value (#Cons [record #Nil])])])
- (` (set@' (~ (#Tag tag)) (~ value) (~ record)))
+ (#Cons [tag (#Cons [value (#Cons [record #Nil])])])
+ (` (set@' (~ tag) (~ value) (~ record)))
- (#Cons [(#Tag tag) (#Cons [value #Nil])])
- (` (lambda [record] (set@' (~ (#Tag tag)) (~ value) record)))
+ (#Cons [tag (#Cons [value #Nil])])
+ (` (lambda [record] (set@' (~ tag) (~ value) record)))
- (#Cons [(#Tag tag) #Nil])
- (` (lambda [value record] (set@' (~ (#Tag tag)) value record))))]
+ (#Cons [tag #Nil])
+ (` (lambda [value record] (set@' (~ tag) value record))))]
(return (list output))))
(defmacro (update@ tokens)
@@ -627,6 +585,10 @@
(set@' (~ tag) record (func (get@' (~ tag) record))))))]
(return (list output))))
+(def (show-int int)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ int []))
+
(def gen-ident
(lambda [state]
[(update@ #gen-seed inc state)
@@ -641,96 +603,183 @@
## [first f]
## [second s])
+(def (show-syntax syntax)
+ (case' syntax
+ (#Bool value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Int value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Real value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Char value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Text value)
+ (jvm-invokevirtual java.lang.Object "toString" []
+ value [])
+
+ (#Ident ident)
+ ident
+
+ (#Tag tag)
+ (text-++ "#" tag)
+
+ (#Tuple members)
+ ($ text-++ "[" (fold text-++ "" (interpose " " (map show-syntax members))) "]")
+
+ (#Form members)
+ ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")")
+ ))
+
+(defmacro (do tokens)
+ (case' tokens
+ (#Cons [(#Tuple bindings) (#Cons [body #Nil])])
+ (let [output (fold (lambda [body binding]
+ (case' binding
+ [lhs rhs]
+ (` (bind (lambda [(~ lhs)] (~ body))
+ (~ rhs)))))
+ body
+ (reverse (as-pairs bindings)))]
+ (return (list output)))))
+
+(def (map% f xs)
+ (case' xs
+ #Nil
+ (return xs)
+
+ (#Cons [x xs'])
+ (do [y (f x)
+ ys (map% f xs')]
+ (return (#Cons [y ys])))))
+
(defmacro (type tokens)
- (case tokens
- (#Tuple elems)
- (return (list (' (#Tuple (~ (map untemplate elems))))))
-
- (#Record fields)
- (return (list (' (#Record (~ (map (lambda [kv]
- (case kv
- [(#Tag tag) val]
- [tag (untemplate val)]))
- fields))))))
-
- (#Form (list+ (#Ident "|") options))
- (do [options' (map% (lambda [opt]
- (case opt
- (#Tag tag)
- [tag (#Tuple (list))]
-
- (#Form (list (#Tag tag) value))
- [tag value]
-
- _
- (fail "")))
- options)]
- (#Variant options'))
- ))
+ (case' tokens
+ (#Tuple elems)
+ (return (list (` (#Tuple (~ (map untemplate elems))))))
+
+ (#Record fields)
+ (return (list (` (#Record (~ (map (lambda [kv]
+ (case' kv
+ [(#Tag tag) val]
+ [tag (untemplate val)]))
+ fields))))))
+
+ (#Form (#Cons [(#Ident "|") options]))
+ (do [options' (map% (lambda [opt]
+ (case' opt
+ (#Tag tag)
+ (return [tag (#Tuple (list))])
+
+ (#Form (#Cons [(#Tag tag) (#Cons [value #Nil])]))
+ (return [tag value])
+
+ _
+ (fail "")))
+ options)]
+ (return (list (#Variant options'))))))
(defmacro (All tokens)
- (let [[name args body] (case tokens
- (list (#Tuple args) body)
- ["" args body]
-
- (list (#Ident name) (#Tuple args) body)
- [name args body])]
- (return (list (' (#All (~ name) [(~@ (map (lambda [arg]
- (case arg
- (#Ident arg')
- (#Text arg')))
- args))]
- (~ body)))))))
+ (let [[name args body] (case' tokens
+ (#Cons [(#Tuple args) (#Cons [body #Nil])])
+ [(#Text "") args body]
+
+ (#Cons [(#Ident name) (#Cons [(#Tuple args) (#Cons [body #Nil])])])
+ [(#Text name) args body])]
+ (return (list (#Form (list (#Tag "All")
+ name
+ (#Tuple (map (lambda [arg]
+ (case' arg
+ (#Ident arg')
+ (#Text arg')))
+ args))
+ body))))))
(defmacro (Exists tokens)
- (case tokens
- (list (#Ident name) body)
- (return (list (' (#Exists (~ name) (~ body)))))))
+ (case' tokens
+ (#Cons [(#Ident name) (#Cons [body #Nil])])
+ (return (list (` (#Exists (~ name) (~ body)))))))
(defmacro (deftype tokens)
- (case tokens
- (list (#Ident name) definition)
- (return (list (' (def (~ (#Ident name))
- (type (~ definition))))))
-
- (list (#Form (list+ (#Ident name) args)) definition)
- (let [name' (#Ident name)]
- (return (list (' (def (~ name')
- (All (~ name') [(~@ args)]
- (type (~ definition))))))))
- ))
+ (case' tokens
+ (#Cons [(#Form (#Cons [name args])) (#Cons [definition #Nil])])
+ (return (list (` (def (~ name)
+ (All (~ name) [(~@ args)]
+ (type (~ definition)))))))
+
+ (#Cons [name (#Cons [definition #Nil])])
+ (return (list (` (def (~ name)
+ (type (~ definition))))))
+ ))
(defmacro ($keys tokens)
- (case tokens
- (list (#Tuple fields))
- (let [record (#Record (map (lambda [slot]
- (case slot
- (#Tag name)
- [(#Tag name) (#Ident name)]))
- fields))]
- (return (list record)))))
+ (case' tokens
+ (#Cons [(#Tuple fields) #Nil])
+ (return (list (#Record (map (lambda [slot]
+ (case' slot
+ (#Tag name)
+ [(#Tag name) (#Ident name)]))
+ fields))))))
(defmacro ($or tokens)
- (case tokens
- (list (#Tuple patterns) body)
- (return (flat-map (lambda [pattern] (list pattern body))
- patterns))))
+ (case' tokens
+ (#Cons [(#Tuple patterns) (#Cons [body #Nil])])
+ (return (flat-map (lambda [pattern] (list pattern body))
+ patterns))))
(defmacro (-> tokens)
- (case (reverse tokens)
- (#Cons [f-return f-args])
- (fold (lambda [f-return f-arg]
- (#Lambda [f-arg f-return]))
- f-return f-args)))
+ (case' (reverse tokens)
+ (#Cons [f-return f-args])
+ (fold (lambda [f-return f-arg]
+ (#Lambda [f-arg f-return]))
+ f-return f-args)))
+
+## (defmacro (case tokens)
+## (case' tokens
+## (#Cons value branches)
+## (loop [kind #Pattern
+## pieces branches
+## new-pieces (list)]
+## (case' pieces
+## #Nil
+## (return (list (' (case' (~ value) (~@ new-pieces)))))
-(def (defsyntax tokens)
- ...)
+## (#Cons piece pieces')
+## (let [[kind' expanded more-pieces] (case' kind
+## #Body
+## [#Pattern (list piece) #Nil]
+
+## #Pattern
+## (do [expansion (macro-expand piece)]
+## (case' expansion
+## #Nil
+## [#Pattern #Nil #Nil]
+
+## (#Cons exp #Nil)
+## [#Body (list exp) #Nil]
+
+## (#Cons exp exps)
+## [#Body (list exp) exps]))
+## )]
+## (recur kind' (++ expanded new-pieces) (++ more-pieces pieces))))
+## )))
+
+
+## (def (defsyntax tokens)
+## ...)
-(def (defsig tokens)
- ...)
+## (def (defsig tokens)
+## ...)
-(def (defstruct tokens)
- ...)
+## (def (defstruct tokens)
+## ...)
## (def (with tokens)
## ...)
@@ -740,7 +789,15 @@
## TODO: (Im|Ex)ports-related macros
## TODO: Macro-related macros
-#(
+## (deftype (List a)
+## (|| #Nil (#Cons [a (List a)])))
+
+## (deftype User
+## (&& (#name Text) (#age Int)))
+
+## (deftype User
+## (** Text Int))
+
## (import "lux")
## (module-alias "lux" "l")
## (def-alias "lux;map" "map")
@@ -761,4 +818,3 @@
## (deftype (List a)
## (| #Nil
## (#Cons [a (List a)])))
-)#
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 01:18:55 +0000