aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux292
1 files changed, 182 insertions, 110 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 04ffcf91f..70ebaf67e 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -646,7 +646,7 @@
_
(fail "Wrong syntax for lambda"))))
-(defmacro #export (def tokens)
+(defmacro (def__ tokens)
(case' tokens
(#Cons [(#Meta [_ (#Tag ["" "export"])])
(#Cons [(#Meta [_ (#Form (#Cons [name args]))])
@@ -693,7 +693,7 @@
(fail "Wrong syntax for def")
))
-(def (as-pairs xs)
+(def__ (as-pairs xs)
(All' [a]
(->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
(case' xs
@@ -724,7 +724,7 @@
_
(fail "Wrong syntax for let")))
-(def #export (map f xs)
+(def__ #export (map f xs)
(All' [a b]
(->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
(case' xs
@@ -734,7 +734,7 @@
(#Cons [x xs'])
(#Cons [(f x) (map f xs')])))
-(def #export (any? p xs)
+(def__ #export (any? p xs)
(All' [a]
(->' (->' (B' a) Bool) ($' List (B' a)) Bool))
(case' xs
@@ -746,7 +746,7 @@
true true
false (any? p xs'))))
-(def (spliced? token)
+(def__ (spliced? token)
(->' Syntax Bool)
(case' token
(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))])
@@ -755,13 +755,13 @@
_
false))
-(def (wrap-meta content)
+(def__ (wrap-meta content)
(->' Syntax Syntax)
(_meta (#Form (list (_meta (#Tag ["lux" "Meta"]))
(_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Text "")) (_meta (#Int -1)) (_meta (#Int -1)))))
content)))))))
-(def (untemplate-list tokens)
+(def__ (untemplate-list tokens)
(->' ($' List Syntax) Syntax)
(case' tokens
#Nil
@@ -771,7 +771,7 @@
(_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
(_meta (#Tuple (list token (untemplate-list tokens')))))))))
-(def (list:++ xs ys)
+(def__ (list:++ xs ys)
(All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
(case' xs
(#Cons [x xs'])
@@ -793,7 +793,7 @@
_
(fail "Wrong syntax for $")))
-(def (splice untemplate tag elems)
+(def__ (splice untemplate tag elems)
(->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
(case' (any? spliced? elems)
true
@@ -816,7 +816,7 @@
false
(wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
-(def (untemplate token)
+(def__ (untemplate token)
(->' Syntax Syntax)
(case' token
(#Meta [_ (#Bool value)])
@@ -898,7 +898,7 @@
## (deftype (Lux a)
## (-> CompilerState (Either Text (, CompilerState a))))
-(def #export Lux
+(def__ #export Lux
Type
(All' [a]
(->' CompilerState ($' Either Text (#TupleT (list CompilerState (B' a)))))))
@@ -908,7 +908,7 @@
## 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))))]
@@ -916,7 +916,7 @@
($' (B' m) (B' a))
($' (B' m) (B' b))))]))))
-(def Maybe:Monad
+(def__ Maybe:Monad
($' Monad Maybe)
{#lux;return
(lambda return [x]
@@ -928,7 +928,7 @@
#None #None
(#Some a) (f a)))})
-(def Lux:Monad
+(def__ Lux:Monad
($' Monad Lux)
{#lux;return
(lambda return [x]
@@ -996,7 +996,7 @@
_
(fail "Wrong syntax for do")))
-(def (map% m f xs)
+(def__ (map% m f xs)
## (All [m a b]
## (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
(All' [m a b]
@@ -1016,13 +1016,13 @@
(;return (:' List (#Cons [y ys]))))
)))
-(def #export (. f g)
+(def__ #export (. f g)
(All' [a b c]
(-> (-> (B' b) (B' c)) (-> (B' a) (B' b)) (-> (B' a) (B' c))))
(lambda [x]
(f (g x))))
-(def (get-ident x)
+(def__ (get-ident x)
(-> Syntax ($' Maybe Text))
(case' x
(#Meta [_ (#Symbol ["" sname])])
@@ -1031,7 +1031,7 @@
_
#None))
-(def (tuple->list tuple)
+(def__ (tuple->list tuple)
(-> Syntax ($' Maybe ($' List Syntax)))
(case' tuple
(#Meta [_ (#Tuple members)])
@@ -1040,11 +1040,11 @@
_
#None))
-(def RepEnv
+(def__ RepEnv
Type
($' List (, Text Syntax)))
-(def (make-env xs ys)
+(def__ (make-env xs ys)
(-> ($' List Text) ($' List Syntax) RepEnv)
(case' (:' (, ($' List Text) ($' List Syntax))
[xs ys])
@@ -1054,12 +1054,12 @@
_
#Nil))
-(def (text:= x y)
+(def__ (text:= x y)
(-> Text Text Bool)
(jvm-invokevirtual java.lang.Object equals [java.lang.Object]
x [y]))
-(def (get-rep key env)
+(def__ (get-rep key env)
(-> Text RepEnv ($' Maybe Syntax))
(case' env
#Nil
@@ -1070,7 +1070,7 @@
(#Some v)
(get-rep key env'))))
-(def (apply-template env template)
+(def__ (apply-template env template)
(-> RepEnv Syntax Syntax)
(case' template
(#Meta [_ (#Symbol ["" sname])])
@@ -1097,7 +1097,7 @@
_
template))
-(def (join-map f xs)
+(def__ (join-map f xs)
(All' [a b]
(-> (-> (B' a) ($' List (B' b))) ($' List (B' a)) ($' List (B' b))))
(case' xs
@@ -1127,7 +1127,7 @@
(fail "Wrong syntax for do-template")))
(do-template [<name> <cmp> <type>]
- [(def #export (<name> x y)
+ [(def__ #export (<name> x y)
(-> <type> <type> Bool)
(<cmp> x y))]
@@ -1140,7 +1140,7 @@
)
(do-template [<name> <cmp> <type>]
- [(def #export (<name> x y)
+ [(def__ #export (<name> x y)
(-> <type> <type> <type>)
(<cmp> x y))]
@@ -1156,24 +1156,24 @@
[real:% jvm-drem Real]
)
-(def (multiple? div n)
+(def__ (multiple? div n)
(-> Int Int Bool)
(int:= 0 (int:% n div)))
-(def #export (length list)
+(def__ #export (length list)
(-> List Int)
(fold (lambda [acc _] (int:+ 1 acc)) 0 list))
-(def #export (not x)
+(def__ #export (not x)
(-> Bool Bool)
(if x false true))
-(def (text:++ x y)
+(def__ (text:++ x y)
(-> Text Text Text)
(jvm-invokevirtual java.lang.String concat [java.lang.String]
x [y]))
-(def (ident->text ident)
+(def__ (ident->text ident)
(-> Ident Text)
(let [[module name] ident]
($ text:++ module ";" name)))
@@ -1211,7 +1211,7 @@
(as-pairs tokens))]
(;return (:' SyntaxList (list (` (#;RecordT (;list (~@ pairs))))))))))
-(def (replace-syntax reps syntax)
+(def__ (replace-syntax reps syntax)
(-> RepEnv Syntax Syntax)
(case' syntax
(#Meta [_ (#Symbol ["" name])])
@@ -1274,7 +1274,7 @@
(fail "Wrong syntax for All"))
))
-(def (get k plist)
+(def__ (get k plist)
(All [a]
(-> Text ($' List (, Text a)) ($' Maybe a)))
(case' plist
@@ -1286,7 +1286,7 @@
#Nil
#None))
-(def #export (find-macro ident state)
+(def__ #export (find-macro ident state)
(-> Ident ($' Lux ($' Maybe Macro)))
(let [[module name] ident]
(case' state
@@ -1303,12 +1303,12 @@
_
#None))]))))
-(def (list:join xs)
+(def__ (list:join xs)
(All [a]
(-> ($' List ($' List a)) ($' List a)))
(fold list:++ #Nil xs))
-(def #export (normalize ident state)
+(def__ #export (normalize ident state)
(-> Ident ($' Lux Ident))
(case' ident
["" name]
@@ -1326,40 +1326,63 @@
_
(#Right [state ident])))
-## (def #export (macro-expand syntax)
-## (-> Syntax ($' Lux ($' List Syntax)))
-## (case' syntax
-## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
-## (do Lux:Monad
-## [macro-name' (normalize macro-name)
-## ?macro (find-macro macro-name')]
-## (case' (:' ($' Maybe Macro) ?macro)
-## (#Some macro)
-## (do Lux:Monad
-## [expansion (macro args)
-## expansion' (map% Lux:Monad macro-expand expansion)]
-## (;return (:' SyntaxList (list:join expansion'))))
-
-## #None
-## (do Lux:Monad
-## [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
-## (;return (:' SyntaxList (list ($form (list:join parts'))))))))
-
-## ## (#Meta [_ (#Form (#Cons [harg targs]))])
-## ## (do Lux:Monad
-## ## [harg+ (macro-expand harg)
-## ## targs+ (map% Lux:Monad macro-expand targs)]
-## ## (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
-
-## (#Meta [_ (#Tuple members)])
-## (do Lux:Monad
-## [members' (map% Lux:Monad macro-expand members)]
-## (;return (:' SyntaxList (list ($tuple (list:join members'))))))
-
-## _
-## (return (:' SyntaxList (list syntax)))))
-
-(def #export (macro-expand syntax)
+(def__ (->text x)
+ (-> (^ java.lang.Object) Text)
+ (jvm-invokevirtual java.lang.Object toString [] x []))
+
+(def__ #export (interpose sep xs)
+ (All [a]
+ (-> a ($' List a) ($' List a)))
+ (case' xs
+ #Nil
+ xs
+
+ (#Cons [x #Nil])
+ xs
+
+ (#Cons [x xs'])
+ (list& x sep (interpose sep xs'))))
+
+(def__ #export (syntax:show syntax)
+ (-> Syntax Text)
+ (case' syntax
+ (#Meta [_ (#Bool value)])
+ (->text value)
+
+ (#Meta [_ (#Int value)])
+ (->text value)
+
+ (#Meta [_ (#Real value)])
+ (->text value)
+
+ (#Meta [_ (#Char value)])
+ ($ text:++ "#\"" (->text value) "\"")
+
+ (#Meta [_ (#Text value)])
+ value
+
+ (#Meta [_ (#Symbol ident)])
+ (ident->text ident)
+
+ (#Meta [_ (#Tag ident)])
+ (text:++ "#" (ident->text ident))
+
+ (#Meta [_ (#Tuple members)])
+ ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")
+
+ (#Meta [_ (#Form members)])
+ ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")
+
+ (#Meta [_ (#Record slots)])
+ ($ text:++ "(" (|> slots
+ (map (:' (-> (, Syntax Syntax) Text)
+ (lambda [slot]
+ (let [[k v] slot]
+ ($ text:++ (syntax:show k) " " (syntax:show v))))))
+ (interpose " ") (fold text:++ "")) ")")
+ ))
+
+(def__ #export (macro-expand syntax)
(-> Syntax ($' Lux ($' List Syntax)))
(case' syntax
(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
@@ -1378,11 +1401,11 @@
[parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
(;return (:' SyntaxList (list ($form (list:join parts'))))))))
- ## (#Meta [_ (#Form (#Cons [harg targs]))])
- ## (do Lux:Monad
- ## [harg+ (macro-expand harg)
- ## targs+ (map% Lux:Monad macro-expand targs)]
- ## (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
+ (#Meta [_ (#Form (#Cons [harg targs]))])
+ (do Lux:Monad
+ [harg+ (macro-expand harg)
+ targs+ (map% Lux:Monad macro-expand targs)]
+ (;return (:' SyntaxList (list ($form (list:++ harg+ (list:join (:' ($' List ($' List Syntax)) targs+))))))))
(#Meta [_ (#Tuple members)])
(do Lux:Monad
@@ -1392,7 +1415,7 @@
_
(return (:' SyntaxList (list syntax)))))
-(def (walk-type type)
+(def__ (walk-type type)
(-> Syntax Syntax)
(case' type
(#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))])
@@ -1450,36 +1473,37 @@
_
[false tokens]))
- ## parts (: (Maybe (, Syntax (List Syntax) Syntax))
- ## (case' tokens'
- ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
- ## (#Some [($symbol name) #Nil type])
+ parts (: (Maybe (, Syntax (List Syntax) Syntax))
+ (case' tokens'
+ (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
+ (#Some [($symbol name) #Nil type])
- ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
- ## (#Some [($symbol name) args type])
+ (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
+ (#Some [($symbol name) args type])
- ## _
- ## #None))
+ _
+ #None))
]
- (return (: (List Syntax) #Nil))
- ## (case' parts
- ## (#Some [name args type])
- ## (let [with-export (: (List Syntax)
- ## (if export?
- ## (list (` (export' (~ name))))
- ## #Nil))
- ## type' (: Syntax
- ## (case' args
- ## #Nil
- ## type
-
- ## _
- ## (` (;All (~ name) [(~@ args)] (~ type)))))]
- ## (return (: (List Syntax)
- ## (list& type' with-export))))
-
- ## #None
- ## (fail "Wrong syntax for deftype"))
+ ## (return (: (List Syntax) #Nil))
+ (case' parts
+ (#Some [name args type])
+ (let [with-export (: (List Syntax)
+ (if export?
+ (list (` (export' (~ name))))
+ #Nil))
+ type' (: Syntax
+ (case' args
+ #Nil
+ type
+
+ _
+ (` (;All (~ name) [(~@ args)] (~ type)))))]
+ (return (: (List Syntax)
+ (list& (` (def' (~ name) (;type` (~ type'))))
+ with-export))))
+
+ #None
+ (fail "Wrong syntax for deftype"))
))
(deftype #export (IO a)
@@ -1489,7 +1513,8 @@
(case' tokens
(#Cons [value #Nil])
(let [blank ($symbol ["" ""])]
- (return (list (` (lambda' (~ blank) (~ blank) (~ value))))))
+ (return (: (List Syntax)
+ (list (` (lambda' (~ blank) (~ blank) (~ value)))))))
_
(fail "Wrong syntax for io")))
@@ -1508,6 +1533,51 @@
_
(fail "Wrong syntax for exec")))
+(defmacro #export (def tokens)
+ (let [[export? tokens'] (: (, Bool (List Syntax))
+ (case' tokens
+ (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
+ [true tokens']
+
+ _
+ [false tokens]))
+ parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+ (case' tokens'
+ (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])])
+ (#Some [name args (#Some type) body])
+
+ (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+ (#Some [name #Nil (#Some type) body])
+
+ (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])
+ (#Some [name args #None body])
+
+ (#Cons [name (#Cons [body #Nil])])
+ (#Some [name #Nil #None body])
+
+ _
+ #None))]
+ (case' parts
+ (#Some [name args ?type body])
+ (let [body' (: Syntax
+ (case' args
+ #Nil
+ body
+
+ _
+ (` (;lambda (~ name) [(~@ args)] (~ body)))))
+ body'' (: Syntax
+ (case' ?type
+ (#Some type)
+ (` (: (~ type) (~ body')))
+
+ #None
+ body'))]
+ (return (: (List Syntax) (list (` (def' (~ name) (~ body'')))))))
+
+ #None
+ (fail "Wrong syntax for def"))))
+
(def (rejoin-pair pair)
(-> (, Syntax Syntax) (List Syntax))
(let [[left right] pair]
@@ -1515,24 +1585,26 @@
(defmacro #export (case tokens)
(case' tokens
- (#Cons value branches)
+ (#Cons [value branches])
(do Lux:Monad
[expansions (map% Lux:Monad
(: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
(lambda expander [branch]
(let [[pattern body] branch]
(case' pattern
- (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args])
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args]))])
(do Lux:Monad
- [expansion (macro-expand (list& ($symbol macro-name) body macro-args))]
- (map% Lux:Monad expander (as-pairs expansion)))
+ [expansion (macro-expand ($form (list& ($symbol macro-name) body macro-args)))
+ expansions (map% Lux:Monad expander (as-pairs (: (List Syntax) expansion)))]
+ (;return (list:join (: (List (List (, Syntax Syntax))) expansions))))
_
(;return (: (List (, Syntax Syntax)) (list branch)))))))
(as-pairs branches))]
- (;return (: (List (, Syntax Syntax))
+ (;return (: (List Syntax)
(list (` (case' (~ value)
- (~@ (|> expansions list:join (map rejoin-pair) list:join))))))))
+ (~@ (|> (: (List (List (, Syntax Syntax))) expansions) list:join (map rejoin-pair) list:join))
+ ))))))
_
(fail "Wrong syntax for case")))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 07:29:32 +0000