aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2015-07-31 20:33:29 -0400
committerEduardo Julian2015-07-31 20:33:29 -0400
commitc9e0b6c3a0c23b34cd6ffac1b93a266ae6243c4a (patch)
treefaf96e94ba0bf7dd762e2af05662fc24c8d90690
parent3b0b7de8d898662ba154aa8cbd578d26fb91e62e (diff)
- Did some refactoring of the standard library.
- Introduced 2 new modules: lux/data/tuple & lux/codata/function - Now doing safe reading of files. - Took the "let", "lambda" & "def" macros to their ultimate form. - Added some macros for doing better JVM interop. - Fixed a bug when compiling comparisons for doubles. - Changed the order in which arguments are compiled for all arithmetic operations, as the order is reversed (from the conventional order) in the JVM bytecode.
-rw-r--r--README.md2
-rw-r--r--source/lux.lux1115
-rw-r--r--source/lux/codata/function.lux26
-rw-r--r--source/lux/codata/lazy.lux (renamed from source/lux/control/lazy.lux)9
-rw-r--r--source/lux/codata/reader.lux (renamed from source/lux/data/reader.lux)0
-rw-r--r--source/lux/codata/state.lux (renamed from source/lux/data/state.lux)0
-rw-r--r--source/lux/codata/stream.lux11
-rw-r--r--source/lux/control/bounded.lux (renamed from source/lux/data/bounded.lux)0
-rw-r--r--source/lux/control/dict.lux21
-rw-r--r--source/lux/control/eq.lux (renamed from source/lux/data/eq.lux)0
-rw-r--r--source/lux/control/number.lux28
-rw-r--r--source/lux/control/ord.lux (renamed from source/lux/data/ord.lux)0
-rw-r--r--source/lux/control/show.lux (renamed from source/lux/data/show.lux)0
-rw-r--r--source/lux/data/bool.lux6
-rw-r--r--source/lux/data/char.lux6
-rw-r--r--source/lux/data/cont.lux41
-rw-r--r--source/lux/data/dict.lux83
-rw-r--r--source/lux/data/id.lux12
-rw-r--r--source/lux/data/list.lux99
-rw-r--r--source/lux/data/maybe.lux20
-rw-r--r--source/lux/data/number/int.lux89
-rw-r--r--source/lux/data/number/real.lux (renamed from source/lux/data/number.lux)78
-rw-r--r--source/lux/data/text.lux9
-rw-r--r--source/lux/data/tuple.lux39
-rw-r--r--source/lux/host/jvm.lux16
-rw-r--r--source/lux/meta/lux.lux42
-rw-r--r--source/lux/meta/syntax.lux10
-rw-r--r--source/program.lux31
-rw-r--r--src/lux/compiler.clj100
-rw-r--r--src/lux/compiler/cache.clj126
-rw-r--r--src/lux/compiler/host.clj10
-rw-r--r--src/lux/compiler/io.clj18
32 files changed, 1219 insertions, 828 deletions
diff --git a/README.md b/README.md
index 094de9d8d..0c0b4e5c8 100644
--- a/README.md
+++ b/README.md
@@ -102,7 +102,7 @@ The mechanism hasn't been added yet to the language (mainly because there's only
### Macros
Unlike in most other lisps, Lux macros are monadic.
-The **(Lux a)** type is the one responsibly for the magic by treading **Compiler** instances through macros.
+The **(Lux a)** type is the one responsible for the magic by treading **Compiler** instances through macros.
Macros must have the **Macro** type and then be declared as macros.
However, just using the **defmacro** macro will take care of it for you.
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.")
diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux
new file mode 100644
index 000000000..3c40df188
--- /dev/null
+++ b/source/lux/codata/function.lux
@@ -0,0 +1,26 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## The use and distribution terms for this software are covered by the
+## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+## which can be found in the file epl-v10.html at the root of this distribution.
+## By using this software in any fashion, you are agreeing to be bound by
+## the terms of this license.
+## You must not remove this notice, or any other, from this software.
+
+(;import lux
+ (lux/control (monoid #as m)))
+
+## [Functions]
+(def #export (flip f)
+ (All [a b c]
+ (-> (-> a b c) (-> b a c)))
+ (lambda [y x] (f x y)))
+
+(def #export (. f g)
+ (All [a b c]
+ (-> (-> b c) (-> a b) (-> a c)))
+ (lambda [x] (f (g x))))
+
+## [Structures]
+(defstruct #export Comp/Monoid (All [a] (m;Monoid (-> a a)))
+ (def m;unit id)
+ (def m;++ .))
diff --git a/source/lux/control/lazy.lux b/source/lux/codata/lazy.lux
index 22dac74fe..94968de20 100644
--- a/source/lux/control/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -7,10 +7,11 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/meta macro)
- (.. (functor #as F #refer #all)
- (monad #as M #refer #all))
- (lux/data list))
+ (lux (meta macro)
+ (control (functor #as F #refer #all)
+ (monad #as M #refer #all))
+ (data list))
+ (.. function))
## Types
(deftype #export (Lazy a)
diff --git a/source/lux/data/reader.lux b/source/lux/codata/reader.lux
index e91687c3a..e91687c3a 100644
--- a/source/lux/data/reader.lux
+++ b/source/lux/codata/reader.lux
diff --git a/source/lux/data/state.lux b/source/lux/codata/state.lux
index bc9858a29..bc9858a29 100644
--- a/source/lux/data/state.lux
+++ b/source/lux/codata/state.lux
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 1d6dd1b50..2c854a61c 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -7,14 +7,15 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (control (lazy #as L #refer #all)
- (functor #as F #refer #all)
+ (lux (control (functor #as F #refer #all)
(monad #as M #refer #all)
(comonad #as CM #refer #all))
(meta lux
macro
syntax)
- (data (list #as l #refer (#only list list& List/Monad)))))
+ (data (list #as l #refer (#only list list& List/Monad))
+ (number (int #open ("i" Int/Number Int/Ord))))
+ (codata (lazy #as L #refer #all))))
## [Types]
(deftype #export (Stream a)
@@ -59,7 +60,7 @@
(All [a] (-> Int (Stream a) a))
(let [[h t] (! s)]
(if (i> idx 0)
- (@ (dec idx) t)
+ (@ (i+ -1 idx) t)
h)))
(do-template [<taker> <dropper> <splitter> <det-type> <det-test> <det-step>]
@@ -89,7 +90,7 @@
[(list) xs])))]
[take-while drop-while split-with (-> a Bool) (det x) det]
- [take drop split Int (i> det 0) (dec det)]
+ [take drop split Int (i> det 0) (i+ -1 det)]
)
(def #export (unfold step init)
diff --git a/source/lux/data/bounded.lux b/source/lux/control/bounded.lux
index 9d2dabde1..9d2dabde1 100644
--- a/source/lux/data/bounded.lux
+++ b/source/lux/control/bounded.lux
diff --git a/source/lux/control/dict.lux b/source/lux/control/dict.lux
new file mode 100644
index 000000000..3089ec927
--- /dev/null
+++ b/source/lux/control/dict.lux
@@ -0,0 +1,21 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## The use and distribution terms for this software are covered by the
+## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+## which can be found in the file epl-v10.html at the root of this distribution.
+## By using this software in any fashion, you are agreeing to be bound by
+## the terms of this license.
+## You must not remove this notice, or any other, from this software.
+
+(;import lux)
+
+## Signatures
+(defsig #export (Dict d)
+ (: (All [k v]
+ (-> k (d k v) (Maybe v)))
+ get)
+ (: (All [k v]
+ (-> k v (d k v) (d k v)))
+ put)
+ (: (All [k v]
+ (-> k (d k v) (d k v)))
+ remove))
diff --git a/source/lux/data/eq.lux b/source/lux/control/eq.lux
index be3400208..be3400208 100644
--- a/source/lux/data/eq.lux
+++ b/source/lux/control/eq.lux
diff --git a/source/lux/control/number.lux b/source/lux/control/number.lux
new file mode 100644
index 000000000..40906a8a8
--- /dev/null
+++ b/source/lux/control/number.lux
@@ -0,0 +1,28 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## The use and distribution terms for this software are covered by the
+## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+## which can be found in the file epl-v10.html at the root of this distribution.
+## By using this software in any fashion, you are agreeing to be bound by
+## the terms of this license.
+## You must not remove this notice, or any other, from this software.
+
+(;import lux
+ (lux/control (monoid #as m)
+ (eq #as E)
+ (ord #as O)
+ (bounded #as B)
+ (show #as S)))
+
+## [Signatures]
+(defsig #export (Number n)
+ (do-template [<name>]
+ [(: (-> n n n) <name>)]
+ [+] [-] [*] [/] [%])
+
+ (do-template [<name>]
+ [(: (-> n n) <name>)]
+ [negate] [signum] [abs])
+
+ (: (-> Int n)
+ from-int)
+ )
diff --git a/source/lux/data/ord.lux b/source/lux/control/ord.lux
index 80f2e4fb5..80f2e4fb5 100644
--- a/source/lux/data/ord.lux
+++ b/source/lux/control/ord.lux
diff --git a/source/lux/data/show.lux b/source/lux/control/show.lux
index f4e1cf762..f4e1cf762 100644
--- a/source/lux/data/show.lux
+++ b/source/lux/control/show.lux
diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux
index d4f223612..5f4427a2c 100644
--- a/source/lux/data/bool.lux
+++ b/source/lux/data/bool.lux
@@ -7,9 +7,9 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m))
- (.. (eq #as E)
- (show #as S)))
+ (lux/control (monoid #as m)
+ (eq #as E)
+ (show #as S)))
## [Structures]
(defstruct #export Bool/Eq (E;Eq Bool)
diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux
index 5a811c006..b97ec644d 100644
--- a/source/lux/data/char.lux
+++ b/source/lux/data/char.lux
@@ -7,9 +7,9 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (.. (eq #as E)
- (show #as S)
- (text #as T #open ("text:" Text/Monoid))))
+ (lux/control (eq #as E)
+ (show #as S))
+ (.. (text #as T #open ("text:" Text/Monoid))))
## [Structures]
(defstruct #export Char/Eq (E;Eq Char)
diff --git a/source/lux/data/cont.lux b/source/lux/data/cont.lux
new file mode 100644
index 000000000..51c6ece87
--- /dev/null
+++ b/source/lux/data/cont.lux
@@ -0,0 +1,41 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## The use and distribution terms for this software are covered by the
+## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+## which can be found in the file epl-v10.html at the root of this distribution.
+## By using this software in any fashion, you are agreeing to be bound by
+## the terms of this license.
+## You must not remove this notice, or any other, from this software.
+
+(;import lux
+ (lux/control (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Cont r a)
+ (-> (-> a r) r))
+
+## [Structures]
+(defstruct #export Cont/Functor (All [r]
+ (Functor (Cont r)))
+ (def (F;map f fa)
+ (lambda [k]
+ (k (fa f)))))
+
+(defstruct #export Cont/Monad (All [r]
+ (Monad (Cont r)))
+ (def M;_functor Cont/Functor)
+
+ (def (M;wrap x)
+ (lambda [k]
+ (k x)))
+
+ (def (M;join mma)
+ (lambda [k]
+ (mma (lambda [ma] (ma k))))))
+
+## [Functions]
+(def #export (call/cc body)
+ (All [r a b]
+ (-> (-> (-> a (Cont r b)) (Cont r a)) (Cont r a)))
+ (lambda [k]
+ (body k)))
diff --git a/source/lux/data/dict.lux b/source/lux/data/dict.lux
deleted file mode 100644
index 63a66d49b..000000000
--- a/source/lux/data/dict.lux
+++ /dev/null
@@ -1,83 +0,0 @@
-## Copyright (c) Eduardo Julian. All rights reserved.
-## The use and distribution terms for this software are covered by the
-## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-## which can be found in the file epl-v10.html at the root of this distribution.
-## By using this software in any fashion, you are agreeing to be bound by
-## the terms of this license.
-## You must not remove this notice, or any other, from this software.
-
-(;import lux
- (lux/data (eq #as E)))
-
-## Signatures
-(defsig #export (Dict d)
- (: (All [k v]
- (-> k (d k v) (Maybe v)))
- get)
- (: (All [k v]
- (-> k v (d k v) (d k v)))
- put)
- (: (All [k v]
- (-> k (d k v) (d k v)))
- remove))
-
-## Types
-(deftype #export (PList k v)
- (| (#PList (, (E;Eq k) (List (, k v))))))
-
-## Constructors
-(def #export (plist eq)
- (All [k v]
- (-> (E;Eq k) (PList k v)))
- (#PList [eq #;Nil]))
-
-## Utils
-(def (pl-get eq k kvs)
- (All [k v]
- (-> (E;Eq k) k (List (, k v)) (Maybe v)))
- (case kvs
- #;Nil
- #;None
-
- (#;Cons [[k' v'] kvs'])
- (if (:: eq (E;= k k'))
- (#;Some v')
- (pl-get eq k kvs'))))
-
-(def (pl-put eq k v kvs)
- (All [k v]
- (-> (E;Eq k) k v (List (, k v)) (List (, k v))))
- (case kvs
- #;Nil
- (#;Cons [[k v] kvs])
-
- (#;Cons [[k' v'] kvs'])
- (if (:: eq (E;= k k'))
- (#;Cons [[k v] kvs'])
- (#;Cons [[k' v'] (pl-put eq k v kvs')]))))
-
-(def (pl-remove eq k kvs)
- (All [k v]
- (-> (E;Eq k) k (List (, k v)) (List (, k v))))
- (case kvs
- #;Nil
- kvs
-
- (#;Cons [[k' v'] kvs'])
- (if (:: eq (E;= k k'))
- kvs'
- (#;Cons [[k' v'] (pl-remove eq k kvs')]))))
-
-## Structs
-(defstruct #export PList/Dict (Dict PList)
- (def (get k plist)
- (let [(#PList [eq kvs]) plist]
- (pl-get eq k kvs)))
-
- (def (put k v plist)
- (let [(#PList [eq kvs]) plist]
- (#PList [eq (pl-put eq k v kvs)])))
-
- (def (remove k plist)
- (let [(#PList [eq kvs]) plist]
- (#PList [eq (pl-remove eq k kvs)]))))
diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux
index 0e3bdbee6..3ad6b056b 100644
--- a/source/lux/data/id.lux
+++ b/source/lux/data/id.lux
@@ -8,7 +8,8 @@
(;import lux
(lux/control (functor #as F #refer #all)
- (monad #as M #refer #all)))
+ (monad #as M #refer #all)
+ (comonad #as CM #refer #all)))
## [Types]
(deftype #export (Id a)
@@ -23,6 +24,9 @@
(defstruct #export Id/Monad (Monad Id)
(def M;_functor Id/Functor)
(def (M;wrap a) (#Id a))
- (def (M;join mma)
- (let [(#Id ma) mma]
- ma)))
+ (def (M;join mma) (let [(#Id ma) mma] ma)))
+
+(defstruct #export Id/CoMonad (CoMonad Id)
+ (def CM;_functor Id/Functor)
+ (def (CM;unwrap wa) (let [(#Id a) wa] a))
+ (def (CM;split wa) (#Id wa)))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 8fd5c2951..8d6296b14 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -7,17 +7,66 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m #refer #all)
- (functor #as F #refer #all)
- (monad #as M #refer #all))
- lux/meta/macro)
+ (lux (control (monoid #as m #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all)
+ (eq #as E)
+ (dict #as D #refer #all))
+ (data/number (int #open ("i" Int/Number Int/Ord Int/Eq)))
+ meta/macro))
## Types
## (deftype (List a)
## (| #Nil
## (#Cons (, a (List a)))))
-## Functions
+(deftype #export (PList k v)
+ (| (#PList (, (E;Eq k) (List (, k v))))))
+
+## [Utils]
+(def (pl-get eq k kvs)
+ (All [k v]
+ (-> (E;Eq k) k (List (, k v)) (Maybe v)))
+ (case kvs
+ #;Nil
+ #;None
+
+ (#;Cons [[k' v'] kvs'])
+ (if (:: eq (E;= k k'))
+ (#;Some v')
+ (pl-get eq k kvs'))))
+
+(def (pl-put eq k v kvs)
+ (All [k v]
+ (-> (E;Eq k) k v (List (, k v)) (List (, k v))))
+ (case kvs
+ #;Nil
+ (#;Cons [[k v] kvs])
+
+ (#;Cons [[k' v'] kvs'])
+ (if (:: eq (E;= k k'))
+ (#;Cons [[k v] kvs'])
+ (#;Cons [[k' v'] (pl-put eq k v kvs')]))))
+
+(def (pl-remove eq k kvs)
+ (All [k v]
+ (-> (E;Eq k) k (List (, k v)) (List (, k v))))
+ (case kvs
+ #;Nil
+ kvs
+
+ (#;Cons [[k' v'] kvs'])
+ (if (:: eq (E;= k k'))
+ kvs'
+ (#;Cons [[k' v'] (pl-remove eq k kvs')]))))
+
+## [Constructors]
+(def #export (plist eq)
+ (All [k v]
+ (-> (E;Eq k) (PList k v)))
+ (#PList [eq #;Nil]))
+
+## [Functions]
(def #export (foldL f init xs)
(All [a b]
(-> (-> a b a) a (List b) a))
@@ -38,6 +87,12 @@
(#;Cons [x xs'])
(f x (foldR f init xs'))))
+(def #export (fold mon xs)
+ (All [a]
+ (-> (m;Monoid a) (List a) a))
+ (using mon
+ (foldL ++ unit xs)))
+
(def #export (reverse xs)
(All [a]
(-> (List a) (List a)))
@@ -83,8 +138,8 @@
<then>)
<else>))]
- [take (#;Cons [x (take (dec n) xs')]) #;Nil]
- [drop (drop (dec n) xs') xs]
+ [take (#;Cons [x (take (i+ -1 n) xs')]) #;Nil]
+ [drop (drop (i+ -1 n) xs') xs]
)
(do-template [<name> <then> <else>]
@@ -113,7 +168,7 @@
[#;Nil #;Nil]
(#;Cons [x xs'])
- (let [[tail rest] (split (dec n) xs')]
+ (let [[tail rest] (split (i+ -1 n) xs')]
[(#;Cons [x tail]) rest]))
[#;Nil xs]))
@@ -139,7 +194,7 @@
(All [a]
(-> Int a (List a)))
(if (i> n 0)
- (#;Cons [x (repeat (dec n) x)])
+ (#;Cons [x (repeat (i+ -1 n) x)])
#;Nil))
(def #export (iterate f x)
@@ -203,7 +258,7 @@
(#;Cons [x xs'])
(if (i= 0 i)
(#;Some x)
- (@ (dec i) xs'))))
+ (@ (i+ -1 i) xs'))))
## Syntax
(defmacro #export (list xs state)
@@ -225,6 +280,17 @@
(#;Left "Wrong syntax for list&")))
## Structures
+## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a))))
+## (def (E;= xs ys)
+## (case [xs ys]
+## [#;Nil #;Nil]
+## true
+
+## [(#;Cons [x xs']) (#;Cons [y ys'])]
+## (and (:: eq (E;= x y))
+## (E;= xs' ys'))
+## )))
+
(defstruct #export List/Monoid (All [a]
(Monoid (List a)))
(def m;unit #;Nil)
@@ -248,3 +314,16 @@
(def (M;join mma)
(using List/Monoid
(foldL ++ unit mma))))
+
+(defstruct #export PList/Dict (Dict PList)
+ (def (D;get k plist)
+ (let [(#PList [eq kvs]) plist]
+ (pl-get eq k kvs)))
+
+ (def (D;put k v plist)
+ (let [(#PList [eq kvs]) plist]
+ (#PList [eq (pl-put eq k v kvs)])))
+
+ (def (D;remove k plist)
+ (let [(#PList [eq kvs]) plist]
+ (#PList [eq (pl-remove eq k kvs)]))))
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
index faec53c2e..396ec470a 100644
--- a/source/lux/data/maybe.lux
+++ b/source/lux/data/maybe.lux
@@ -7,9 +7,12 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m #refer #all)
- (functor #as F #refer #all)
- (monad #as M #refer #all)))
+ (.. list)
+ (lux (control (monoid #as m #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all))
+ (meta lux
+ syntax)))
## [Types]
## (deftype (Maybe a)
@@ -40,3 +43,14 @@
(case mma
#;None #;None
(#;Some xs) xs)))
+
+## [Syntax]
+(defsyntax #export (? maybe else)
+ (do Lux/Monad
+ [g!value (gensym "")]
+ (M;wrap (list (` (case (~ maybe)
+ (#;Some (~ g!value))
+ (~ g!value)
+
+ _
+ (~ else)))))))
diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux
new file mode 100644
index 000000000..35c8d34bf
--- /dev/null
+++ b/source/lux/data/number/int.lux
@@ -0,0 +1,89 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## The use and distribution terms for this software are covered by the
+## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+## which can be found in the file epl-v10.html at the root of this distribution.
+## By using this software in any fashion, you are agreeing to be bound by
+## the terms of this license.
+## You must not remove this notice, or any other, from this software.
+
+(;import lux
+ (lux/control (number #as N)
+ (monoid #as m)
+ (eq #as E)
+ (ord #as O)
+ (bounded #as B)
+ (show #as S)))
+
+## [Structures]
+## Number
+(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
+ [(defstruct #export <name> (N;Number <type>)
+ (def (N;+ x y) (<+> x y))
+ (def (N;- x y) (<-> x y))
+ (def (N;* x y) (<*> x y))
+ (def (N;/ x y) (</> x y))
+ (def (N;% x y) (<%> x y))
+ (def (N;from-int x)
+ (<from> x))
+ (def (N;negate x)
+ (<*> <-1> x))
+ (def (N;abs x)
+ (if (<<> x <0>)
+ (<*> <-1> x)
+ x))
+ (def (N;signum x)
+ (cond (<=> x <0>) <0>
+ (<<> x <0>) <-1>
+ ## else
+ <1>))
+ )]
+
+ [ Int/Number Int _jvm_ladd _jvm_lsub _jvm_lmul _jvm_ldiv _jvm_lrem _jvm_leq _jvm_llt id 0 1 -1])
+
+## Eq
+(defstruct #export Int/Eq (E;Eq Int)
+ (def (E;= x y) (_jvm_leq x y)))
+
+## Ord
+(do-template [<name> <type> <eq> <=> <lt> <gt>]
+ [(defstruct #export <name> (O;Ord <type>)
+ (def O;_eq <eq>)
+ (def (O;< x y) (<lt> x y))
+ (def (O;<= x y)
+ (or (<lt> x y)
+ (<=> x y)))
+ (def (O;> x y) (<gt> x y))
+ (def (O;>= x y)
+ (or (<gt> x y)
+ (<=> x y))))]
+
+ [ Int/Ord Int Int/Eq _jvm_leq _jvm_llt _jvm_lgt])
+
+## Bounded
+(do-template [<name> <type> <top> <bottom>]
+ [(defstruct #export <name> (B;Bounded <type>)
+ (def B;top <top>)
+ (def B;bottom <bottom>))]
+
+ [ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")])
+
+## Monoid
+(do-template [<name> <type> <unit> <++>]
+ [(defstruct #export <name> (m;Monoid <type>)
+ (def m;unit <unit>)
+ (def (m;++ x y) (<++> x y)))]
+
+ [ IntAdd/Monoid Int 0 _jvm_ladd]
+ [ IntMul/Monoid Int 1 _jvm_lmul]
+ [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)]
+ [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)]
+ )
+
+## Show
+(do-template [<name> <type> <body>]
+ [(defstruct #export <name> (S;Show <type>)
+ (def (S;show x)
+ <body>))]
+
+ [ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])]
+ )
diff --git a/source/lux/data/number.lux b/source/lux/data/number/real.lux
index 8771ef06e..4f9e4fa5f 100644
--- a/source/lux/data/number.lux
+++ b/source/lux/data/number/real.lux
@@ -7,75 +7,57 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m))
- (.. (eq #as E)
- (ord #as O)
- (bounded #as B)
- (show #as S)))
-
-## Signatures
-(defsig #export (Number n)
- (do-template [<name>]
- [(: (-> n n n) <name>)]
- [+] [-] [*] [/] [%])
-
- (: (-> Int n)
- from-int)
-
- (do-template [<name>]
- [(: (-> n n) <name>)]
- [negate] [signum] [abs])
- )
+ (lux/control (number #as N)
+ (monoid #as m)
+ (eq #as E)
+ (ord #as O)
+ (bounded #as B)
+ (show #as S)))
## [Structures]
## Number
(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
- [(defstruct #export <name> (Number <type>)
- (def + <+>)
- (def - <->)
- (def * <*>)
- (def / </>)
- (def % <%>)
- (def (from-int x)
+ [(defstruct #export <name> (N;Number <type>)
+ (def (N;+ x y) (<+> x y))
+ (def (N;- x y) (<-> x y))
+ (def (N;* x y) (<*> x y))
+ (def (N;/ x y) (</> x y))
+ (def (N;% x y) (<%> x y))
+ (def (N;from-int x)
(<from> x))
- (def (negate x)
+ (def (N;negate x)
(<*> <-1> x))
- (def (abs x)
+ (def (N;abs x)
(if (<<> x <0>)
(<*> <-1> x)
x))
- (def (signum x)
+ (def (N;signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
<1>))
)]
- [ Int/Number Int i+ i- i* i/ i% i= i< id 0 1 -1]
- [Real/Number Real r+ r- r* r/ r% r= r< _jvm_l2d 0.0 1.0 -1.0])
+ [Real/Number Real _jvm_dadd _jvm_dsub _jvm_dmul _jvm_ddiv _jvm_drem _jvm_deq _jvm_dlt _jvm_l2d 0.0 1.0 -1.0])
## Eq
-(defstruct #export Int/Eq (E;Eq Int)
- (def E;= i=))
-
(defstruct #export Real/Eq (E;Eq Real)
- (def E;= r=))
+ (def (E;= x y) (_jvm_deq x y)))
## Ord
-(do-template [<name> <type> <eq> <lt> <gt>]
+(do-template [<name> <type> <eq> <=> <lt> <gt>]
[(defstruct #export <name> (O;Ord <type>)
(def O;_eq <eq>)
- (def O;< <lt>)
+ (def (O;< x y) (<lt> x y))
(def (O;<= x y)
(or (<lt> x y)
- (:: <eq> (E;= x y))))
- (def O;> <gt>)
+ (<=> x y)))
+ (def (O;> x y) (<gt> x y))
(def (O;>= x y)
(or (<gt> x y)
- (:: <eq> (E;= x y)))))]
+ (<=> x y))))]
- [ Int/Ord Int Int/Eq i< i>]
- [Real/Ord Real Real/Eq r< r>])
+ [Real/Ord Real Real/Eq _jvm_deq _jvm_dlt _jvm_dgt])
## Bounded
(do-template [<name> <type> <top> <bottom>]
@@ -83,21 +65,16 @@
(def B;top <top>)
(def B;bottom <bottom>))]
- [ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")]
[Real/Bounded Real (_jvm_getstatic "java.lang.Double" "MAX_VALUE") (_jvm_getstatic "java.lang.Double" "MIN_VALUE")])
## Monoid
(do-template [<name> <type> <unit> <++>]
[(defstruct #export <name> (m;Monoid <type>)
(def m;unit <unit>)
- (def m;++ <++>))]
+ (def (m;++ x y) (<++> x y)))]
- [ IntAdd/Monoid Int 0 i+]
- [ IntMul/Monoid Int 1 i*]
- [RealAdd/Monoid Real 0.0 r+]
- [RealMul/Monoid Real 1.0 r*]
- [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)]
- [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)]
+ [RealAdd/Monoid Real 0.0 _jvm_dadd]
+ [RealMul/Monoid Real 1.0 _jvm_dmul]
[RealMax/Monoid Real (:: Real/Bounded B;bottom) (O;max Real/Ord)]
[RealMin/Monoid Real (:: Real/Bounded B;top) (O;min Real/Ord)]
)
@@ -108,6 +85,5 @@
(def (S;show x)
<body>))]
- [ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])]
[Real/Show Real (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])]
)
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index 6ad9cfd63..c3cb1ecfb 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -7,10 +7,11 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/control (monoid #as m))
- (lux/data (eq #as E)
- (ord #as O)
- (show #as S)))
+ (lux (control (monoid #as m)
+ (eq #as E)
+ (ord #as O)
+ (show #as S))
+ (data/number (int #open ("i" Int/Number Int/Ord Int/Eq)))))
## [Functions]
(def #export (size x)
diff --git a/source/lux/data/tuple.lux b/source/lux/data/tuple.lux
new file mode 100644
index 000000000..5220ad4ac
--- /dev/null
+++ b/source/lux/data/tuple.lux
@@ -0,0 +1,39 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## The use and distribution terms for this software are covered by the
+## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+## which can be found in the file epl-v10.html at the root of this distribution.
+## By using this software in any fashion, you are agreeing to be bound by
+## the terms of this license.
+## You must not remove this notice, or any other, from this software.
+
+(;import lux)
+
+## [Functions]
+(do-template [<name> <type> <output>]
+ [(def #export (<name> xy)
+ (All [a b] (-> (, a b) <type>))
+ (let [[x y] xy]
+ <output>))]
+
+ [first a x]
+ [second b 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))))
+
+(def #export (swap xy)
+ (All [a b] (-> (, a b) (, b a)))
+ (let [[x y] xy]
+ [y x]))
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 7af043969..2c90b1ba3 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -11,7 +11,8 @@
(functor #as F)
(monad #as M #refer (#only do)))
(data (list #as l #refer #all #open ("" List/Functor))
- (text #as text))
+ (text #as text)
+ (number (int #open ("i" Int/Eq))))
(meta lux
macro
syntax)))
@@ -236,3 +237,16 @@
(emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name))
[(~@ (map text$ m-classes))]
[(~@ m-args)]))))))
+
+(defsyntax #export (->maybe expr)
+ (do Lux/Monad
+ [g!val (gensym "")]
+ (emit (list (` (;let [(~ g!val) (~ expr)]
+ (;if (null? (~ g!val))
+ #;None
+ (#;Some (~ g!val)))))))))
+
+(defsyntax #export (try$ expr)
+ (emit (list (` (try (#;Right (~ expr))
+ (~ (' (catch java.lang.Exception e
+ (#;Left (.! (getMessage [] []) e))))))))))
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 19b7dd9df..13dcae284 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -10,12 +10,11 @@
(.. macro)
(lux/control (monoid #as m)
(functor #as F)
- (monad #as M #refer (#only do)))
+ (monad #as M #refer (#only do))
+ (show #as S))
(lux/data list
- maybe
- (show #as S)
- (number #as N)
- (text #as T #open ("text:" Text/Monoid Text/Eq))))
+ (text #as T #open ("text:" Text/Monoid Text/Eq))
+ (number/int #as I #open ("i" Int/Number))))
## [Types]
## (deftype (Lux a)
@@ -77,20 +76,27 @@
(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 (|> (: (Module Compiler) $module) (get@ #;defs) (get name))]
- (case (: (, Bool (DefData' Macro)) gdef)
- [exported? (#;MacroD macro')]
- (if (or exported? (text:= module current-module))
- (#;Some macro')
+ (case (get module modules)
+ (#;Some $module)
+ (case (|> (: (Module Compiler) $module) (get@ #;defs) (get name))
+ (#;Some gdef)
+ (case (: (, Bool (DefData' Macro)) gdef)
+ [exported? (#;MacroD macro')]
+ (if (or exported? (text:= module current-module))
+ (#;Some macro')
+ #;None)
+
+ [_ (#;AliasD [r-module r-name])]
+ (find-macro' modules current-module r-module r-name)
+
+ _
#;None)
-
- [_ (#;AliasD [r-module r-name])]
- (find-macro' modules current-module r-module r-name)
_
- #;None)))
+ #;None)
+
+ _
+ #;None))
(def #export (find-macro ident)
(-> Ident (Lux (Maybe Macro)))
@@ -147,8 +153,8 @@
(def #export (gensym prefix state)
(-> Text (Lux Syntax))
- (#;Right [(update@ #;seed inc state)
- (symbol$ ["__gensym__" (:: N;Int/Show (S;show (get@ #;seed state)))])]))
+ (#;Right [(update@ #;seed (i+ 1) state)
+ (symbol$ ["__gensym__" (:: I;Int/Show (S;show (get@ #;seed state)))])]))
(def #export (emit datum)
(All [a]
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index 63ab81475..972999fcb 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -10,12 +10,14 @@
(.. (macro #as m #refer #all)
(lux #as l #refer (#only Lux/Monad gensym)))
(lux (control (functor #as F)
- (monad #as M #refer (#only do)))
- (data (eq #as E)
- (bool #as b)
+ (monad #as M #refer (#only do))
+ (eq #as E))
+ (data (bool #as b)
(char #as c)
(text #as t #open ("text:" Text/Monoid Text/Eq))
- list)))
+ list
+ (number (int #open ("i" Int/Eq))
+ (real #open ("r" Real/Eq))))))
## [Utils]
(def (first xy)
diff --git a/source/program.lux b/source/program.lux
index 086506725..b9f737480 100644
--- a/source/program.lux
+++ b/source/program.lux
@@ -7,31 +7,34 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (codata (stream #as S))
- (control monoid
+ (lux (control monoid
functor
monad
- lazy
- comonad)
+ comonad
+ bounded
+ dict
+ eq
+ ord
+ show
+ number)
(data bool
- bounded
char
- ## cont
- dict
(either #as e)
- eq
error
id
io
list
maybe
- number
- ord
- (reader #as r)
- show
- state
+ (number int
+ real)
(text #as t #open ("text:" Text/Monoid))
- writer)
+ writer
+ tuple)
+ (codata (stream #as S)
+ lazy
+ function
+ (reader #as r)
+ state)
(host jvm)
(meta lux
macro
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 3449900e0..b88bb9c0a 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -29,7 +29,8 @@
[host :as &&host]
[case :as &&case]
[lambda :as &&lambda]
- [package :as &&package]))
+ [package :as &&package]
+ [io :as &&io]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -372,54 +373,55 @@
(defn ^:private compile-module [name]
;; (prn 'compile-module name (&&cache/cached? name))
- (let [file-name (str &&/input-dir "/" name ".lux")
- file-content (slurp file-name)
- file-hash (hash file-content)]
- (if (&&cache/cached? name)
- (&&cache/load name file-hash compile-module)
- (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)]
- (&/map% compile-statement analysis+))]
- (|do [module-exists? (&a-module/exists? name)]
- (if module-exists?
- (fail "[Compiler Error] Can't redefine a module!")
- (|do [_ (&a-module/enter-module name)
- :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
- (.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
- (str (&host/->module-class name) "/_") nil "java/lang/Object" nil)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil file-hash)
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version)
- .visitEnd))
- ;; _ (prn 'compile-module name =class)
- ]]
- (fn [state]
- (matchv ::M/objects [((&/with-writer =class
- (&/exhaust% compiler-step))
- (&/set$ &/$SOURCE (&reader/from file-name file-content) state))]
- [["lux;Right" [?state _]]]
- (&/run-state (|do [defs &a-module/defs
- imports &a-module/imports
- :let [_ (doto =class
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil
- (->> defs
- (&/|map (fn [_def]
- (|let [[?exported ?name ?ann] _def]
- (str (if ?exported "1" "0") " " ?name " " ?ann))))
- (&/|interpose "\t")
- (&/fold str "")))
- .visitEnd)
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil
- (->> imports (&/|interpose "\t") (&/fold str "")))
- .visitEnd)
- (.visitEnd))
- ;; _ (prn 'CLOSED name =class)
- ]]
- (&&/save-class! "_" (.toByteArray =class)))
- ?state)
-
- [["lux;Left" ?message]]
- (fail* ?message)))))))
- )))
+ (let [file-name (str &&/input-dir "/" name ".lux")]
+ (|do [file-content (&&io/read-file file-name)
+ :let [file-hash (hash file-content)]]
+ (if (&&cache/cached? name)
+ (&&cache/load name file-hash compile-module)
+ (let [compiler-step (|do [analysis+ (&optimizer/optimize eval! compile-module)]
+ (&/map% compile-statement analysis+))]
+ (|do [module-exists? (&a-module/exists? name)]
+ (if module-exists?
+ (fail "[Compiler Error] Can't redefine a module!")
+ (|do [_ (&a-module/enter-module name)
+ :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit Opcodes/V1_6 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
+ (str (&host/->module-class name) "/_") nil "java/lang/Object" nil)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_hash" "I" nil file-hash)
+ .visitEnd)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_compiler" "Ljava/lang/String;" nil &&/version)
+ .visitEnd))
+ ;; _ (prn 'compile-module name =class)
+ ]]
+ (fn [state]
+ (matchv ::M/objects [((&/with-writer =class
+ (&/exhaust% compiler-step))
+ (&/set$ &/$SOURCE (&reader/from file-name file-content) state))]
+ [["lux;Right" [?state _]]]
+ (&/run-state (|do [defs &a-module/defs
+ imports &a-module/imports
+ :let [_ (doto =class
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_defs" "Ljava/lang/String;" nil
+ (->> defs
+ (&/|map (fn [_def]
+ (|let [[?exported ?name ?ann] _def]
+ (str (if ?exported "1" "0") " " ?name " " ?ann))))
+ (&/|interpose "\t")
+ (&/fold str "")))
+ .visitEnd)
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) "_imports" "Ljava/lang/String;" nil
+ (->> imports (&/|interpose "\t") (&/fold str "")))
+ .visitEnd)
+ (.visitEnd))
+ ;; _ (prn 'CLOSED name =class)
+ ]]
+ (&&/save-class! "_" (.toByteArray =class)))
+ ?state)
+
+ [["lux;Left" ?message]]
+ (fail* ?message)))))))
+ ))
+ ))
(defn ^:private init! []
(.mkdirs (java.io.File. &&/output-dir)))
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index c0d978146..45513d0a5 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -17,7 +17,8 @@
[host :as &host])
(lux.analyser [base :as &a]
[module :as &a-module])
- (lux.compiler [base :as &&]))
+ (lux.compiler [base :as &&]
+ [io :as &&io]))
(:import (java.io File
BufferedOutputStream
FileOutputStream)
@@ -74,65 +75,66 @@
(return false))]]
(do ;; (prn 'load module 'sources already-loaded?
;; (&/->seq _modules))
- (if already-loaded?
- (return true)
- (if (cached? module)
- (do ;; (prn 'load/HASH module module-hash)
- (let [module* (&host/->module-class module)
- module-path (str &&/output-dir "/" module*)
- class-name (str module* "._")
- ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class"))))
- (&&/load-class! loader class-name))]
- (if (and (= module-hash (get-field "_hash" module-meta))
- (= &&/version (get-field "_compiler" module-meta)))
- (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t")
- ;; _ (prn 'load/IMPORTS module imports)
- ]
- (|do [loads (&/map% (fn [_import]
- (load _import (-> (str &&/input-dir "/" _import ".lux") slurp hash) compile-module))
- (if (= [""] imports)
- (&/|list)
- (&/->list imports)))]
- (if (->> loads &/->seq (every? true?))
- (do (doseq [^File file (seq (.listFiles (File. module-path)))
- :let [file-name (.getName file)]
- :when (not= "_.class" file-name)]
- (let [real-name (second (re-find #"^(.*)\.class$" file-name))
- bytecode (read-file file)
- ;; _ (prn 'load module real-name)
- ]
- (swap! !classes assoc (str module* "." real-name) bytecode)))
- (let [defs (string/split (get-field "_defs" module-meta) #"\t")]
- ;; (prn 'load module defs)
- (|do [_ (&a-module/enter-module module)
- _ (&/map% (fn [_def]
- (let [[_exported? _name _ann] (string/split _def #" ")
- ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann])
- ]
- (|do [_ (case _ann
- "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type)
- "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)]
- (&a-module/declare-macro module _name))
- "V" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name)))
- ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class)
- def-type (get-field "_meta" def-class)]
- (matchv ::M/objects [def-type]
- [["lux;ValueD" _def-type]]
- (&a-module/define module _name def-type _def-type)))
- ;; else
- (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)]
- (|do [__type (&a-module/def-type __module __name)]
- (do ;; (prn '__type [__module __name] (&type/show-type __type))
- (&a-module/def-alias module _name __module __name __type)))))]
- (if (= "1" _exported?)
- (&a-module/export module _name)
- (return nil)))
- ))
- (if (= [""] defs)
+ (if already-loaded?
+ (return true)
+ (if (cached? module)
+ (do ;; (prn 'load/HASH module module-hash)
+ (let [module* (&host/->module-class module)
+ module-path (str &&/output-dir "/" module*)
+ class-name (str module* "._")
+ ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class"))))
+ (&&/load-class! loader class-name))]
+ (if (and (= module-hash (get-field "_hash" module-meta))
+ (= &&/version (get-field "_compiler" module-meta)))
+ (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t")
+ ;; _ (prn 'load/IMPORTS module imports)
+ ]
+ (|do [loads (&/map% (fn [_import]
+ (|do [content (&&io/read-file (str &&/input-dir "/" _import ".lux"))]
+ (load _import (hash content) compile-module)))
+ (if (= [""] imports)
(&/|list)
- (&/->list defs)))]
- (return true))))
- redo-cache)))
- redo-cache)
- ))
- redo-cache)))))
+ (&/->list imports)))]
+ (if (->> loads &/->seq (every? true?))
+ (do (doseq [^File file (seq (.listFiles (File. module-path)))
+ :let [file-name (.getName file)]
+ :when (not= "_.class" file-name)]
+ (let [real-name (second (re-find #"^(.*)\.class$" file-name))
+ bytecode (read-file file)
+ ;; _ (prn 'load module real-name)
+ ]
+ (swap! !classes assoc (str module* "." real-name) bytecode)))
+ (let [defs (string/split (get-field "_defs" module-meta) #"\t")]
+ ;; (prn 'load module defs)
+ (|do [_ (&a-module/enter-module module)
+ _ (&/map% (fn [_def]
+ (let [[_exported? _name _ann] (string/split _def #" ")
+ ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann])
+ ]
+ (|do [_ (case _ann
+ "T" (&a-module/define module _name (&/V "lux;TypeD" nil) &type/Type)
+ "M" (|do [_ (&a-module/define module _name (&/V "lux;ValueD" &type/Macro) &type/Macro)]
+ (&a-module/declare-macro module _name))
+ "V" (let [def-class (&&/load-class! loader (str module* "." (&/normalize-name _name)))
+ ;; _ (println "Fetching _meta" module _name (str module* "." (&/normalize-name _name)) def-class)
+ def-type (get-field "_meta" def-class)]
+ (matchv ::M/objects [def-type]
+ [["lux;ValueD" _def-type]]
+ (&a-module/define module _name def-type _def-type)))
+ ;; else
+ (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)]
+ (|do [__type (&a-module/def-type __module __name)]
+ (do ;; (prn '__type [__module __name] (&type/show-type __type))
+ (&a-module/def-alias module _name __module __name __type)))))]
+ (if (= "1" _exported?)
+ (&a-module/export module _name)
+ (return nil)))
+ ))
+ (if (= [""] defs)
+ (&/|list)
+ (&/->list defs)))]
+ (return true))))
+ redo-cache)))
+ redo-cache)
+ ))
+ redo-cache)))))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 346b66fd2..542bd9a40 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -88,11 +88,11 @@
(defn <name> [compile *type* ?x ?y]
(|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)]
^MethodVisitor *writer* &/get-writer
- _ (compile ?x)
+ _ (compile ?y)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
- _ (compile ?y)
+ _ (compile ?x)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
@@ -191,9 +191,9 @@
compile-jvm-flt Opcodes/FCMPG 1 "java.lang.Float" "floatValue" "()F"
compile-jvm-fgt Opcodes/FCMPG -1 "java.lang.Float" "floatValue" "()F"
- compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dlt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dgt Opcodes/FCMPG -1 "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()D"
+ compile-jvm-dlt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()D"
+ compile-jvm-dgt Opcodes/FCMPG -1 "java.lang.Double" "doubleValue" "()D"
)
(defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args]
diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj
new file mode 100644
index 000000000..176b4340d
--- /dev/null
+++ b/src/lux/compiler/io.clj
@@ -0,0 +1,18 @@
+;; Copyright (c) Eduardo Julian. All rights reserved.
+;; The use and distribution terms for this software are covered by the
+;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this distribution.
+;; By using this software in any fashion, you are agreeing to be bound by
+;; the terms of this license.
+;; You must not remove this notice, or any other, from this software.
+
+(ns lux.compiler.io
+ (:require (lux [base :as & :refer [|let |do return* return fail fail*]])
+ ))
+
+;; [Resources]
+(defn read-file [path]
+ (let [file (new java.io.File path)]
+ (if (.exists file)
+ (return (slurp file))
+ (fail (str "[I/O] File doesn't exist: " path)))))