aboutsummaryrefslogtreecommitdiff
path: root/source/lux.lux
diff options
context:
space:
mode:
Diffstat (limited to 'source/lux.lux')
-rw-r--r--source/lux.lux1115
1 files changed, 611 insertions, 504 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 8861bc241..dc186fb3d 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -373,7 +373,7 @@
(_lux_lambda _ tokens
(_meta (#RecordS tokens)))))
-(_lux_def let'
+(_lux_def let''
(_lux_: Macro
(_lux_lambda _ tokens
(_lux_case tokens
@@ -383,10 +383,10 @@
#Nil]))
_
- (fail "Wrong syntax for let'")))))
-(_lux_declare-macro let')
+ (fail "Wrong syntax for let''")))))
+(_lux_declare-macro let'')
-(_lux_def lambda'
+(_lux_def lambda''
(_lux_: Macro
(_lux_lambda _ tokens
(_lux_case tokens
@@ -399,7 +399,7 @@
body
_
- (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
+ (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
(#Cons [(_meta (#TupleS args'))
(#Cons [body #Nil])])]))))
#Nil])])])])))
@@ -414,7 +414,7 @@
body
_
- (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
+ (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
(#Cons [(_meta (#TupleS args'))
(#Cons [body #Nil])])]))))
#Nil])])])])))
@@ -422,73 +422,73 @@
_
(fail "Wrong syntax for lambda")))))
-(_lux_declare-macro lambda')
+(_lux_declare-macro lambda'')
-(_lux_def def'
+(_lux_def def''
(_lux_: Macro
- (lambda' [tokens]
- (_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])])
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
- (#Cons [name
- (#Cons [(_meta (#TupleS args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])])])))
- (#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
- #Nil])]))
-
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- #Nil])])])))
- (#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
- #Nil])]))
-
- (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
- (#Cons [type (#Cons [body #Nil])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda'"]))
- (#Cons [name
- (#Cons [(_meta (#TupleS args))
- (#Cons [body #Nil])])])])))
- #Nil])])])))
- #Nil])])])))
- #Nil]))
-
- (#Cons [name (#Cons [type (#Cons [body #Nil])])])
- (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
- (#Cons [name
- (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
- (#Cons [type
- (#Cons [body
- #Nil])])])))
- #Nil])])])))
- #Nil]))
+ (lambda'' [tokens]
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#TagS ["" "export"])])
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
+ (#Cons [name
+ (#Cons [(_meta (#TupleS args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])])])))
+ (#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
+ #Nil])]))
+
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [name (#Cons [type (#Cons [body #Nil])])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])))
+ (#Cons [(_meta (#FormS (#Cons [(symbol$ ["" "_lux_export"]) (#Cons [name #Nil])])))
+ #Nil])]))
+
+ (#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
+ (#Cons [type (#Cons [body #Nil])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
+ (#Cons [name
+ (#Cons [(_meta (#TupleS args))
+ (#Cons [body #Nil])])])])))
+ #Nil])])])))
+ #Nil])])])))
+ #Nil]))
+
+ (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+ (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_def"]))
+ (#Cons [name
+ (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_:"]))
+ (#Cons [type
+ (#Cons [body
+ #Nil])])])))
+ #Nil])])])))
+ #Nil]))
- _
- (fail "Wrong syntax for def")
- ))))
-(_lux_declare-macro def')
+ _
+ (fail "Wrong syntax for def")
+ ))))
+(_lux_declare-macro def'')
-(def' (defmacro tokens)
+(def'' (defmacro tokens)
Macro
(_lux_case tokens
(#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
- (return (#Cons [(form$ (#Cons [(symbol$ ["lux" "def'"])
+ (return (#Cons [(form$ (#Cons [(symbol$ ["lux" "def''"])
(#Cons [(form$ (#Cons [name args]))
(#Cons [(symbol$ ["lux" "Macro"])
(#Cons [body
@@ -498,7 +498,7 @@
#Nil])]))
(#Cons [(#Meta [_ (#TagS ["" "export"])]) (#Cons [(#Meta [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])])
- (return (#Cons [(form$ (#Cons [(symbol$ ["lux" "def'"])
+ (return (#Cons [(form$ (#Cons [(symbol$ ["lux" "def''"])
(#Cons [(tag$ ["" "export"])
(#Cons [(form$ (#Cons [name args]))
(#Cons [(symbol$ ["lux" "Macro"])
@@ -587,7 +587,7 @@
_
(fail "Wrong syntax for $'")))
-(def' (foldL f init xs)
+(def'' (foldL f init xs)
(All' [a b]
(->' (->' (B' a) (B' b) (B' a))
(B' a)
@@ -600,18 +600,18 @@
(#Cons [x xs'])
(foldL f (f init x) xs')))
-(def' (reverse list)
+(def'' (reverse list)
(All' [a]
(->' ($' List (B' a)) ($' List (B' a))))
- (foldL (lambda' [tail head] (#Cons [head tail]))
+ (foldL (lambda'' [tail head] (#Cons [head tail]))
#Nil
list))
(defmacro (list xs)
- (return (#Cons [(foldL (lambda' [tail head]
- (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"]))
- (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])])))
- #Nil])]))))
+ (return (#Cons [(foldL (lambda'' [tail head]
+ (_meta (#FormS (#Cons [(_meta (#TagS ["lux" "Cons"]))
+ (#Cons [(_meta (#TupleS (#Cons [head (#Cons [tail #Nil])])))
+ #Nil])]))))
(_meta (#TagS ["lux" "Nil"]))
(reverse xs))
#Nil])))
@@ -619,45 +619,45 @@
(defmacro (list& xs)
(_lux_case (reverse xs)
(#Cons [last init])
- (return (list (foldL (lambda' [tail head]
- (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
- (_meta (#TupleS (list head tail)))))))
+ (return (list (foldL (lambda'' [tail head]
+ (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
+ (_meta (#TupleS (list head tail)))))))
last
init)))
_
(fail "Wrong syntax for list&")))
-(defmacro #export (lambda tokens)
- (let' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax)))
- (_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
- [name tokens']
-
- _
- [["" ""] tokens]))
- (_lux_case tokens'
- (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
- (_lux_case args
- #Nil
- (fail "lambda requires a non-empty arguments tuple.")
-
- (#Cons [harg targs])
- (return (list (form$ (list (symbol$ ["" "_lux_lambda"])
- (symbol$ name)
- harg
- (foldL (lambda' [body' arg]
- (form$ (list (symbol$ ["" "_lux_lambda"])
- (symbol$ ["" ""])
- arg
- body')))
- body
- (reverse targs)))))))
-
- _
- (fail "Wrong syntax for lambda"))))
+(defmacro (lambda' tokens)
+ (let'' [name tokens'] (_lux_: (#TupleT (list Ident ($' List Syntax)))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#SymbolS name)]) tokens'])
+ [name tokens']
-(defmacro (def'' tokens)
+ _
+ [["" ""] tokens]))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
+ (_lux_case args
+ #Nil
+ (fail "lambda' requires a non-empty arguments tuple.")
+
+ (#Cons [harg targs])
+ (return (list (form$ (list (symbol$ ["" "_lux_lambda"])
+ (symbol$ name)
+ harg
+ (foldL (lambda'' [body' arg]
+ (form$ (list (symbol$ ["" "_lux_lambda"])
+ (symbol$ ["" ""])
+ arg
+ body')))
+ body
+ (reverse targs)))))))
+
+ _
+ (fail "Wrong syntax for lambda'"))))
+
+(defmacro (def''' tokens)
(_lux_case tokens
(#Cons [(#Meta [_ (#TagS ["" "export"])])
(#Cons [(#Meta [_ (#FormS (#Cons [name args]))])
@@ -666,7 +666,7 @@
name
(form$ (list (symbol$ ["" "_lux_:"])
type
- (form$ (list (symbol$ ["lux" "lambda"])
+ (form$ (list (symbol$ ["lux" "lambda'"])
name
(tuple$ args)
body))))))
@@ -686,7 +686,7 @@
name
(form$ (list (symbol$ ["" "_lux_:"])
type
- (form$ (list (symbol$ ["lux" "lambda"])
+ (form$ (list (symbol$ ["lux" "lambda'"])
name
(tuple$ args)
body))))))))
@@ -697,10 +697,10 @@
(form$ (list (symbol$ ["" "_lux_:"]) type body))))))
_
- (fail "Wrong syntax for def")
+ (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))))))
(_lux_case xs
@@ -710,22 +710,22 @@
_
#Nil))
-(defmacro #export (let tokens)
+(defmacro (let' tokens)
(_lux_case tokens
(#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])
(return (list (foldL (_lux_: (->' Syntax (#TupleT (list Syntax Syntax))
Syntax)
- (lambda [body binding]
- (_lux_case binding
- [label value]
- (form$ (list (symbol$ ["" "_lux_case"]) value label body)))))
+ (lambda' [body binding]
+ (_lux_case binding
+ [label value]
+ (form$ (list (symbol$ ["" "_lux_case"]) value label body)))))
body
(reverse (as-pairs bindings)))))
_
- (fail "Wrong syntax for let")))
+ (fail "Wrong syntax for let'")))
-(def'' (map f xs)
+(def''' (map f xs)
(All' [a b]
(->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
(_lux_case xs
@@ -735,7 +735,7 @@
(#Cons [x xs'])
(#Cons [(f x) (map f xs')])))
-(def'' (any? p xs)
+(def''' (any? p xs)
(All' [a]
(->' (->' (B' a) Bool) ($' List (B' a)) Bool))
(_lux_case xs
@@ -747,7 +747,7 @@
true true
false (any? p xs'))))
-(def'' (spliced? token)
+(def''' (spliced? token)
(->' Syntax Bool)
(_lux_case token
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [_ #Nil])]))])
@@ -756,13 +756,13 @@
_
false))
-(def'' (wrap-meta content)
+(def''' (wrap-meta content)
(->' Syntax Syntax)
(_meta (#FormS (list (_meta (#TagS ["lux" "Meta"]))
(_meta (#TupleS (list (_meta (#TupleS (list (_meta (#TextS "")) (_meta (#IntS -1)) (_meta (#IntS -1)))))
content)))))))
-(def'' (untemplate-list tokens)
+(def''' (untemplate-list tokens)
(->' ($' List Syntax) Syntax)
(_lux_case tokens
#Nil
@@ -772,7 +772,7 @@
(_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
(_meta (#TupleS (list token (untemplate-list tokens')))))))))
-(def'' #export (list:++ xs ys)
+(def''' #export (list:++ xs ys)
(All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
(_lux_case xs
(#Cons [x xs'])
@@ -784,41 +784,41 @@
(defmacro #export ($ tokens)
(_lux_case tokens
(#Cons [op (#Cons [init args])])
- (return (list (foldL (lambda [a1 a2] (form$ (list op a1 a2)))
+ (return (list (foldL (lambda' [a1 a2] (form$ (list op a1 a2)))
init
args)))
_
(fail "Wrong syntax for $")))
-(def'' (splice replace? untemplate tag elems)
+(def''' (splice replace? untemplate tag elems)
(->' Bool (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
(_lux_case replace?
true
(_lux_case (any? spliced? elems)
true
- (let [elems' (map (lambda [elem]
- (_lux_case elem
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
- spliced
-
- _
- (form$ (list (symbol$ ["" "_lux_:"])
- (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "Syntax"])))))
- (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list (untemplate elem)
- (tag$ ["lux" "Nil"])))))))))
- elems)]
- (wrap-meta (form$ (list tag
- (form$ (list& (symbol$ ["lux" "$"])
- (symbol$ ["lux" "list:++"])
- elems'))))))
+ (let' [elems' (map (lambda' [elem]
+ (_lux_case elem
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
+ spliced
+
+ _
+ (form$ (list (symbol$ ["" "_lux_:"])
+ (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "Syntax"])))))
+ (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list (untemplate elem)
+ (tag$ ["lux" "Nil"])))))))))
+ 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))))))
false
(wrap-meta (form$ (list tag (untemplate-list (map untemplate elems)))))))
-(def'' (untemplate replace? subst token)
+(def''' (untemplate replace? subst token)
(->' Bool Text Syntax Syntax)
(_lux_case (_lux_: (#TupleT (list Bool Syntax)) [replace? token])
[_ (#Meta [_ (#BoolS value)])]
@@ -837,22 +837,22 @@
(wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))
[_ (#Meta [_ (#TagS [module name])])]
- (let [module' (_lux_case module
- ""
- subst
+ (let' [module' (_lux_case module
+ ""
+ subst
- _
- module)]
- (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))
+ _
+ module)]
+ (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))
[_ (#Meta [_ (#SymbolS [module name])])]
- (let [module' (_lux_case module
- ""
- subst
+ (let' [module' (_lux_case module
+ ""
+ subst
- _
- module)]
- (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
+ _
+ module)]
+ (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
[_ (#Meta [_ (#TupleS elems)])]
(splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
@@ -861,15 +861,15 @@
unquoted
[_ (#Meta [meta (#FormS elems)])]
- (let [(#Meta [_ form']) (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
- (#Meta [meta form']))
+ (let' [(#Meta [_ form']) (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)]
+ (#Meta [meta form']))
[_ (#Meta [_ (#RecordS fields)])]
(wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
(untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax)
- (lambda [kv]
- (let [[k v] kv]
- (tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
+ (lambda' [kv]
+ (let' [[k v] kv]
+ (tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
fields)))))
))
@@ -881,7 +881,7 @@
_
(fail "Wrong syntax for `'")))
-(defmacro (' tokens)
+(defmacro #export (' tokens)
(_lux_case tokens
(#Cons [template #Nil])
(return (list (untemplate false "" template)))
@@ -892,16 +892,16 @@
(defmacro #export (|> tokens)
(_lux_case tokens
(#Cons [init apps])
- (return (list (foldL (lambda [acc app]
- (_lux_case app
- (#Meta [_ (#TupleS parts)])
- (tuple$ (list:++ parts (list acc)))
+ (return (list (foldL (lambda' [acc app]
+ (_lux_case app
+ (#Meta [_ (#TupleS parts)])
+ (tuple$ (list:++ parts (list acc)))
- (#Meta [_ (#FormS parts)])
- (form$ (list:++ parts (list acc)))
+ (#Meta [_ (#FormS parts)])
+ (form$ (list:++ parts (list acc)))
- _
- (`' ((~ app) (~ acc)))))
+ _
+ (`' ((~ app) (~ acc)))))
init
apps)))
@@ -920,7 +920,7 @@
## (deftype (Lux a)
## (-> Compiler (Either Text (, Compiler a))))
-(def'' #export Lux
+(def''' #export Lux
Type
(All' [a]
(->' Compiler ($' Either Text (#TupleT (list Compiler (B' a)))))))
@@ -930,7 +930,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))))]
@@ -938,34 +938,34 @@
($' (B' m) (B' a))
($' (B' m) (B' b))))]))))
-(def'' Maybe/Monad
+(def''' Maybe/Monad
($' Monad Maybe)
{#lux;return
- (lambda return [x]
- (#Some x))
+ (lambda' return [x]
+ (#Some x))
#lux;bind
- (lambda [f ma]
- (_lux_case ma
- #None #None
- (#Some a) (f a)))})
+ (lambda' [f ma]
+ (_lux_case ma
+ #None #None
+ (#Some a) (f a)))})
-(def'' Lux/Monad
+(def''' Lux/Monad
($' Monad Lux)
{#lux;return
- (lambda [x]
- (lambda [state]
- (#Right [state x])))
+ (lambda' [x]
+ (lambda' [state]
+ (#Right [state x])))
#lux;bind
- (lambda [f ma]
- (lambda [state]
- (_lux_case (ma state)
- (#Left msg)
- (#Left msg)
+ (lambda' [f ma]
+ (lambda' [state]
+ (_lux_case (ma state)
+ (#Left msg)
+ (#Left msg)
- (#Right [state' a])
- (f a state'))))})
+ (#Right [state' a])
+ (f a state'))))})
(defmacro #export (^ tokens)
(_lux_case tokens
@@ -978,7 +978,7 @@
(defmacro #export (-> tokens)
(_lux_case (reverse tokens)
(#Cons [output inputs])
- (return (list (foldL (lambda [o i] (`' (#;LambdaT [(~ i) (~ o)])))
+ (return (list (foldL (lambda' [o i] (`' (#;LambdaT [(~ i) (~ o)])))
output
inputs)))
@@ -991,28 +991,28 @@
(defmacro (do tokens)
(_lux_case tokens
(#Cons [monad (#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [body #Nil])])])
- (let [body' (foldL (_lux_: (-> Syntax (, Syntax Syntax) Syntax)
- (lambda [body' binding]
- (let [[var value] binding]
- (_lux_case var
- (#Meta [_ (#TagS ["" "let"])])
- (`' (;let (~ value) (~ body')))
-
- _
- (`' (;bind (_lux_lambda (~ (symbol$ ["" ""]))
- (~ var)
- (~ body'))
- (~ value)))))))
- body
- (reverse (as-pairs bindings)))]
- (return (list (`' (_lux_case (~ monad)
- {#;return ;return #;bind ;bind}
- (~ body'))))))
+ (let' [body' (foldL (_lux_: (-> Syntax (, Syntax Syntax) Syntax)
+ (lambda' [body' binding]
+ (let' [[var value] binding]
+ (_lux_case var
+ (#Meta [_ (#TagS ["" "let"])])
+ (`' (;let' (~ value) (~ body')))
+
+ _
+ (`' (;bind (_lux_lambda (~ (symbol$ ["" ""]))
+ (~ var)
+ (~ body'))
+ (~ value)))))))
+ body
+ (reverse (as-pairs bindings)))]
+ (return (list (`' (_lux_case (~ monad)
+ {#;return ;return #;bind ;bind}
+ (~ body'))))))
_
(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]
@@ -1020,25 +1020,25 @@
(-> (B' a) ($' (B' m) (B' b)))
($' List (B' a))
($' (B' m) ($' List (B' b)))))
- (let [{#;return ;return #;bind _} m]
- (_lux_case xs
- #Nil
- (;return #Nil)
-
- (#Cons [x xs'])
- (do m
- [y (f x)
- ys (map% m f xs')]
- (;return (#Cons [y ys])))
- )))
+ (let' [{#;return ;return #;bind _} m]
+ (_lux_case xs
+ #Nil
+ (;return #Nil)
+
+ (#Cons [x xs'])
+ (do m
+ [y (f x)
+ ys (map% m f xs')]
+ (;return (#Cons [y ys])))
+ )))
-(def'' #export (. f g)
+(def''' (. f g)
(All' [a b c]
(-> (-> (B' b) (B' c)) (-> (B' a) (B' b)) (-> (B' a) (B' c))))
- (lambda [x]
- (f (g x))))
+ (lambda' [x]
+ (f (g x))))
-(def'' (get-ident x)
+(def''' (get-ident x)
(-> Syntax ($' Maybe Text))
(_lux_case x
(#Meta [_ (#SymbolS ["" sname])])
@@ -1047,7 +1047,7 @@
_
#None))
-(def'' (tuple->list tuple)
+(def''' (tuple->list tuple)
(-> Syntax ($' Maybe ($' List Syntax)))
(_lux_case tuple
(#Meta [_ (#TupleS members)])
@@ -1056,11 +1056,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)
(_lux_case (_lux_: (, ($' List Text) ($' List Syntax))
[xs ys])
@@ -1070,12 +1070,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))
(_lux_case env
#Nil
@@ -1086,7 +1086,7 @@
(#Some v)
(get-rep key env'))))
-(def'' (apply-template env template)
+(def''' (apply-template env template)
(-> RepEnv Syntax Syntax)
(_lux_case template
(#Meta [_ (#SymbolS ["" sname])])
@@ -1105,15 +1105,15 @@
(#Meta [_ (#RecordS members)])
(record$ (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
- (lambda [kv]
- (let [[slot value] kv]
- [(apply-template env slot) (apply-template env value)])))
+ (lambda' [kv]
+ (let' [[slot value] kv]
+ [(apply-template env slot) (apply-template env value)])))
members))
_
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))))
(_lux_case xs
@@ -1130,11 +1130,11 @@
[(map% Maybe/Monad get-ident bindings)
(map% Maybe/Monad tuple->list data)])
[(#Some bindings') (#Some data')]
- (let [apply (_lux_: (-> RepEnv ($' List Syntax))
- (lambda [env] (map (apply-template env) templates)))]
- (|> data'
- (join-map (. apply (make-env bindings')))
- return))
+ (let' [apply (_lux_: (-> RepEnv ($' List Syntax))
+ (lambda' [env] (map (apply-template env) templates)))]
+ (|> data'
+ (join-map (. apply (make-env bindings')))
+ return))
_
(fail "Wrong syntax for do-template"))
@@ -1143,7 +1143,7 @@
(fail "Wrong syntax for do-template")))
(do-template [<name> <cmp> <type>]
- [(def'' #export (<name> x y)
+ [(def''' (<name> x y)
(-> <type> <type> Bool)
(<cmp> x y))]
@@ -1156,7 +1156,7 @@
)
(do-template [<name> <cmp> <eq> <type>]
- [(def'' #export (<name> x y)
+ [(def''' (<name> x y)
(-> <type> <type> Bool)
(if (<cmp> x y)
true
@@ -1169,7 +1169,7 @@
)
(do-template [<name> <cmp> <type>]
- [(def'' #export (<name> x y)
+ [(def''' (<name> x y)
(-> <type> <type> <type>)
(<cmp> x y))]
@@ -1185,29 +1185,29 @@
[r% _jvm_drem Real]
)
-(def'' (multiple? div n)
+(def''' (multiple? div n)
(-> Int Int Bool)
(i= 0 (i% n div)))
-(def'' (length list)
+(def''' (length list)
(-> List Int)
- (foldL (lambda [acc _] (i+ 1 acc)) 0 list))
+ (foldL (lambda' [acc _] (_jvm_ladd 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)))
+ (let' [[module name] ident]
+ ($ text:++ module ";" name)))
-(def'' (replace-syntax reps syntax)
+(def''' (replace-syntax reps syntax)
(-> RepEnv Syntax Syntax)
(_lux_case syntax
(#Meta [_ (#SymbolS ["" name])])
@@ -1226,9 +1226,9 @@
(#Meta [_ (#RecordS slots)])
(#Meta [_ (#RecordS (map (_lux_: (-> (, Syntax Syntax) (, Syntax Syntax))
- (lambda [slot]
- (let [[k v] slot]
- [(replace-syntax reps k) (replace-syntax reps v)])))
+ (lambda' [slot]
+ (let' [[k v] slot]
+ [(replace-syntax reps k) (replace-syntax reps v)])))
slots))])
_
@@ -1236,40 +1236,40 @@
)
(defmacro #export (All tokens)
- (let [[self-ident tokens'] (_lux_: (, Text SyntaxList)
- (_lux_case tokens
- (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens'])
- [self-ident tokens']
-
- _
- ["" tokens]))]
- (_lux_case tokens'
- (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
- (_lux_case (map% Maybe/Monad get-ident args)
- (#Some idents)
- (_lux_case idents
- #Nil
- (return (list body))
+ (let' [[self-ident tokens'] (_lux_: (, Text SyntaxList)
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#SymbolS ["" self-ident])]) tokens'])
+ [self-ident tokens']
+
+ _
+ ["" tokens]))]
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
+ (_lux_case (map% Maybe/Monad get-ident args)
+ (#Some idents)
+ (_lux_case idents
+ #Nil
+ (return (list body))
+
+ (#Cons [harg targs])
+ (let' [replacements (map (_lux_: (-> Text (, Text Syntax))
+ (lambda' [ident] [ident (`' (#;BoundT (~ (text$ ident))))]))
+ (list& self-ident idents))
+ body' (foldL (lambda' [body' arg']
+ (`' (#;AllT [#;None "" (~ (text$ arg')) (~ body')])))
+ (replace-syntax replacements body)
+ (reverse targs))]
+ ## (#;Some #;Nil)
+ (return (list (`' (#;AllT [#;None (~ (text$ self-ident)) (~ (text$ harg)) (~ body')]))))))
+
+ #None
+ (fail "'All' arguments must be symbols."))
- (#Cons [harg targs])
- (let [replacements (map (_lux_: (-> Text (, Text Syntax))
- (lambda [ident] [ident (`' (#;BoundT (~ (text$ ident))))]))
- (list& self-ident idents))
- body' (foldL (lambda [body' arg']
- (`' (#;AllT [#;None "" (~ (text$ arg')) (~ body')])))
- (replace-syntax replacements body)
- (reverse targs))]
- ## (#;Some #;Nil)
- (return (list (`' (#;AllT [#;None (~ (text$ self-ident)) (~ (text$ harg)) (~ body')]))))))
-
- #None
- (fail "'All' arguments must be symbols."))
-
- _
- (fail "Wrong syntax for All"))
- ))
+ _
+ (fail "Wrong syntax for All"))
+ ))
-(def'' (get k plist)
+(def''' (get k plist)
(All [a]
(-> Text ($' List (, Text a)) ($' Maybe a)))
(_lux_case plist
@@ -1281,7 +1281,7 @@
#Nil
#None))
-(def'' (put k v dict)
+(def''' (put k v dict)
(All [a]
(-> Text a ($' List (, Text a)) ($' List (, Text a))))
(_lux_case dict
@@ -1293,7 +1293,7 @@
(#Cons [[k' v] dict'])
(#Cons [[k' v'] (put k v dict')]))))
-(def'' (get-module-name state)
+(def''' (get-module-name state)
($' Lux Text)
(_lux_case state
{#source source #modules modules
@@ -1306,14 +1306,14 @@
(#Cons [{#name module-name #inner-closures _ #locals _ #closure _} _])
(#Right [state module-name]))))
-(def'' (find-macro' modules current-module module name)
+(def''' (find-macro' modules current-module module name)
(-> ($' List (, Text ($' Module Compiler)))
Text Text Text
($' Maybe Macro))
(do Maybe/Monad
[$module (get module modules)
- gdef (let [{#module-aliases _ #defs bindings #imports _} (_lux_: ($' Module Compiler) $module)]
- (get name bindings))]
+ gdef (let' [{#module-aliases _ #defs bindings #imports _} (_lux_: ($' Module Compiler) $module)]
+ (get name bindings))]
(_lux_case (_lux_: (, Bool ($' DefData' Macro)) gdef)
[exported? (#MacroD macro')]
(if exported?
@@ -1328,24 +1328,24 @@
_
#None)))
-(def'' (find-macro ident)
+(def''' (find-macro ident)
(-> Ident ($' Lux ($' Maybe Macro)))
(do Lux/Monad
[current-module get-module-name]
- (let [[module name] ident]
- (lambda [state]
- (_lux_case state
- {#source source #modules modules
- #envs envs #types types #host host
- #seed seed #eval? eval?}
- (#Right [state (find-macro' modules current-module module name)]))))))
-
-(def'' (list:join xs)
+ (let' [[module name] ident]
+ (lambda' [state]
+ (_lux_case state
+ {#source source #modules modules
+ #envs envs #types types #host host
+ #seed seed #eval? eval?}
+ (#Right [state (find-macro' modules current-module module name)]))))))
+
+(def''' (list:join xs)
(All [a]
(-> ($' List ($' List a)) ($' List a)))
(foldL list:++ #Nil xs))
-(def'' (normalize ident)
+(def''' (normalize ident)
(-> Ident ($' Lux Ident))
(_lux_case ident
["" name]
@@ -1360,20 +1360,20 @@
(do Lux/Monad
[pairs (map% Lux/Monad
(_lux_: (-> Syntax ($' Lux Syntax))
- (lambda [token]
- (_lux_case token
- (#Meta [_ (#TagS ident)])
- (do Lux/Monad
- [ident (normalize ident)]
- (;return (`' [(~ (text$ (ident->text ident))) (;,)])))
-
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))])
- (do Lux/Monad
- [ident (normalize ident)]
- (;return (`' [(~ (text$ (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for |"))))
+ (lambda' [token]
+ (_lux_case token
+ (#Meta [_ (#TagS ident)])
+ (do Lux/Monad
+ [ident (normalize ident)]
+ (;return (`' [(~ (text$ (ident->text ident))) (;,)])))
+
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))])
+ (do Lux/Monad
+ [ident (normalize ident)]
+ (;return (`' [(~ (text$ (ident->text ident))) (~ value)])))
+
+ _
+ (fail "Wrong syntax for |"))))
tokens)]
(;return (list (`' (#;VariantT (~ (untemplate-list pairs))))))))
@@ -1383,23 +1383,23 @@
(do Lux/Monad
[pairs (map% Lux/Monad
(_lux_: (-> (, Syntax Syntax) ($' Lux Syntax))
- (lambda [pair]
- (_lux_case pair
- [(#Meta [_ (#TagS ident)]) value]
- (do Lux/Monad
- [ident (normalize ident)]
- (;return (`' [(~ (text$ (ident->text ident))) (~ value)])))
-
- _
- (fail "Wrong syntax for &"))))
+ (lambda' [pair]
+ (_lux_case pair
+ [(#Meta [_ (#TagS ident)]) value]
+ (do Lux/Monad
+ [ident (normalize ident)]
+ (;return (`' [(~ (text$ (ident->text ident))) (~ value)])))
+
+ _
+ (fail "Wrong syntax for &"))))
(as-pairs tokens))]
(;return (list (`' (#;RecordT (~ (untemplate-list pairs)))))))))
-(def'' #export (->text x)
+(def''' (->text x)
(-> (^ java.lang.Object) Text)
(_jvm_invokevirtual "java.lang.Object" "toString" [] x []))
-(def'' (interpose sep xs)
+(def''' (interpose sep xs)
(All [a]
(-> a ($' List a) ($' List a)))
(_lux_case xs
@@ -1412,7 +1412,7 @@
(#Cons [x xs'])
(list& x sep (interpose sep xs'))))
-(def'' (macro-expand syntax)
+(def''' (macro-expand syntax)
(-> Syntax ($' Lux ($' List Syntax)))
(_lux_case syntax
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
@@ -1445,7 +1445,7 @@
_
(return (list syntax))))
-(def'' (walk-type type)
+(def''' (walk-type type)
(-> Syntax Syntax)
(_lux_case type
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS tag)]) parts]))])
@@ -1455,7 +1455,7 @@
(tuple$ (map walk-type members))
(#Meta [_ (#FormS (#Cons [type-fn args]))])
- (foldL (lambda [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))
+ (foldL (lambda' [type-fn arg] (`' (#;AppT [(~ type-fn) (~ arg)])))
(walk-type type-fn)
(map walk-type args))
@@ -1493,71 +1493,71 @@
_
(fail "Wrong syntax for :!")))
-(def'' (empty? xs)
+(def''' (empty? xs)
(All [a] (-> ($' List a) Bool))
(_lux_case xs
#Nil true
_ false))
(defmacro #export (deftype tokens)
- (let [[export? tokens'] (: (, Bool (List Syntax))
- (_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
- [true tokens']
+ (let' [[export? tokens'] (: (, Bool (List Syntax))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+ [true tokens']
+
+ _
+ [false tokens]))
+ [rec? tokens'] (: (, Bool (List Syntax))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#TagS ["" "rec"])]) tokens'])
+ [true tokens']
- _
- [false tokens]))
- [rec? tokens'] (: (, Bool (List Syntax))
- (_lux_case tokens'
- (#Cons [(#Meta [_ (#TagS ["" "rec"])]) tokens'])
- [true tokens']
-
- _
- [false tokens']))
- parts (: (Maybe (, Text (List Syntax) Syntax))
- (_lux_case tokens'
- (#Cons [(#Meta [_ (#SymbolS ["" name])]) (#Cons [type #Nil])])
- (#Some [name #Nil type])
+ _
+ [false tokens']))
+ parts (: (Maybe (, Text (List Syntax) Syntax))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#SymbolS ["" name])]) (#Cons [type #Nil])])
+ (#Some [name #Nil type])
- (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" name])]) args]))]) (#Cons [type #Nil])])
- (#Some [name args type])
+ (#Cons [(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" name])]) args]))]) (#Cons [type #Nil])])
+ (#Some [name args type])
- _
- #None))]
- (_lux_case parts
- (#Some [name args type])
- (let [with-export (: (List Syntax)
- (if export?
- (list (`' (_lux_export (~ (symbol$ ["" name])))))
- #Nil))
- type' (: (Maybe Syntax)
- (if rec?
- (if (empty? args)
- (let [g!param (symbol$ ["" ""])
- prime-name (symbol$ ["" (text:++ name "'")])
- type+ (replace-syntax (list [name (`' ((~ prime-name) (~ g!param)))]) type)]
- (#Some (`' ((;All (~ prime-name) [(~ g!param)] (~ type+))
- ;Void))))
- #None)
- (_lux_case args
- #Nil
- (#Some type)
-
- _
- (#Some (`' (;All (~ (symbol$ ["" name])) [(~@ args)] (~ type)))))))]
- (_lux_case type'
- (#Some type'')
- (return (list& (`' (_lux_def (~ (symbol$ ["" name])) (;type (~ type''))))
- with-export))
+ _
+ #None))]
+ (_lux_case parts
+ (#Some [name args type])
+ (let' [with-export (: (List Syntax)
+ (if export?
+ (list (`' (_lux_export (~ (symbol$ ["" name])))))
+ #Nil))
+ type' (: (Maybe Syntax)
+ (if rec?
+ (if (empty? args)
+ (let' [g!param (symbol$ ["" ""])
+ prime-name (symbol$ ["" (text:++ name "'")])
+ type+ (replace-syntax (list [name (`' ((~ prime-name) (~ g!param)))]) type)]
+ (#Some (`' ((;All (~ prime-name) [(~ g!param)] (~ type+))
+ ;Void))))
+ #None)
+ (_lux_case args
+ #Nil
+ (#Some type)
+
+ _
+ (#Some (`' (;All (~ (symbol$ ["" name])) [(~@ args)] (~ type)))))))]
+ (_lux_case type'
+ (#Some type'')
+ (return (list& (`' (_lux_def (~ (symbol$ ["" name])) (;type (~ type''))))
+ with-export))
+
+ #None
+ (fail "Wrong syntax for deftype")))
#None
- (fail "Wrong syntax for deftype")))
-
- #None
- (fail "Wrong syntax for deftype"))
- ))
+ (fail "Wrong syntax for deftype"))
+ ))
## (defmacro #export (deftype tokens)
-## (let [[export? tokens'] (: (, Bool (List Syntax))
+## (let' [[export? tokens'] (: (, Bool (List Syntax))
## (_lux_case (:! (List Syntax) tokens)
## (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
## [true (:! (List Syntax) tokens')]
@@ -1576,7 +1576,7 @@
## #None))]
## (_lux_case parts
## (#Some [name args type])
-## (let [with-export (: (List Syntax)
+## (let' [with-export (: (List Syntax)
## (if export?
## (list (`' (_lux_export (~ name))))
## #Nil))
@@ -1597,66 +1597,66 @@
(defmacro #export (exec tokens)
(_lux_case (reverse tokens)
(#Cons [value actions])
- (let [dummy (symbol$ ["" ""])]
- (return (list (foldL (lambda [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post))))
- value
- actions))))
+ (let' [dummy (symbol$ ["" ""])]
+ (return (list (foldL (lambda' [post pre] (`' (_lux_case (~ pre) (~ dummy) (~ post))))
+ value
+ actions))))
_
(fail "Wrong syntax for exec")))
-(defmacro #export (def tokens)
- (let [[export? tokens'] (: (, Bool (List Syntax))
- (_lux_case tokens
- (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
- [true tokens']
+(defmacro (def' tokens)
+ (let' [[export? tokens'] (: (, Bool (List Syntax))
+ (_lux_case tokens
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+ [true tokens']
+
+ _
+ [false tokens]))
+ parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+ (_lux_case tokens'
+ (#Cons [(#Meta [_ (#FormS (#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 [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
+ (#Some [name args #None body])
+
+ (#Cons [name (#Cons [body #Nil])])
+ (#Some [name #Nil #None body])
- _
- [false tokens]))
- parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
- (_lux_case tokens'
- (#Cons [(#Meta [_ (#FormS (#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 [_ (#FormS (#Cons [name args]))]) (#Cons [body #Nil])])
- (#Some [name args #None body])
-
- (#Cons [name (#Cons [body #Nil])])
- (#Some [name #Nil #None body])
-
- _
- #None))]
- (_lux_case parts
- (#Some [name args ?type body])
- (let [body' (: Syntax
- (_lux_case args
- #Nil
- body
+ _
+ #None))]
+ (_lux_case parts
+ (#Some [name args ?type body])
+ (let' [body' (: Syntax
+ (_lux_case args
+ #Nil
+ body
- _
- (`' (;lambda (~ name) [(~@ args)] (~ body)))))
- body'' (: Syntax
- (_lux_case ?type
- (#Some type)
- (`' (: (~ type) (~ body')))
-
- #None
- body'))]
- (return (list& (`' (_lux_def (~ name) (~ body'')))
- (if export?
- (list (`' (_lux_export (~ name))))
- #Nil))))
-
- #None
- (fail "Wrong syntax for def"))))
+ _
+ (`' (;lambda' (~ name) [(~@ args)] (~ body)))))
+ body'' (: Syntax
+ (_lux_case ?type
+ (#Some type)
+ (`' (: (~ type) (~ body')))
+
+ #None
+ body'))]
+ (return (list& (`' (_lux_def (~ name) (~ body'')))
+ (if export?
+ (list (`' (_lux_export (~ name))))
+ #Nil))))
+
+ #None
+ (fail "Wrong syntax for def'"))))
-(def (rejoin-pair pair)
+(def' (rejoin-pair pair)
(-> (, Syntax Syntax) (List Syntax))
- (let [[left right] pair]
- (list left right)))
+ (let' [[left right] pair]
+ (list left right)))
(defmacro #export (case tokens)
(_lux_case tokens
@@ -1664,17 +1664,17 @@
(do Lux/Monad
[expansions (map% Lux/Monad
(: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
- (lambda expander [branch]
- (let [[pattern body] branch]
- (_lux_case pattern
- (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) macro-args]))])
- (do Lux/Monad
- [expansion (macro-expand (form$ (list& (symbol$ macro-name) body macro-args)))
- expansions (map% Lux/Monad expander (as-pairs expansion))]
- (;return (list:join expansions)))
-
- _
- (;return (list branch))))))
+ (lambda' expander [branch]
+ (let' [[pattern body] branch]
+ (_lux_case pattern
+ (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) macro-args]))])
+ (do Lux/Monad
+ [expansion (macro-expand (form$ (list& (symbol$ macro-name) body macro-args)))
+ expansions (map% Lux/Monad expander (as-pairs expansion))]
+ (;return (list:join expansions)))
+
+ _
+ (;return (list branch))))))
(as-pairs branches))]
(;return (list (`' (_lux_case (~ value)
(~@ (|> expansions list:join (map rejoin-pair) list:join)))))))
@@ -1707,18 +1707,12 @@
_
(do Lux/Monad
[patterns' (map% Lux/Monad macro-expand patterns)]
- (;return (list:join (map (lambda [pattern] (list pattern body))
+ (;return (list:join (map (lambda' [pattern] (list pattern body))
(list:join patterns'))))))
_
(fail "Wrong syntax for \\or")))
-(do-template [<name> <offset>]
- [(def #export <name> (i+ <offset>))]
-
- [inc 1]
- [dec -1])
-
(defmacro #export (` tokens)
(do Lux/Monad
[module-name get-module-name]
@@ -1729,6 +1723,147 @@
_
(fail "Wrong syntax for `"))))
+(def' (symbol? ast)
+ (-> Syntax Bool)
+ (case ast
+ (#Meta [_ (#SymbolS _)])
+ true
+
+ _
+ false))
+
+(defmacro #export (let tokens)
+ (case tokens
+ (\ (list (#Meta [_ (#TupleS bindings)]) body))
+ (if (multiple? 2 (length bindings))
+ (|> bindings as-pairs reverse
+ (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (lambda' [body' lr]
+ (let' [[l r] lr]
+ (if (symbol? l)
+ (` (_lux_case (~ r) (~ l) (~ body')))
+ (` (case (~ r) (~ l) (~ body')))))))
+ body)
+ list
+ return)
+ (fail "let requires an even number of parts"))
+
+ _
+ (fail "Wrong syntax for let")))
+
+(def' (ast:show ast)
+ (-> Syntax Text)
+ (case ast
+ (#Meta [_ ast])
+ (case ast
+ (\or (#BoolS val) (#IntS val) (#RealS val))
+ (->text val)
+
+ (#CharS val)
+ ($ text:++ "#\"" (->text val) "\"")
+
+ (#TextS val)
+ ($ text:++ "\"" (->text val) "\"")
+
+ (#FormS parts)
+ ($ text:++ "(" (|> parts (map ast:show) (interpose " ") (foldL text:++ "")) ")")
+
+ (#TupleS parts)
+ ($ text:++ "[" (|> parts (map ast:show) (interpose " ") (foldL text:++ "")) "]")
+
+ (#SymbolS [prefix name])
+ ($ text:++ prefix ";" name)
+
+ (#TagS [prefix name])
+ ($ text:++ "#" prefix ";" name)
+
+ (#RecordS kvs)
+ ($ text:++ "{"
+ (|> kvs
+ (map (: (-> (, Syntax Syntax) Text)
+ (lambda' [kv] (let [[k v] kv] ($ text:++ (ast:show k) " " (ast:show v))))))
+ (interpose " ")
+ (foldL text:++ ""))
+ "}")
+ )))
+
+(defmacro #export (lambda tokens)
+ (case (: (Maybe (, Ident Syntax (List Syntax) Syntax))
+ (case tokens
+ (\ (list (#Meta [_ (#TupleS (#Cons [head tail]))]) body))
+ (#Some [["" ""] head tail body])
+
+ (\ (list (#Meta [_ (#SymbolS ident)]) (#Meta [_ (#TupleS (#Cons [head tail]))]) body))
+ (#Some [ident head tail body])
+
+ _
+ #None))
+ (#Some [ident head tail body])
+ (let [g!blank (symbol$ ["" ""])
+ g!name (symbol$ ident)
+ body+ (: Syntax (foldL (: (-> Syntax Syntax Syntax)
+ (lambda' [body' arg]
+ (if (symbol? arg)
+ (` (_lux_lambda (~ g!blank) (~ arg) (~ body')))
+ (` (_lux_lambda (~ g!blank) (~ g!blank)
+ (case (~ g!blank) (~ arg) (~ body')))))))
+ body
+ (reverse tail)))]
+ (return (list (if (symbol? head)
+ (` (_lux_lambda (~ g!name) (~ head) (~ body+)))
+ (` (_lux_lambda (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+))))))))
+
+ #None
+ (fail "Wrong syntax for lambda")))
+
+(defmacro #export (def tokens)
+ (let [[export? tokens'] (: (, Bool (List Syntax))
+ (case tokens
+ (#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
+ [true tokens']
+
+ _
+ [false tokens]))
+ parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+ (case tokens'
+ (\ (list (#Meta [_ (#FormS (#Cons [name args]))]) type body))
+ (#Some [name args (#Some type) body])
+
+ (\ (list name type body))
+ (#Some [name #Nil (#Some type) body])
+
+ (\ (list (#Meta [_ (#FormS (#Cons [name args]))]) body))
+ (#Some [name args #None body])
+
+ (\ (list name body))
+ (#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& (` (_lux_def (~ name) (~ body)))
+ (if export?
+ (list (` (_lux_export (~ name))))
+ (list)))))
+
+ #None
+ (fail "Wrong syntax for def"))))
+
(def (gensym prefix state)
(-> Text (Lux Syntax))
(case state
@@ -1737,7 +1872,7 @@
#seed seed #eval? eval?}
(#Right [{#source source #modules modules
#envs envs #types types #host host
- #seed (inc seed) #eval? eval?}
+ #seed (i+ 1 seed) #eval? eval?}
(symbol$ ["__gensym__" (->text seed)])])))
(def (macro-expand-1 token)
@@ -1758,7 +1893,7 @@
(: (-> Syntax (Lux (, Ident Syntax)))
(lambda [token]
(case token
- (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_:"])]) type (#Meta [_ (#SymbolS name)])))]))
+ (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS [_ "_lux_:"])]) type (#Meta [_ (#SymbolS name)])))]))
(do Lux/Monad
[name' (normalize name)]
(;return (: (, Ident Syntax) [name' type])))
@@ -1766,12 +1901,12 @@
_
(fail "Signatures require typed members!"))))
(list:join tokens'))]
- (;return (list (`' (#;RecordT (~ (untemplate-list (map (: (-> (, Ident Syntax) Syntax)
- (lambda [pair]
- (let [[name type] pair]
- (`' [(~ (|> name ident->text text$))
- (~ type)]))))
- members)))))))))
+ (;return (list (` (#;RecordT (~ (untemplate-list (map (: (-> (, Ident Syntax) Syntax)
+ (lambda [pair]
+ (let [[name type] pair]
+ (` [(~ (|> name ident->text text$))
+ (~ type)]))))
+ members)))))))))
(defmacro #export (defsig tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
@@ -1796,13 +1931,13 @@
(let [sigs' (: Syntax
(case args
#Nil
- (`' (;sig (~@ sigs)))
+ (` (;sig (~@ sigs)))
_
- (`' (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))]
- (return (list& (`' (_lux_def (~ name) (~ sigs')))
+ (` (;All (~ name) [(~@ args)] (;sig (~@ sigs))))))]
+ (return (list& (` (_lux_def (~ name) (~ sigs')))
(if export?
- (list (`' (_lux_export (~ name))))
+ (list (` (_lux_export (~ name))))
#Nil))))
#None
@@ -1815,13 +1950,13 @@
(: (-> Syntax (Lux (, Syntax Syntax)))
(lambda [token]
(case token
- (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_def"])]) (#Meta [_ (#SymbolS name)]) value))]))
+ (\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS [_ "_lux_def"])]) (#Meta [_ (#SymbolS name)]) value))]))
(do Lux/Monad
[name' (normalize name)]
(;return (: (, Syntax Syntax) [(tag$ name') value])))
_
- (fail "Structures require defined members!"))))
+ (fail "Structures require defined members"))))
(list:join tokens'))]
(;return (list (record$ members)))))
@@ -1848,13 +1983,13 @@
(let [defs' (: Syntax
(case args
#Nil
- (`' (;struct (~@ defs)))
+ (` (;struct (~@ defs)))
_
- (`' (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
- (return (list& (`' (def (~ name) (~ type) (~ defs')))
+ (` (;lambda (~ name) [(~@ args)] (;struct (~@ defs))))))]
+ (return (list& (` (def (~ name) (~ type) (~ defs')))
(if export?
- (list (`' (_lux_export (~ name))))
+ (list (` (_lux_export (~ name))))
#Nil))))
#None
@@ -2071,7 +2206,7 @@
(if (i< idx 0)
(#Cons [module #Nil])
(#Cons [(substring2 0 idx module)
- (split-module (substring1 (inc idx) module))]))))
+ (split-module (substring1 (i+ 1 idx) module))]))))
(def (@ idx xs)
(All [a]
@@ -2083,7 +2218,7 @@
(#Cons [x xs'])
(if (i= idx 0)
(#Some x)
- (@ (dec idx) xs')
+ (@ (i- idx 1) xs')
)))
(def (split-with' p ys xs)
@@ -2213,7 +2348,7 @@
(#Some alias) (list (` (_lux_alias (~ (text$ alias)) (~ (text$ m-name))))))
(map (: (-> Text Syntax)
(lambda [def]
- (` ((~ (symbol$ ["" "_lux_def"])) (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
+ (` (_lux_def (~ (symbol$ ["" def])) (~ (symbol$ [m-name def]))))))
defs)
openings))))))
imports)]
@@ -2244,7 +2379,7 @@
(-> Text (, Text Text))
(let [idx (index-of ";" slot)
module (substring2 0 idx slot)
- name (substring1 (inc idx) slot)]
+ name (substring1 (i+ 1 idx) slot)]
[module name]))
(def (type:show type)
@@ -2363,26 +2498,13 @@
type
))
-(defmacro #export (? tokens)
- (case tokens
- (\ (list maybe else))
- (do Lux/Monad
- [g!value (gensym "")]
- (return (list (` (case (~ maybe)
- (#;Some (~ g!value))
- (~ g!value)
-
- _
- (~ else))))))
-
- _
- (fail "Wrong syntax for ?")))
-
(def (apply-type type-fn param)
(-> Type Type (Maybe Type))
(case type-fn
(#AllT [env name arg body])
- (#Some (beta-reduce (|> (? env (list))
+ (#Some (beta-reduce (|> (case env
+ (#Some env) env
+ _ (list))
(put name type-fn)
(put arg param))
body))
@@ -2542,27 +2664,12 @@
_
(fail "Wrong syntax for using")))
-(def #export (flip f)
+(def (flip f)
(All [a b c]
(-> (-> a b c) (-> b a c)))
(lambda [y x]
(f x y)))
-(def #export (curry f)
- (All [a b c]
- (-> (-> (, a b) c)
- (-> a b c)))
- (lambda [x y]
- (f [x y])))
-
-(def #export (uncurry f)
- (All [a b c]
- (-> (-> a b c)
- (-> (, a b) c)))
- (lambda [xy]
- (let [[x y] xy]
- (f x y))))
-
(defmacro #export (cond tokens)
(if (i= 0 (i% (length tokens) 2))
(fail "cond requires an even number of arguments.")
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 01:18:11 +0000