aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to 'source')
-rw-r--r--source/lux.lux400
1 files changed, 192 insertions, 208 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 973d5727b..e9b4484c5 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -168,9 +168,9 @@
(case' (#AppT [(#BoundT "w")
(#AppT [(#BoundT "Syntax'")
(#BoundT "w")])])
- Syntax'
- (case' (#AppT [List Syntax'])
- Syntax'List
+ Syntax
+ (case' (#AppT [List Syntax])
+ SyntaxList
(case' (#TupleT (#Cons [Text (#Cons [Text #Nil])]))
Ident
(#AllT [#None "Syntax'" "w"
@@ -181,9 +181,9 @@
(#Cons [["lux;Text" Text]
(#Cons [["lux;Symbol" Ident]
(#Cons [["lux;Tag" Ident]
- (#Cons [["lux;Form" Syntax'List]
- (#Cons [["lux;Tuple" Syntax'List]
- (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Text (#Cons [Syntax' #Nil])]))])]
+ (#Cons [["lux;Form" SyntaxList]
+ (#Cons [["lux;Tuple" SyntaxList]
+ (#Cons [["lux;Record" (#AppT [List (#TupleT (#Cons [Syntax (#Cons [Syntax #Nil])]))])]
#Nil])
])])])])])])])])])
)])
@@ -308,8 +308,8 @@
(case' tokens
(#Cons [lhs (#Cons [rhs (#Cons [body #Nil])])])
(return (:' SyntaxList
- (#Cons [(_meta (#Form (#Cons [(_meta (#Symbol ["" "case'"]))
- (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])])))
+ (#Cons [($form (#Cons [($symbol ["" "case'"])
+ (#Cons [rhs (#Cons [lhs (#Cons [body #Nil])])])]))
#Nil])))
_
@@ -657,7 +657,7 @@
(->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
(case' xs
(#Cons [x (#Cons [y xs'])])
- (list& [x y] (as-pairs xs'))
+ (#Cons [[x y] (as-pairs xs')])
_
#Nil))
@@ -730,46 +730,31 @@
(_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
(_meta (#Tuple (list token (untemplate-list tokens')))))))))
-## (def (untemplate token)
-## (->' Syntax Syntax)
-## (case' token
-## (#Meta [_ (#Bool value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value)))))
-
-## (#Meta [_ (#Int value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value)))))
-
-## (#Meta [_ (#Real value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value)))))
-
-## (#Meta [_ (#Char value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value)))))
-
-## (#Meta [_ (#Text value)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value)))))
-
-## (#Meta [_ (#Tag [module name])])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name))))))))
-
-## (#Meta [_ (#Symbol [module name])])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name))))))))
-
-## (#Meta [_ (#Tuple elems)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Tuple"])) (untemplate-list (map untemplate elems)))))
+(defmacro #export ($ tokens)
+ (case' tokens
+ (#Cons [op (#Cons [init args])])
+ (return (:' SyntaxList
+ (list (fold (:' (->' Syntax Syntax Syntax)
+ (lambda [a1 a2]
+ ($form (list op a1 a2))))
+ init
+ args))))
+
+ _
+ (fail "Wrong syntax for $")))
-## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~"])]) (#Cons [(#Meta [_ unquoted]) #Nil])]))])
-## (_meta unquoted)
+(def (list:++ xs ys)
+ (All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
+ (case' xs
+ (#Cons [x xs'])
+ (#Cons [x (list:++ xs' ys)])
-## (#Meta [_ (#Form elems)])
-## (wrap-meta (#Form (list (_meta (#Tag ["lux" "Form"])) (untemplate-list (map untemplate elems)))))
+ #Nil
+ ys))
-## (#Meta [_ (#Record fields)])
-## (wrap-meta (#Record (map (:' (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax)))
-## (lambda [kv]
-## (let [[k v] kv]
-## [k (untemplate v)])))
-## fields)))
-## ))
+## (: (All [a b]
+## (-> (-> a b) (List a) (List b)))
+## map)
(def (splice untemplate tag elems)
(->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
@@ -782,39 +767,64 @@
spliced
_
- (_meta (#Form (list ($symbol ["lux" "list"]) elem))))))
+ ($form (list ($symbol ["" ":'"])
+ ($symbol ["lux" "SyntaxList"])
+ ($form (list ($symbol ["lux" "list"]) (untemplate elem))))))))
elems)]
(wrap-meta ($form (list tag
- (wrap-meta ($form (list& ($tag ["lux" "$"])
- ($tag ["lux" "list:++"])
- elems')))))))
+ ($form (list& ($symbol ["lux" "$"])
+ ($symbol ["lux" "list:++"])
+ elems'))))))
false
(wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
+## (def (splice untemplate tag elems)
+## (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
+## (case' (any? spliced? elems)
+## true
+## (let [elems' (map (:' (->' Syntax Syntax)
+## (lambda [elem]
+## (case' elem
+## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [spliced #Nil])]))])
+## spliced
+
+## _
+## ($form (list ($symbol ["" ":'"])
+## ($symbol ["lux" "SyntaxList"])
+## ($form (list ($symbol ["lux" "list"]) (untemplate elem))))))))
+## elems)]
+## (wrap-meta ($form (list tag
+## ($form (list& ($symbol ["lux" "$"])
+## ($symbol ["lux" "list:++"])
+## elems'))))))
+
+## false
+## (wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
+
(def (untemplate token)
(->' Syntax Syntax)
(case' token
(#Meta [_ (#Bool value)])
- (wrap-meta ($form (list (_meta (#Tag ["lux" "Bool"])) (_meta (#Bool value)))))
+ (wrap-meta ($form (list ($tag ["lux" "Bool"]) (_meta (#Bool value)))))
(#Meta [_ (#Int value)])
- (wrap-meta ($form (list (_meta (#Tag ["lux" "Int"])) (_meta (#Int value)))))
+ (wrap-meta ($form (list ($tag ["lux" "Int"]) (_meta (#Int value)))))
(#Meta [_ (#Real value)])
- (wrap-meta ($form (list (_meta (#Tag ["lux" "Real"])) (_meta (#Real value)))))
+ (wrap-meta ($form (list ($tag ["lux" "Real"]) (_meta (#Real value)))))
(#Meta [_ (#Char value)])
- (wrap-meta ($form (list (_meta (#Tag ["lux" "Char"])) (_meta (#Char value)))))
+ (wrap-meta ($form (list ($tag ["lux" "Char"]) (_meta (#Char value)))))
(#Meta [_ (#Text value)])
- (wrap-meta ($form (list (_meta (#Tag ["lux" "Text"])) (_meta (#Text value)))))
+ (wrap-meta ($form (list ($tag ["lux" "Text"]) (_meta (#Text value)))))
(#Meta [_ (#Tag [module name])])
- (wrap-meta ($form (list (_meta (#Tag ["lux" "Tag"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name))))))))
+ (wrap-meta ($form (list ($tag ["lux" "Tag"]) ($tuple (list (_meta (#Text module)) (_meta (#Text name)))))))
(#Meta [_ (#Symbol [module name])])
- (wrap-meta ($form (list (_meta (#Tag ["lux" "Symbol"])) (_meta (#Tuple (list (_meta (#Text module)) (_meta (#Text name))))))))
+ (wrap-meta ($form (list ($tag ["lux" "Symbol"]) ($tuple (list (_meta (#Text module)) (_meta (#Text name)))))))
(#Meta [_ (#Tuple elems)])
(splice untemplate ($tag ["lux" "Tuple"]) elems)
@@ -826,11 +836,12 @@
(splice untemplate ($tag ["lux" "Form"]) elems)
(#Meta [_ (#Record fields)])
- (wrap-meta (_meta (#Record (map (:' (->' (#TupleT (list Text Syntax)) (#TupleT (list Text Syntax)))
- (lambda [kv]
- (let [[k v] kv]
- [k (untemplate v)])))
- fields))))
+ (wrap-meta ($form (list ($tag ["lux" "Record"])
+ (untemplate-list (map (:' (->' (#TupleT (list Syntax Syntax)) Syntax)
+ (lambda [kv]
+ (let [[k v] kv]
+ ($tuple (list (untemplate k) (untemplate v))))))
+ fields)))))
))
(defmacro #export (` tokens)
@@ -865,7 +876,8 @@
## return)
## (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
## bind))
-(def' Monad
+(def Monad
+ Type
(All' [m]
(#RecordT (list ["lux;return" (All' [a] (->' (B' a) ($' (B' m) (B' a))))]
["lux;bind" (All' [a b] (->' (->' (B' a) ($' (B' m) (B' b)))
@@ -901,62 +913,114 @@
(#Right [state' a])
(f a state'))))})
-## (defmacro #export (^ tokens)
-## (case' tokens
-## (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil])
-## (return (:' SyntaxList
-## (list (` (#DataT (~ (_meta (#Text class-name))))))))
-
-## _
-## (fail "Wrong syntax for ^")))
-
-## (defmacro #export (-> tokens)
-## (case' (reverse tokens)
-## (#Cons [output inputs])
-## (return (:' SyntaxList
-## (list (fold (:' (->' Syntax Syntax Syntax)
-## (lambda [o i]
-## (` (#;LambdaT [(~ i) (~ o)]))))
-## output
-## inputs))))
+(defmacro #export (^ tokens)
+ (case' tokens
+ (#Cons [(#Meta [_ (#Symbol ["" class-name])]) #Nil])
+ (return (:' SyntaxList
+ (list (` (#DataT (~ (_meta (#Text class-name))))))))
+
+ _
+ (fail "Wrong syntax for ^")))
+
+(defmacro #export (-> tokens)
+ (case' (reverse tokens)
+ (#Cons [output inputs])
+ (return (:' SyntaxList
+ (list (fold (:' (->' Syntax Syntax Syntax)
+ (lambda [o i]
+ (` (#;LambdaT [(~ i) (~ o)]))))
+ output
+ inputs))))
-## _
-## (fail "Wrong syntax for ->")))
-
-## (defmacro #export (, tokens)
-## (return (:' SyntaxList
-## (list (` (#TupleT (list (~@ tokens))))))))
-
-## (defmacro #export (| tokens)
-## (do Lux:Monad
-## [pairs (map% Lux:Monad
-## (lambda [token]
-## (case' token
-## (#Tag ident)
-## (;return (` [(~ ($text (ident->text ident))) (,)]))
-
-## (#Form (#Cons [(#Tag ident) (#Cons [value #Nil])]))
-## (;return (` [(~ ($text (ident->text ident))) (~ value)]))
+ _
+ (fail "Wrong syntax for ->")))
+
+(defmacro #export (, tokens)
+ (return (:' SyntaxList
+ (list (` (#TupleT (list (~@ tokens))))))))
+
+## (: (All [a b]
+## (-> (-> a b a) a (List b) a))
+## fold)
+
+## (: (All [a]
+## (-> (List a) (List a)))
+## reverse)
+
+## (: (All [a]
+## (-> (List a) (List (, a a))))
+## as-pairs)
+
+(defmacro (do tokens)
+ (case' tokens
+ (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])])
+ (let [body' (fold (:' (-> Syntax (, Syntax Syntax) Syntax)
+ (lambda [body' binding]
+ (let [[var value] binding]
+ (` (;bind (lambda' (~ ($symbol ["" ""]))
+ (~ var)
+ (~ body'))
+ (~ value))))))
+ body
+ (reverse (as-pairs bindings)))]
+ (return (:' SyntaxList
+ (list (` (case' (~ monad)
+ {#;return ;return #;bind ;bind}
+ (~ body')))))))
+
+ _
+ (fail "Wrong syntax for do")))
+
+(def (map% m f xs)
+ ## (All [m a b]
+ ## (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
+ (All' [m a b]
+ (-> ($' Monad (B' m))
+ (-> (B' a) ($' (B' m) (B' b)))
+ ($' List (B' a))
+ ($' (B' m) ($' List (B' b)))))
+ (let [{#;return ;return #;bind ;bind} m]
+ (case' xs
+ #Nil
+ (;return #Nil)
+
+ (#Cons [x xs'])
+ (do m
+ [y (f x)
+ ys (map% m f xs')]
+ (;return (#Cons [y ys])))
+ )))
+
+(defmacro #export (| tokens)
+ (do Lux:Monad
+ [pairs (map% Lux:Monad
+ (lambda [token]
+ (case' token
+ (#Tag ident)
+ (;return (` [(~ ($text (ident->text ident))) (,)]))
+
+ (#Form (#Cons [(#Tag ident) (#Cons [value #Nil])]))
+ (;return (` [(~ ($text (ident->text ident))) (~ value)]))
-## _
-## (fail "Wrong syntax for |")))
-## tokens)]
-## (` (#VariantT (list (~@ pairs))))))
-
-## (defmacro #export (& tokens)
-## (if (not (int:= 2 (length tokens)))
-## (fail "& expects an even number of arguments.")
-## (do Lux:Monad
-## [pairs (map% Lux:Monad
-## (lambda [pair]
-## (case' pair
-## [(#Tag ident) value]
-## (;return (` [(~ ($text (ident->text ident))) (~ value)]))
+ _
+ (fail "Wrong syntax for |")))
+ tokens)]
+ (` (#VariantT (list (~@ pairs))))))
+
+(defmacro #export (& tokens)
+ (if (not (int:= 2 (length tokens)))
+ (fail "& expects an even number of arguments.")
+ (do Lux:Monad
+ [pairs (map% Lux:Monad
+ (lambda [pair]
+ (case' pair
+ [(#Tag ident) value]
+ (;return (` [(~ ($text (ident->text ident))) (~ value)]))
-## _
-## (fail "Wrong syntax for &")))
-## (as-pairs tokens))]
-## (` (#RecordT (list (~@ pairs)))))))
+ _
+ (fail "Wrong syntax for &")))
+ (as-pairs tokens))]
+ (` (#RecordT (list (~@ pairs)))))))
## (defmacro #export (All tokens)
## (case' (:' (, Ident SyntaxList)
@@ -1002,38 +1066,6 @@
## (let [[module name] ident]
## ($ text:++ module ";" name)))
-## (def (map% monad f xs)
-## (All' [m a b]
-## (->' ($' Monad (B' m))
-## (->' (B' a) ($' (B' m) (B' b)))
-## ($' (B' m) ($' List (B' b)))))
-## (let [{#;return ;return #;bind ;bind} monad]
-## (case' xs
-## #Nil
-## (;return #Nil)
-
-## (#Cons [x xs'])
-## (do monad
-## [x' (f x)
-## xs'' (map% monad f xs')]
-## (;return (#Cons [x' xs'']))))))
-
-## (defmacro (do tokens)
-## (case' tokens
-## (#Cons [monad (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])])
-## (return (:' SyntaxList
-## (list (` (case' (~ monad)
-## {#;return ;return #;bind ;bind}
-## (~ (fold (:' (-> Syntax (, Syntax Syntax) Syntax)
-## (lambda [body' binding]
-## (let [[lhs rhs] binding]
-## (` (;bind (lambda [(~ lhs)] (~ body')) (~ rhs))))))
-## body
-## (reverse (as-pairs bindings)))))))))
-
-## _
-## (fail "Wrong syntax for do")))
-
## (def #export (find-macro ident state)
## (->' Ident ($' Lux Macro))
## (let [[module name] ident]
@@ -1066,10 +1098,6 @@
## ## (jvm-invokevirtual java.lang.Object "equals" [java.lang.Object]
## ## x [y]))
-## ## (def #export (int:+ x y)
-## ## (-> Int Int Int)
-## ## (jvm-ladd x y))
-
## ## (def (replace-ident ident value syntax)
## ## (-> (, Text Text) Syntax Syntax Syntax)
## ## (let [[module name] ident]
@@ -1201,8 +1229,6 @@
## ## _
## ## (fail "Wrong syntax for :!")))
-
-
## ## (def (print x)
## ## (-> (^ java.lang.Object) [])
## ## (jvm-invokevirtual java.io.PrintStream "print" [java.lang.Object]
@@ -1227,16 +1253,6 @@
## ## (lambda [x]
## ## (f (g x))))
-## ## (def (++ xs ys)
-## ## (All [a]
-## ## (-> (List a) (List a) (List a)))
-## ## (case' xs
-## ## #Nil
-## ## ys
-
-## ## (#Cons [x xs'])
-## ## (#Cons [x (++ xs' ys)])))
-
## ## (def concat
## ## (All [a]
## ## (-> (List (List a)) (List a)))
@@ -1314,26 +1330,18 @@
## ## true false
## ## false true))
-## ## (defmacro (|> tokens)
-## ## (case' tokens
-## ## (#Cons [init apps])
-## ## (return (list (fold (lambda [acc app]
-## ## (case' app
-## ## (#Form parts)
-## ## (#Form (++ parts (list acc)))
-
-## ## _
-## ## (` ((~ app) (~ acc)))))
-## ## init
-## ## apps)))))
-
-## ## (defmacro ($ tokens)
-## ## (case' tokens
-## ## (#Cons [op (#Cons [init args])])
-## ## (return (list (fold (lambda [acc elem]
-## ## (` ((~ op) (~ acc) (~ elem))))
-## ## init
-## ## args)))))
+## (defmacro (|> tokens)
+## (case' tokens
+## (#Cons [init apps])
+## (return (list (fold (lambda [acc app]
+## (case' app
+## (#Form parts)
+## (#Form (++ parts (list acc)))
+
+## _
+## (` ((~ app) (~ acc)))))
+## init
+## apps)))))
## ## (def (const x)
## ## (All [a b]
@@ -1666,30 +1674,6 @@
## ## ($ text-++ "(" (fold text-++ "" (interpose " " (map show-syntax members))) ")")
## ## ))
-## ## (defmacro (do tokens)
-## ## (case' tokens
-## ## (#Cons [(#Meta [_ monad]) (#Cons [(#Meta [_ (#Tuple bindings)]) (#Cons [body #Nil])])])
-## ## (let [output (fold (lambda [body binding]
-## ## (case' binding
-## ## [lhs rhs]
-## ## (` (lux;bind (lambda [(~ lhs)] (~ body))
-## ## (~ rhs)))))
-## ## body
-## ## (reverse (as-pairs bindings)))]
-## ## (return (list (` (using (~ monad) (~ output))))))))
-
-## ## (def (map% f xs)
-## ## (All [m a b]
-## ## (-> (-> a (m b)) (List a) (m (List b))))
-## ## (case' xs
-## ## #Nil
-## ## (return xs)
-
-## ## (#Cons [x xs'])
-## ## (do [y (f x)
-## ## ys (map% f xs')]
-## ## (return (#Cons [y ys])))))
-
## ## ## (defmacro ($keys tokens)
## ## ## (case' tokens
## ## ## (#Cons [(#Meta [_ (#Tuple fields)]) #Nil])
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 13:54:50 +0000