aboutsummaryrefslogtreecommitdiff
path: root/input
diff options
context:
space:
mode:
authorEduardo Julian2015-07-19 22:24:48 -0400
committerEduardo Julian2015-07-19 22:24:48 -0400
commit50366bad3ecf961fdfdbb1e4d8436794d97ae763 (patch)
tree3c911205244647bb923b2b1868cc8b1d36a083a4 /input
parenteb424eeb33d8fc9bb7ad2acda0c58fcb037717d3 (diff)
- Some bug fixes.
- More additions to the standard library.
Diffstat (limited to 'input')
-rw-r--r--input/lux.lux293
-rw-r--r--input/lux/codata/stream.lux160
-rw-r--r--input/lux/control/functor.lux22
-rw-r--r--input/lux/control/lazy.lux6
-rw-r--r--input/lux/control/monad.lux80
-rw-r--r--input/lux/control/monoid.lux35
-rw-r--r--input/lux/data/bounded.lux4
-rw-r--r--input/lux/data/dict.lux2
-rw-r--r--input/lux/data/either.lux46
-rw-r--r--input/lux/data/eq.lux13
-rw-r--r--input/lux/data/error.lux34
-rw-r--r--input/lux/data/id.lux28
-rw-r--r--input/lux/data/io.lux6
-rw-r--r--input/lux/data/list.lux48
-rw-r--r--input/lux/data/maybe.lux42
-rw-r--r--input/lux/data/number.lux86
-rw-r--r--input/lux/data/ord.lux25
-rw-r--r--input/lux/data/reader.lux33
-rw-r--r--input/lux/data/show.lux10
-rw-r--r--input/lux/data/state.lux26
-rw-r--r--input/lux/data/text.lux52
-rw-r--r--input/lux/data/writer.lux34
-rw-r--r--input/lux/host/java.lux311
-rw-r--r--input/lux/math.lux60
-rw-r--r--input/lux/meta/lux.lux155
-rw-r--r--input/lux/meta/syntax.lux119
-rw-r--r--input/program.lux30
27 files changed, 1299 insertions, 461 deletions
diff --git a/input/lux.lux b/input/lux.lux
index 2bad33439..0c8b73c34 100644
--- a/input/lux.lux
+++ b/input/lux.lux
@@ -10,15 +10,6 @@
(_jvm_interface "Function" []
(apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
-## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"]
-## [(foo "java.lang.Object" ["public" "static"])]
-## (<init> [] "void"
-## ["public"]
-## (_jvm_invokespecial java.lang.Object <init> [] this []))
-## (apply [(arg "java.lang.Object")] "java.lang.Object"
-## ["public"]
-## "YOLO"))
-
## Basic types
(_lux_def Bool (#DataT "java.lang.Boolean"))
(_lux_export Bool)
@@ -35,6 +26,9 @@
(_lux_def Text (#DataT "java.lang.String"))
(_lux_export Text)
+(_lux_def Unit (#TupleT #Nil))
+(_lux_export Unit)
+
(_lux_def Void (#VariantT #Nil))
(_lux_export Void)
@@ -105,6 +99,7 @@
(#Cons [(#BoundT "v")
#Nil])]))])]
#Nil])]))])]))
+(_lux_export Bindings)
## (deftype (Env k v)
## (& #name Text
@@ -121,6 +116,7 @@
(#Cons [["lux;closure" (#AppT [(#AppT [Bindings (#BoundT "k")])
(#BoundT "v")])]
#Nil])])])]))])]))
+(_lux_export Env)
## (deftype Cursor
## (, Text Int Int))
@@ -855,7 +851,7 @@
(wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
[_ (#Meta [_ (#TupleS elems)])]
- (splice (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
+ (splice replace? (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
[true (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])]
unquoted
@@ -937,7 +933,7 @@
($' (B' m) (B' a))
($' (B' m) (B' b))))]))))
-(def'' Maybe:Monad
+(def'' Maybe/Monad
($' Monad Maybe)
{#lux;return
(lambda return [x]
@@ -949,7 +945,7 @@
#None #None
(#Some a) (f a)))})
-(def'' Lux:Monad
+(def'' Lux/Monad
($' Monad Lux)
{#lux;return
(lambda [x]
@@ -1126,8 +1122,8 @@
(_lux_case tokens
(#Cons [(#Meta [_ (#TupleS bindings)]) (#Cons [(#Meta [_ (#TupleS templates)]) data])])
(_lux_case (_lux_: (, ($' Maybe ($' List Text)) ($' Maybe ($' List ($' List Syntax))))
- [(map% Maybe:Monad get-ident bindings)
- (map% Maybe:Monad tuple->list data)])
+ [(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)))]
@@ -1146,12 +1142,12 @@
(-> <type> <type> Bool)
(<cmp> x y))]
- [int:= _jvm_leq Int]
- [int:> _jvm_lgt Int]
- [int:< _jvm_llt Int]
- [real:= _jvm_deq Real]
- [real:> _jvm_dgt Real]
- [real:< _jvm_dlt Real]
+ [i= _jvm_leq Int]
+ [i> _jvm_lgt Int]
+ [i< _jvm_llt Int]
+ [r= _jvm_deq Real]
+ [r> _jvm_dgt Real]
+ [r< _jvm_dlt Real]
)
(do-template [<name> <cmp> <eq> <type>]
@@ -1161,10 +1157,10 @@
true
(<eq> x y)))]
- [ int:>= int:> int:= Int]
- [ int:<= int:< int:= Int]
- [real:>= real:> real:= Real]
- [real:<= real:< real:= Real]
+ [i>= i> i= Int]
+ [i<= i< i= Int]
+ [r>= r> r= Real]
+ [r<= r< r= Real]
)
(do-template [<name> <cmp> <type>]
@@ -1172,25 +1168,25 @@
(-> <type> <type> <type>)
(<cmp> x y))]
- [int:+ _jvm_ladd Int]
- [int:- _jvm_lsub Int]
- [int:* _jvm_lmul Int]
- [int:/ _jvm_ldiv Int]
- [int:% _jvm_lrem Int]
- [real:+ _jvm_dadd Real]
- [real:- _jvm_dsub Real]
- [real:* _jvm_dmul Real]
- [real:/ _jvm_ddiv Real]
- [real:% _jvm_drem Real]
+ [i+ _jvm_ladd Int]
+ [i- _jvm_lsub Int]
+ [i* _jvm_lmul Int]
+ [i/ _jvm_ldiv Int]
+ [i% _jvm_lrem Int]
+ [r+ _jvm_dadd Real]
+ [r- _jvm_dsub Real]
+ [r* _jvm_dmul Real]
+ [r/ _jvm_ddiv Real]
+ [r% _jvm_drem Real]
)
(def'' (multiple? div n)
(-> Int Int Bool)
- (int:= 0 (int:% n div)))
+ (i= 0 (i% n div)))
(def'' (length list)
(-> List Int)
- (foldL (lambda [acc _] (int:+ 1 acc)) 0 list))
+ (foldL (lambda [acc _] (i+ 1 acc)) 0 list))
(def'' #export (not x)
(-> Bool Bool)
@@ -1244,7 +1240,7 @@
["" tokens]))]
(_lux_case tokens'
(#Cons [(#Meta [_ (#TupleS args)]) (#Cons [body #Nil])])
- (_lux_case (map% Maybe:Monad get-ident args)
+ (_lux_case (map% Maybe/Monad get-ident args)
(#Some idents)
(_lux_case idents
#Nil
@@ -1309,7 +1305,7 @@
(-> ($' List (, Text ($' Module Compiler)))
Text Text Text
($' Maybe Macro))
- (do Maybe:Monad
+ (do Maybe/Monad
[$module (get module modules)
gdef (let [{#module-aliases _ #defs bindings #imports _} (_lux_: ($' Module Compiler) $module)]
(get name bindings))]
@@ -1329,7 +1325,7 @@
(def'' (find-macro ident)
(-> Ident ($' Lux ($' Maybe Macro)))
- (do Lux:Monad
+ (do Lux/Monad
[current-module get-module-name]
(let [[module name] ident]
(lambda [state]
@@ -1348,7 +1344,7 @@
(-> Ident ($' Lux Ident))
(_lux_case ident
["" name]
- (do Lux:Monad
+ (do Lux/Monad
[module-name get-module-name]
(;return (_lux_: Ident [module-name name])))
@@ -1356,18 +1352,18 @@
(return ident)))
(defmacro #export (| tokens)
- (do Lux:Monad
- [pairs (map% Lux:Monad
+ (do Lux/Monad
+ [pairs (map% Lux/Monad
(_lux_: (-> Syntax ($' Lux Syntax))
(lambda [token]
(_lux_case token
(#Meta [_ (#TagS ident)])
- (do Lux:Monad
+ (do Lux/Monad
[ident (normalize ident)]
(;return (`' [(~ (text$ (ident->text ident))) (;,)])))
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#TagS ident)]) (#Cons [value #Nil])]))])
- (do Lux:Monad
+ (do Lux/Monad
[ident (normalize ident)]
(;return (`' [(~ (text$ (ident->text ident))) (~ value)])))
@@ -1379,13 +1375,13 @@
(defmacro #export (& tokens)
(if (not (multiple? 2 (length tokens)))
(fail "& expects an even number of arguments.")
- (do Lux:Monad
- [pairs (map% Lux:Monad
+ (do Lux/Monad
+ [pairs (map% Lux/Monad
(_lux_: (-> (, Syntax Syntax) ($' Lux Syntax))
(lambda [pair]
(_lux_case pair
[(#Meta [_ (#TagS ident)]) value]
- (do Lux:Monad
+ (do Lux/Monad
[ident (normalize ident)]
(;return (`' [(~ (text$ (ident->text ident))) (~ value)])))
@@ -1415,30 +1411,30 @@
(-> Syntax ($' Lux ($' List Syntax)))
(_lux_case syntax
(#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS macro-name)]) args]))])
- (do Lux:Monad
+ (do Lux/Monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
(_lux_case ?macro
(#Some macro)
- (do Lux:Monad
+ (do Lux/Monad
[expansion (macro args)
- expansion' (map% Lux:Monad macro-expand expansion)]
+ expansion' (map% Lux/Monad macro-expand expansion)]
(;return (list:join expansion')))
#None
- (do Lux:Monad
- [parts' (map% Lux:Monad macro-expand (list& (symbol$ macro-name) args))]
+ (do Lux/Monad
+ [parts' (map% Lux/Monad macro-expand (list& (symbol$ macro-name) args))]
(;return (list (form$ (list:join parts')))))))
(#Meta [_ (#FormS (#Cons [harg targs]))])
- (do Lux:Monad
+ (do Lux/Monad
[harg+ (macro-expand harg)
- targs+ (map% Lux:Monad macro-expand targs)]
+ targs+ (map% Lux/Monad macro-expand targs)]
(;return (list (form$ (list:++ harg+ (list:join targs+))))))
(#Meta [_ (#TupleS members)])
- (do Lux:Monad
- [members' (map% Lux:Monad macro-expand members)]
+ (do Lux/Monad
+ [members' (map% Lux/Monad macro-expand members)]
(;return (list (tuple$ (list:join members')))))
_
@@ -1464,7 +1460,7 @@
(defmacro #export (type tokens)
(_lux_case tokens
(#Cons [type #Nil])
- (do Lux:Monad
+ (do Lux/Monad
[type+ (macro-expand type)]
(_lux_case type+
(#Cons [type' #Nil])
@@ -1494,12 +1490,12 @@
(defmacro #export (deftype tokens)
(let [[export? tokens'] (: (, Bool (List Syntax))
- (_lux_case tokens
+ (_lux_case (:! (List Syntax) tokens)
(#Cons [(#Meta [_ (#TagS ["" "export"])]) tokens'])
- [true tokens']
+ [true (:! (List Syntax) tokens')]
_
- [false tokens]))
+ [false (:! (List Syntax) tokens)]))
parts (: (Maybe (, Syntax (List Syntax) Syntax))
(_lux_case tokens'
(#Cons [(#Meta [_ (#SymbolS name)]) (#Cons [type #Nil])])
@@ -1597,20 +1593,20 @@
(defmacro #export (case tokens)
(_lux_case tokens
(#Cons [value branches])
- (do Lux:Monad
- [expansions (map% Lux:Monad
+ (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))))))
+ (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)))))))
@@ -1621,7 +1617,7 @@
(defmacro #export (\ tokens)
(case tokens
(#Cons [body (#Cons [pattern #Nil])])
- (do Lux:Monad
+ (do Lux/Monad
[pattern+ (macro-expand pattern)]
(case pattern+
(#Cons [pattern' #Nil])
@@ -1641,8 +1637,8 @@
(fail "\\or can't have 0 patterns")
_
- (do Lux:Monad
- [patterns' (map% Lux:Monad macro-expand patterns)]
+ (do Lux/Monad
+ [patterns' (map% Lux/Monad macro-expand patterns)]
(;return (list:join (map (lambda [pattern] (list pattern body))
(list:join patterns'))))))
@@ -1650,13 +1646,13 @@
(fail "Wrong syntax for \\or")))
(do-template [<name> <offset>]
- [(def #export <name> (int:+ <offset>))]
+ [(def #export <name> (i+ <offset>))]
[inc 1]
[dec -1])
(defmacro #export (` tokens)
- (do Lux:Monad
+ (do Lux/Monad
[module-name get-module-name]
(case tokens
(\ (list template))
@@ -1678,7 +1674,7 @@
(def (macro-expand-1 token)
(-> Syntax (Lux Syntax))
- (do Lux:Monad
+ (do Lux/Monad
[token+ (macro-expand token)]
(case token+
(\ (list token'))
@@ -1688,14 +1684,14 @@
(fail "Macro expanded to more than 1 element."))))
(defmacro #export (sig tokens)
- (do Lux:Monad
- [tokens' (map% Lux:Monad macro-expand tokens)
- members (map% Lux:Monad
+ (do Lux/Monad
+ [tokens' (map% Lux/Monad macro-expand tokens)
+ members (map% Lux/Monad
(: (-> Syntax (Lux (, Ident Syntax)))
(lambda [token]
(case token
(\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_:"])]) type (#Meta [_ (#SymbolS name)])))]))
- (do Lux:Monad
+ (do Lux/Monad
[name' (normalize name)]
(;return (: (, Ident Syntax) [name' type])))
@@ -1745,14 +1741,14 @@
(fail "Wrong syntax for defsig"))))
(defmacro #export (struct tokens)
- (do Lux:Monad
- [tokens' (map% Lux:Monad macro-expand tokens)
- members (map% Lux:Monad
+ (do Lux/Monad
+ [tokens' (map% Lux/Monad macro-expand tokens)
+ members (map% Lux/Monad
(: (-> Syntax (Lux (, Syntax Syntax)))
(lambda [token]
(case token
(\ (#Meta [_ (#FormS (list (#Meta [_ (#SymbolS ["" "_lux_def"])]) (#Meta [_ (#SymbolS name)]) value))]))
- (do Lux:Monad
+ (do Lux/Monad
[name' (normalize name)]
(;return (: (, Syntax Syntax) [(tag$ name') value])))
@@ -1825,7 +1821,7 @@
(def (extract-defs defs)
(-> (List Syntax) (Lux (List Text)))
- (map% Lux:Monad
+ (map% Lux/Monad
(: (-> Syntax (Lux Text))
(lambda [def]
(case def
@@ -1854,12 +1850,12 @@
(return (: (, Referrals (List Syntax)) [#All tokens']))
(\ (#Meta [_ (#FormS (list& (#Meta [_ (#TagS ["" "only"])]) defs))]))
- (do Lux:Monad
+ (do Lux/Monad
[defs' (extract-defs defs)]
(return (: (, Referrals (List Syntax)) [(#Only defs') tokens'])))
(\ (#Meta [_ (#FormS (list& (#Meta [_ (#TagS ["" "except"])]) defs))]))
- (do Lux:Monad
+ (do Lux/Monad
[defs' (extract-defs defs)]
(return (: (, Referrals (List Syntax)) [(#Except defs') tokens'])))
@@ -1871,7 +1867,7 @@
(def (decorate-imports super-name tokens)
(-> Text (List Syntax) (Lux (List Syntax)))
- (map% Lux:Monad
+ (map% Lux/Monad
(: (-> Syntax (Lux Syntax))
(lambda [token]
(case token
@@ -1887,8 +1883,8 @@
(def (parse-imports imports)
(-> (List Syntax) (Lux (List Import)))
- (do Lux:Monad
- [referrals' (map% Lux:Monad
+ (do Lux/Monad
+ [referrals' (map% Lux/Monad
(: (-> Syntax (Lux (List Import)))
(lambda [token]
(case token
@@ -1896,7 +1892,7 @@
(;return (list [m-name #None #All]))
(\ (#Meta [_ (#FormS (list& (#Meta [_ (#SymbolS ["" m-name])]) extra))]))
- (do Lux:Monad
+ (do Lux/Monad
[alias+extra' (parse-alias extra)
#let [[alias extra'] (: (, (Maybe Text) (List Syntax))
alias+extra')]
@@ -1976,14 +1972,14 @@
(def (split-module-contexts module)
(-> Text (List Text))
(#Cons [module (let [idx (last-index-of "/" module)]
- (if (int:< idx 0)
+ (if (i< idx 0)
#Nil
(split-module-contexts (substring2 0 idx module))))]))
(def (split-module module)
(-> Text (List Text))
(let [idx (index-of "/" module)]
- (if (int:< idx 0)
+ (if (i< idx 0)
(#Cons [module #Nil])
(#Cons [(substring2 0 idx module)
(split-module (substring1 (inc idx) module))]))))
@@ -1996,7 +1992,7 @@
#None
(#Cons [x xs'])
- (if (int:= idx 0)
+ (if (i= idx 0)
(#Some x)
(@ (dec idx) xs')
)))
@@ -2021,7 +2017,7 @@
(def (clean-module module)
(-> Text (Lux Text))
- (do Lux:Monad
+ (do Lux/Monad
[module-name get-module-name]
(case (split-module module)
(\ (list& "." parts))
@@ -2030,7 +2026,7 @@
parts
(let [[ups parts'] (split-with (text:= "..") parts)
num-ups (length ups)]
- (if (int:= num-ups 0)
+ (if (i= num-ups 0)
(return module)
(case (@ num-ups (split-module-contexts module-name))
#None
@@ -2062,23 +2058,23 @@
output))
(defmacro #export (import tokens)
- (do Lux:Monad
+ (do Lux/Monad
[imports (parse-imports tokens)
- imports (map% Lux:Monad
+ imports (map% Lux/Monad
(: (-> Import (Lux Import))
(lambda [import]
(case import
[m-name m-alias m-referrals]
- (do Lux:Monad
+ (do Lux/Monad
[m-name (clean-module m-name)]
(;return (: Import [m-name m-alias m-referrals]))))))
imports)
- unknowns' (map% Lux:Monad
+ unknowns' (map% Lux/Monad
(: (-> Import (Lux (List Text)))
(lambda [import]
(case import
[m-name _ _]
- (do Lux:Monad
+ (do Lux/Monad
[? (module-exists? m-name)]
(;return (if ?
(list)
@@ -2087,24 +2083,24 @@
#let [unknowns (list:join unknowns')]]
(case unknowns
#Nil
- (do Lux:Monad
- [output' (map% Lux:Monad
+ (do Lux/Monad
+ [output' (map% Lux/Monad
(: (-> Import (Lux (List Syntax)))
(lambda [import]
(case import
[m-name m-alias m-referrals]
- (do Lux:Monad
+ (do Lux/Monad
[defs (case m-referrals
#All
(exported-defs m-name)
(#Only +defs)
- (do Lux:Monad
+ (do Lux/Monad
[*defs (exported-defs m-name)]
(;return (filter (is-member? +defs) *defs)))
(#Except -defs)
- (do Lux:Monad
+ (do Lux/Monad
[*defs (exported-defs m-name)]
(;return (filter (. not (is-member? -defs)) *defs)))
@@ -2270,7 +2266,7 @@
(defmacro #export (? tokens)
(case tokens
(\ (list maybe else))
- (do Lux:Monad
+ (do Lux/Monad
[g!value (gensym "")]
(return (list (` (case (~ maybe)
(#;Some (~ g!value))
@@ -2292,7 +2288,7 @@
body))
(#AppT [F A])
- (do Maybe:Monad
+ (do Maybe/Monad
[type-fn* (apply-type F A)]
(apply-type type-fn* param))
@@ -2408,7 +2404,7 @@
## {#source source #modules modules
## #envs envs #types types #host host
## #seed seed #seen-sources seen-sources #eval? eval?} state]
-## (do Maybe:Monad
+## (do Maybe/Monad
## [module (get v-prefix modules)
## #let [{#defs defs #module-aliases _ #imports _} module]
## def (get v-name defs)
@@ -2421,7 +2417,7 @@
(def (find-var-type name)
(-> Ident (Lux Type))
- (do Lux:Monad
+ (do Lux/Monad
[name' (normalize name)]
(lambda [state]
(case (find-in-env name state)
@@ -2444,7 +2440,7 @@
(\ (list struct body))
(case struct
(#Meta [_ (#SymbolS name)])
- (do Lux:Monad
+ (do Lux/Monad
[struct-type (find-var-type name)]
(case (resolve-struct-type struct-type)
(#Some (#RecordT slots))
@@ -2491,7 +2487,7 @@
(f x y))))
(defmacro #export (cond tokens)
- (if (int:= 0 (int:% (length tokens) 2))
+ (if (i= 0 (i% (length tokens) 2))
(fail "cond requires an even number of arguments.")
(case (reverse tokens)
(\ (list& else branches'))
@@ -2510,13 +2506,13 @@
(\ (list (#Meta [_ (#TagS slot')]) record))
(case record
(#Meta [_ (#SymbolS name)])
- (do Lux:Monad
+ (do Lux/Monad
[type (find-var-type name)
g!blank (gensym "")
g!output (gensym "")]
(case (resolve-struct-type type)
(#Some (#RecordT slots))
- (do Lux:Monad
+ (do Lux/Monad
[slot (normalize slot')]
(let [[s-prefix s-name] (: Ident slot)
pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax))
@@ -2534,7 +2530,7 @@
(fail "get@ can only use records.")))
_
- (do Lux:Monad
+ (do Lux/Monad
[_record (gensym "")]
(return (list (` (let [(~ _record) (~ record)]
(get@ (~ (tag$ slot')) (~ _record))))))))
@@ -2545,7 +2541,7 @@
(defmacro #export (open tokens)
(case tokens
(\ (list (#Meta [_ (#SymbolS struct-name)])))
- (do Lux:Monad
+ (do Lux/Monad
[struct-type (find-var-type struct-name)]
(case (resolve-struct-type struct-type)
(#Some (#RecordT slots))
@@ -2579,8 +2575,8 @@
(defmacro #export (:: tokens)
(case tokens
(\ (list& start parts))
- (do Lux:Monad
- [output (foldL% Lux:Monad
+ (do Lux/Monad
+ [output (foldL% Lux/Monad
(: (-> Syntax Syntax (Lux Syntax))
(lambda [so-far part]
(case part
@@ -2604,16 +2600,16 @@
(\ (list (#Meta [_ (#TagS slot')]) value record))
(case record
(#Meta [_ (#SymbolS name)])
- (do Lux:Monad
+ (do Lux/Monad
[type (find-var-type name)]
(case (resolve-struct-type type)
(#Some (#RecordT slots))
- (do Lux:Monad
- [pattern' (map% Lux:Monad
+ (do Lux/Monad
+ [pattern' (map% Lux/Monad
(: (-> (, Text Type) (Lux (, Text Syntax)))
(lambda [slot]
(let [[r-slot-name r-type] slot]
- (do Lux:Monad
+ (do Lux/Monad
[g!slot (gensym "")]
(return [r-slot-name g!slot])))))
slots)
@@ -2639,7 +2635,7 @@
(fail "set@ can only use records.")))
_
- (do Lux:Monad
+ (do Lux/Monad
[_record (gensym "")]
(return (list (` (let [(~ _record) (~ record)]
(set@ (~ (tag$ slot')) (~ value) (~ _record))))))))
@@ -2652,16 +2648,16 @@
(\ (list (#Meta [_ (#TagS slot')]) fun record))
(case record
(#Meta [_ (#SymbolS name)])
- (do Lux:Monad
+ (do Lux/Monad
[type (find-var-type name)]
(case (resolve-struct-type type)
(#Some (#RecordT slots))
- (do Lux:Monad
- [pattern' (map% Lux:Monad
+ (do Lux/Monad
+ [pattern' (map% Lux/Monad
(: (-> (, Text Type) (Lux (, Text Syntax)))
(lambda [slot]
(let [[r-slot-name r-type] slot]
- (do Lux:Monad
+ (do Lux/Monad
[g!slot (gensym "")]
(return [r-slot-name g!slot])))))
slots)
@@ -2687,7 +2683,7 @@
(fail "update@ can only use records.")))
_
- (do Lux:Monad
+ (do Lux/Monad
[_record (gensym "")]
(return (list (` (let [(~ _record) (~ record)]
(update@ (~ (tag$ slot')) (~ fun) (~ _record))))))))
@@ -2695,6 +2691,33 @@
_
(fail "Wrong syntax for update@")))
+(defmacro #export (\template tokens)
+ (case tokens
+ (\ (list (#Meta [_ (#TupleS data)])
+ (#Meta [_ (#TupleS bindings)])
+ (#Meta [_ (#TupleS templates)])))
+ (case (: (Maybe (List Syntax))
+ (do Maybe/Monad
+ [bindings' (map% Maybe/Monad get-ident bindings)
+ data' (map% Maybe/Monad tuple->list data)]
+ (let [apply (: (-> RepEnv (List Syntax))
+ (lambda [env] (map (apply-template env) templates)))]
+ (|> data'
+ (join-map (. apply (make-env bindings')))
+ ;return))))
+ (#Some output)
+ (return output)
+
+ #None
+ (fail "Wrong syntax for \\template"))
+
+ _
+ (fail "Wrong syntax for \\template")))
+
+(def #export complement
+ (All [a] (-> (-> a Bool) (-> a Bool)))
+ (. not))
+
## (defmacro #export (loop tokens)
## (case tokens
## (\ (list bindings body))
@@ -2702,14 +2725,14 @@
## vars (map first pairs)
## inits (map second pairs)]
## (if (every? symbol? inits)
-## (do Lux:Monad
-## [inits' (map% Maybe:Monad get-ident inits)
-## init-types (map% Maybe:Monad find-var-type inits')]
+## (do Lux/Monad
+## [inits' (map% Maybe/Monad get-ident inits)
+## init-types (map% Maybe/Monad find-var-type inits')]
## (return (list (` ((lambda (~ (#SymbolS ["" "recur"])) [(~@ vars)]
## (~ body))
## (~@ inits))))))
-## (do Lux:Monad
-## [aliases (map% Maybe:Monad (lambda [_] (gensym "")) inits)]
+## (do Lux/Monad
+## [aliases (map% Maybe/Monad (lambda [_] (gensym "")) inits)]
## (return (list (` (let [(~@ (interleave aliases inits))]
## (loop [(~@ (interleave vars aliases))]
## (~ body)))))))))
diff --git a/input/lux/codata/stream.lux b/input/lux/codata/stream.lux
index 1bfd19292..1d6dd1b50 100644
--- a/input/lux/codata/stream.lux
+++ b/input/lux/codata/stream.lux
@@ -7,57 +7,127 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux (control (lazy #as L #refer #all))))
+ (lux (control (lazy #as L #refer #all)
+ (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)))))
-## Types
+## [Types]
(deftype #export (Stream a)
(Lazy (, a (Stream a))))
-## Functions
+## [Utils]
+(def (cycle' x xs init full)
+ (All [a]
+ (-> a (List a) a (List a) (Stream a)))
+ (case xs
+ #;Nil (cycle' init full init full)
+ (#;Cons [y xs']) (... [x (cycle' y xs' init full)])))
+
+## [Functions]
(def #export (iterate f x)
(All [a]
(-> (-> a a) a (Stream a)))
(... [x (iterate f (f x))]))
-## (def #export (take n xs)
-## (All [a]
-## (-> Int (Stream a) (List a)))
-## (if (int:> n 0)
-## (let [[x xs'] (! xs)]
-## (list& x (take (dec n) xs')))
-## (list)))
-
-## (def #export (drop n xs)
-## (All [a]
-## (-> Int (Stream a) (Stream a)))
-## (if (int:> n 0)
-## (drop (dec n) (get@ 1 (! xs)))
-## xs))
-
-## Pattern-matching
-## (defmacro #export (\stream tokens)
-## (case tokens
-## (\ (list& body patterns'))
-## (do Lux:Monad
-## [patterns (map% Lux:Monad M;macro-expand-1 patterns')
-## g!s (M;gensym "s")
-## #let [patterns+ (do List:Monad
-## [pattern (reverse patterns)]
-## (list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))]]
-## (wrap (list g!s
-## (` (;let [(~@ patterns+)]
-## (~ body))))))
-
-## _
-## "Wrong syntax for \stream"))
-
-## (defsyntax #export (\stream body [patterns' (+$ id$)])
-## (do Lux:Monad
-## [patterns (map% Lux:Monad M;macro-expand-1 patterns')
-## g!s (M;gensym "s")
-## #let [patterns+ (do List:Monad
-## [pattern (reverse patterns)]
-## (list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s)))))]]
-## (wrap (list g!s
-## (` (;let [(~@ patterns+)]
-## (~ body)))))))
+(def #export (repeat x)
+ (All [a]
+ (-> a (Stream a)))
+ (... [x (repeat x)]))
+
+(def #export (cycle xs)
+ (All [a]
+ (-> (List a) (Maybe (Stream a))))
+ (case xs
+ #;Nil #;None
+ (#;Cons [x xs']) (#;Some (cycle' x xs' x xs'))))
+
+(do-template [<name> <return> <part>]
+ [(def #export (<name> s)
+ (All [a] (-> (Stream a) <return>))
+ (let [[h t] (! s)]
+ <part>))]
+
+ [head a h]
+ [tail (Stream a) t])
+
+(def #export (@ idx s)
+ (All [a] (-> Int (Stream a) a))
+ (let [[h t] (! s)]
+ (if (i> idx 0)
+ (@ (dec idx) t)
+ h)))
+
+(do-template [<taker> <dropper> <splitter> <det-type> <det-test> <det-step>]
+ [(def #export (<taker> det xs)
+ (All [a]
+ (-> <det-type> (Stream a) (List a)))
+ (let [[x xs'] (! xs)]
+ (if <det-test>
+ (list& x (<taker> <det-step> xs'))
+ (list))))
+
+ (def #export (<dropper> det xs)
+ (All [a]
+ (-> <det-type> (Stream a) (Stream a)))
+ (let [[x xs'] (! xs)]
+ (if <det-test>
+ (<dropper> <det-step> xs')
+ xs)))
+
+ (def #export (<splitter> det xs)
+ (All [a]
+ (-> <det-type> (Stream a) (, (List a) (Stream a))))
+ (let [[x xs'] (! xs)]
+ (if <det-test>
+ (let [[tail next] (<splitter> <det-step> xs')]
+ [(#;Cons [x tail]) next])
+ [(list) xs])))]
+
+ [take-while drop-while split-with (-> a Bool) (det x) det]
+ [take drop split Int (i> det 0) (dec det)]
+ )
+
+(def #export (unfold step init)
+ (All [a b]
+ (-> (-> a (, a b)) a (Stream b)))
+ (let [[next x] (step init)]
+ (... [x (unfold step next)])))
+
+(def #export (filter p xs)
+ (All [a] (-> (-> a Bool) (Stream a) (Stream a)))
+ (let [[x xs'] (! xs)]
+ (if (p x)
+ (... [x (filter p xs')])
+ (filter p xs'))))
+
+(def #export (partition p xs)
+ (All [a] (-> (-> a Bool) (Stream a) (, (Stream a) (Stream a))))
+ [(filter p xs) (filter (complement p) xs)])
+
+## [Structures]
+(defstruct #export Stream/Functor (Functor Stream)
+ (def (F;map f fa)
+ (let [[h t] (! fa)]
+ (... [(f h) (F;map f t)]))))
+
+(defstruct #export Stream/CoMonad (CoMonad Stream)
+ (def CM;_functor Stream/Functor)
+ (def CM;unwrap head)
+ (def (CM;split wa)
+ (:: Stream/Functor (F;map repeat wa))))
+
+## [Pattern-matching]
+(defsyntax #export (\stream body [patterns' (+^ id^)])
+ (do Lux/Monad
+ [patterns (map% Lux/Monad macro-expand-1 patterns')
+ g!s (gensym "s")
+ #let [patterns+ (: (List Syntax)
+ (do List/Monad
+ [pattern (l;reverse patterns)]
+ (list (` [(~ pattern) (~ g!s)]) (` (L;! (~ g!s))))))]]
+ (M;wrap (list g!s (` (;let [(~@ patterns+)] (~ body)))))))
diff --git a/input/lux/control/functor.lux b/input/lux/control/functor.lux
index 3362dd21a..6a9dcfff8 100644
--- a/input/lux/control/functor.lux
+++ b/input/lux/control/functor.lux
@@ -6,30 +6,10 @@
## the terms of this license.
## You must not remove this notice, or any other, from this software.
-(;import lux
- (lux/data state))
+(;import lux)
## Signatures
(defsig #export (Functor f)
(: (All [a b]
(-> (-> a b) (f a) (f b)))
map))
-
-## Structures
-(defstruct #export Maybe:Functor (Functor Maybe)
- (def (map f ma)
- (case ma
- #;None #;None
- (#;Some a) (#;Some (f a)))))
-
-(defstruct #export List:Functor (Functor List)
- (def (map f ma)
- (case ma
- #;Nil #;Nil
- (#;Cons [a ma']) (#;Cons [(f a) (map f ma')]))))
-
-(defstruct #export State:Functor (Functor State)
- (def (map f ma)
- (lambda [state]
- (let [[state' a] (ma state)]
- [state' (f a)]))))
diff --git a/input/lux/control/lazy.lux b/input/lux/control/lazy.lux
index 83f094592..fca63179e 100644
--- a/input/lux/control/lazy.lux
+++ b/input/lux/control/lazy.lux
@@ -34,12 +34,12 @@
(thunk id))
## Structs
-(defstruct #export Lazy:Functor (Functor Lazy)
+(defstruct #export Lazy/Functor (Functor Lazy)
(def (F;map f ma)
(... (f (! ma)))))
-(defstruct #export Lazy:Monad (Monad Lazy)
- (def M;_functor Lazy:Functor)
+(defstruct #export Lazy/Monad (Monad Lazy)
+ (def M;_functor Lazy/Functor)
(def (M;wrap a)
(... a))
diff --git a/input/lux/control/monad.lux b/input/lux/control/monad.lux
index 2ca541574..b5552f987 100644
--- a/input/lux/control/monad.lux
+++ b/input/lux/control/monad.lux
@@ -7,13 +7,38 @@
## You must not remove this notice, or any other, from this software.
(;import lux
- (lux/data list
- state)
(.. (functor #as F)
(monoid #as M))
lux/meta/macro)
-## Signatures
+## [Utils]
+(def (foldL f init xs)
+ (All [a b]
+ (-> (-> a b a) a (List b) a))
+ (case xs
+ #;Nil
+ init
+
+ (#;Cons [x xs'])
+ (foldL f (f init x) xs')))
+
+(def (reverse xs)
+ (All [a]
+ (-> (List a) (List a)))
+ (foldL (lambda [tail head] (#;Cons [head tail]))
+ #;Nil
+ xs))
+
+(def (as-pairs xs)
+ (All [a] (-> (List a) (List (, a a))))
+ (case xs
+ (#;Cons [x1 (#;Cons [x2 xs'])])
+ (#;Cons [[x1 x2] (as-pairs xs')])
+
+ _
+ #;Nil))
+
+## [Signatures]
(defsig #export (Monad m)
(: (F;Functor m)
_functor)
@@ -24,10 +49,11 @@
(-> (m (m a)) (m a)))
join))
-## Syntax
+## [Syntax]
(defmacro #export (do tokens state)
(case tokens
- (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
+ ## (\ (list monad (#;Meta [_ (#;TupleS bindings)]) body))
+ (#;Cons [monad (#;Cons [(#;Meta [_ (#;TupleS bindings)]) (#;Cons [body #;Nil])])])
(let [body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
(lambda [body' binding]
(let [[var value] binding]
@@ -43,49 +69,15 @@
))))
body
(reverse (as-pairs bindings)))]
- (#;Right [state (list (` (;case (~ monad)
- {#;;_functor ;;_functor #;;wrap ;;wrap #;;join ;;join}
- (~ body'))))]))
+ (#;Right [state (#;Cons [(` (;case (~ monad)
+ {#;;_functor ;;_functor #;;wrap ;;wrap #;;join ;;join}
+ (~ body')))
+ #;Nil])]))
_
(#;Left "Wrong syntax for do")))
-## Structures
-(defstruct #export Maybe:Monad (Monad Maybe)
- (def _functor F;Maybe:Functor)
-
- (def (wrap x)
- (#;Some x))
-
- (def (join mma)
- (case mma
- #;None #;None
- (#;Some xs) xs)))
-
-(defstruct #export List:Monad (Monad List)
- (def _functor F;List:Functor)
-
- (def (wrap x)
- (#;Cons [x #;Nil]))
-
- (def (join xss)
- (using M;List:Monoid
- (foldL M;++ M;unit xss))))
-
-(defstruct #export State:Monad (All [s]
- (Monad (State s)))
- (def _functor F;State:Functor)
-
- (def (wrap x)
- (lambda [state]
- [state x]))
-
- (def (join mma)
- (lambda [state]
- (let [[state' ma] (mma state)]
- (ma state')))))
-
-## Functions
+## [Functions]
(def #export (bind m f ma)
(All [m a b]
(-> (Monad m) (-> a (m b)) (m a) (m b)))
diff --git a/input/lux/control/monoid.lux b/input/lux/control/monoid.lux
index cfb282c52..d32baabc5 100644
--- a/input/lux/control/monoid.lux
+++ b/input/lux/control/monoid.lux
@@ -6,9 +6,7 @@
## the terms of this license.
## You must not remove this notice, or any other, from this software.
-(;import lux
- (lux/data ord
- (bounded #as B)))
+(;import lux)
## Signatures
(defsig #export (Monoid a)
@@ -24,34 +22,3 @@
(struct
(def unit unit)
(def ++ ++)))
-
-## Structures
-(defstruct #export Maybe:Monoid (Monoid Maybe)
- (def unit #;None)
- (def (++ xs ys)
- (case xs
- #;None ys
- (#;Some x) (#;Some x))))
-
-(defstruct #export List:Monoid (All [a]
- (Monoid (List a)))
- (def unit #;Nil)
- (def (++ xs ys)
- (case xs
- #;Nil ys
- (#;Cons [x xs']) (#;Cons [x (++ xs' ys)]))))
-
-(do-template [<name> <type> <unit> <++>]
- [(defstruct #export <name> (Monoid <type>)
- (def unit <unit>)
- (def ++ <++>))]
-
- [ IntAdd:Monoid Int 0 int:+]
- [ IntMul:Monoid Int 1 int:*]
- [RealAdd:Monoid Real 0.0 real:+]
- [RealMul:Monoid Real 1.0 real:*]
- [ IntMax:Monoid Int (:: B;Int:Bounded B;bottom) (max Int:Ord)]
- [ IntMin:Monoid Int (:: B;Int:Bounded B;top) (min Int:Ord)]
- [RealMax:Monoid Real (:: B;Real:Bounded B;bottom) (max Real:Ord)]
- [RealMin:Monoid Real (:: B;Real:Bounded B;top) (min Real:Ord)]
- )
diff --git a/input/lux/data/bounded.lux b/input/lux/data/bounded.lux
index 14f4d2e86..458fbc0df 100644
--- a/input/lux/data/bounded.lux
+++ b/input/lux/data/bounded.lux
@@ -22,5 +22,5 @@
(def top <top>)
(def 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)])
+ [ 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)])
diff --git a/input/lux/data/dict.lux b/input/lux/data/dict.lux
index 8bd6635fd..63a66d49b 100644
--- a/input/lux/data/dict.lux
+++ b/input/lux/data/dict.lux
@@ -69,7 +69,7 @@
(#;Cons [[k' v'] (pl-remove eq k kvs')]))))
## Structs
-(defstruct #export PList:Dict (Dict PList)
+(defstruct #export PList/Dict (Dict PList)
(def (get k plist)
(let [(#PList [eq kvs]) plist]
(pl-get eq k kvs)))
diff --git a/input/lux/data/either.lux b/input/lux/data/either.lux
new file mode 100644
index 000000000..7166688b5
--- /dev/null
+++ b/input/lux/data/either.lux
@@ -0,0 +1,46 @@
+## 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 (list #refer (#except partition))))
+
+## [Types]
+## (deftype (Either l r)
+## (| (#;Left l)
+## (#;Right r)))
+
+## [Functions]
+(def #export (either f g e)
+ (All [a b c] (-> (-> a c) (-> b c) (Either a b) c))
+ (case e
+ (#;Left x) (f x)
+ (#;Right x) (g x)))
+
+(do-template [<name> <side> <tag>]
+ [(def #export (<name> es)
+ (All [a b] (-> (List (Either a b)) (List <side>)))
+ (case es
+ #;Nil #;Nil
+ (#;Cons [(<tag> x) es']) (#;Cons [x (<name> es')])
+ (#;Cons [_ es']) (<name> es')))]
+
+ [lefts a #;Left]
+ [rights b #;Right]
+ )
+
+(def #export (partition es)
+ (All [a b] (-> (List (Either a b)) (, (List a) (List b))))
+ (foldL (: (All [a b]
+ (-> (, (List a) (List b)) (Either a b) (, (List a) (List b))))
+ (lambda [tails e]
+ (let [[ltail rtail] tails]
+ (case e
+ (#;Left x) [(#;Cons [x ltail]) rtail]
+ (#;Right x) [ltail (#;Cons [x rtail])]))))
+ [(list) (list)]
+ (reverse es)))
diff --git a/input/lux/data/eq.lux b/input/lux/data/eq.lux
index 948f8e2ab..191e6a885 100644
--- a/input/lux/data/eq.lux
+++ b/input/lux/data/eq.lux
@@ -14,7 +14,7 @@
=))
## Structures
-(defstruct #export Bool:Eq (Eq Bool)
+(defstruct #export Bool/Eq (Eq Bool)
(def (= x y)
(case (: (, Bool Bool) [x y])
(\or [true true] [false false])
@@ -22,14 +22,3 @@
_
false)))
-
-(defstruct #export Int:Eq (Eq Int)
- (def = int:=))
-
-(defstruct #export Real:Eq (Eq Real)
- (def = real:=))
-
-(defstruct #export Text:Eq (Eq Text)
- (def (= x y)
- (_jvm_invokevirtual java.lang.Object equals [java.lang.Object]
- x [y])))
diff --git a/input/lux/data/error.lux b/input/lux/data/error.lux
new file mode 100644
index 000000000..cb5c309a6
--- /dev/null
+++ b/input/lux/data/error.lux
@@ -0,0 +1,34 @@
+## 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 (Error a)
+ (| (#Fail Text)
+ (#Ok a)))
+
+## [Structures]
+(defstruct #export Error/Functor (Functor Error)
+ (def (F;map f ma)
+ (case ma
+ (#Fail msg) (#Fail msg)
+ (#Ok datum) (#Ok (f datum)))))
+
+(defstruct #export Error/Monad (Monad Error)
+ (def M;_functor Error/Functor)
+
+ (def (M;wrap a)
+ (#Ok a))
+
+ (def (M;join mma)
+ (case mma
+ (#Fail msg) (#Fail msg)
+ (#Ok ma) ma)))
diff --git a/input/lux/data/id.lux b/input/lux/data/id.lux
new file mode 100644
index 000000000..0e3bdbee6
--- /dev/null
+++ b/input/lux/data/id.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 (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Id a)
+ (| (#Id a)))
+
+## [Structures]
+(defstruct #export Id/Functor (Functor Id)
+ (def (F;map f fa)
+ (let [(#Id a) fa]
+ (#Id (f a)))))
+
+(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)))
diff --git a/input/lux/data/io.lux b/input/lux/data/io.lux
index ab74daefd..c08023df5 100644
--- a/input/lux/data/io.lux
+++ b/input/lux/data/io.lux
@@ -27,12 +27,12 @@
(#;Left "Wrong syntax for io")))
## Structures
-(defstruct #export IO:Functor (F;Functor IO)
+(defstruct #export IO/Functor (F;Functor IO)
(def (F;map f ma)
(io (f (ma [])))))
-(defstruct #export IO:Monad (M;Monad IO)
- (def M;_functor IO:Functor)
+(defstruct #export IO/Monad (M;Monad IO)
+ (def M;_functor IO/Functor)
(def (M;wrap x)
(io x))
diff --git a/input/lux/data/list.lux b/input/lux/data/list.lux
index edbdb6160..450dee275 100644
--- a/input/lux/data/list.lux
+++ b/input/lux/data/list.lux
@@ -6,7 +6,10 @@
## the terms of this license.
## You must not remove this notice, or any other, from this software.
-(;import (lux #refer (#except reverse as-pairs))
+(;import lux
+ (lux/control (monoid #as m #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all))
lux/meta/macro)
## Types
@@ -54,6 +57,10 @@
(#;Cons [x (filter p xs')])
(filter p xs'))))
+(def #export (partition p xs)
+ (All [a] (-> (-> a Bool) (List a) (, (List a) (List a))))
+ [(filter p xs) (filter (complement p) xs)])
+
(def #export (as-pairs xs)
(All [a] (-> (List a) (List (, a a))))
(case xs
@@ -67,7 +74,7 @@
[(def #export (<name> n xs)
(All [a]
(-> Int (List a) (List a)))
- (if (int:> n 0)
+ (if (i> n 0)
(case xs
#;Nil
#;Nil
@@ -97,16 +104,16 @@
[drop-while (drop-while p xs') xs]
)
-(def #export (split-at n xs)
+(def #export (split n xs)
(All [a]
(-> Int (List a) (, (List a) (List a))))
- (if (int:> n 0)
+ (if (i> n 0)
(case xs
#;Nil
[#;Nil #;Nil]
(#;Cons [x xs'])
- (let [[tail rest] (split-at (dec n) xs')]
+ (let [[tail rest] (split (dec n) xs')]
[(#;Cons [x tail]) rest]))
[#;Nil xs]))
@@ -131,7 +138,7 @@
(def #export (repeat n x)
(All [a]
(-> Int a (List a)))
- (if (int:> n 0)
+ (if (i> n 0)
(#;Cons [x (repeat (dec n) x)])
#;Nil))
@@ -175,7 +182,7 @@
(def #export (size list)
(-> List Int)
- (foldL (lambda [acc _] (int:+ 1 acc)) 0 list))
+ (foldL (lambda [acc _] (i+ 1 acc)) 0 list))
(do-template [<name> <init> <op>]
[(def #export (<name> p xs)
@@ -194,7 +201,7 @@
#;None
(#;Cons [x xs'])
- (if (int:= 0 i)
+ (if (i= 0 i)
(#;Some x)
(@ (dec i) xs'))))
@@ -216,3 +223,28 @@
_
(#;Left "Wrong syntax for list&")))
+
+## Structures
+(defstruct #export List/Monoid (All [a]
+ (Monoid (List a)))
+ (def m;unit #;Nil)
+ (def (m;++ xs ys)
+ (case xs
+ #;Nil ys
+ (#;Cons [x xs']) (#;Cons [x (m;++ xs' ys)]))))
+
+(defstruct #export List/Functor (Functor List)
+ (def (F;map f ma)
+ (case ma
+ #;Nil #;Nil
+ (#;Cons [a ma']) (#;Cons [(f a) (F;map f ma')]))))
+
+(defstruct #export List/Monad (Monad List)
+ (def M;_functor List/Functor)
+
+ (def (M;wrap a)
+ (#;Cons [a #;Nil]))
+
+ (def (M;join mma)
+ (using List/Monoid
+ (foldL m;++ m;unit mma))))
diff --git a/input/lux/data/maybe.lux b/input/lux/data/maybe.lux
new file mode 100644
index 000000000..faec53c2e
--- /dev/null
+++ b/input/lux/data/maybe.lux
@@ -0,0 +1,42 @@
+## 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 #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+## (deftype (Maybe a)
+## (| #;None
+## (#;Some a)))
+
+## [Structures]
+(defstruct #export Maybe/Monoid (Monoid Maybe)
+ (def m;unit #;None)
+ (def (m;++ xs ys)
+ (case xs
+ #;None ys
+ (#;Some x) (#;Some x))))
+
+(defstruct #export Maybe/Functor (Functor Maybe)
+ (def (F;map f ma)
+ (case ma
+ #;None #;None
+ (#;Some a) (#;Some (f a)))))
+
+(defstruct #export Maybe/Monad (Monad Maybe)
+ (def M;_functor Maybe/Functor)
+
+ (def (M;wrap x)
+ (#;Some x))
+
+ (def (M;join mma)
+ (case mma
+ #;None #;None
+ (#;Some xs) xs)))
diff --git a/input/lux/data/number.lux b/input/lux/data/number.lux
index 7941daa4e..8203d2ecd 100644
--- a/input/lux/data/number.lux
+++ b/input/lux/data/number.lux
@@ -6,38 +6,52 @@
## the terms of this license.
## You must not remove this notice, or any other, from this software.
-(;import lux)
+(;import lux
+ (lux/control (monoid #as m))
+ (lux/data (eq #as E)
+ (ord #as O)
+ (bounded #as B)))
## Signatures
(defsig #export (Number n)
- (: (-> n n n)
- +)
+ (do-template [<name>]
+ [(: (-> n n n)
+ <name>)]
+ [+] [-] [*] [/] [%])
+ ## (: (-> n n n)
+ ## +)
- (: (-> n n n)
- -)
+ ## (: (-> n n n)
+ ## -)
- (: (-> n n n)
- *)
+ ## (: (-> n n n)
+ ## *)
- (: (-> n n n)
- /)
+ ## (: (-> n n n)
+ ## /)
- (: (-> n n n)
- %)
+ ## (: (-> n n n)
+ ## %)
(: (-> Int n)
from-int)
- (: (-> n n)
- negate)
+ (do-template [<name>]
+ [(: (-> n n)
+ <name>)]
+ [negate] [signum] [abs])
+ ## (: (-> n n)
+ ## negate)
- (: (-> n n)
- sign)
+ ## (: (-> n n)
+ ## signum)
- (: (-> n n)
- abs))
+ ## (: (-> n n)
+ ## abs)
+ )
-## Structures
+## [Structures]
+## Number
(do-template [<name> <type> <+> <-> <*> </> <%> <=> <<> <from> <0> <1> <-1>]
[(defstruct #export <name> (Number <type>)
(def + <+>)
@@ -53,12 +67,42 @@
(if (<<> x <0>)
(<*> <-1> x)
x))
- (def (sign x)
+ (def (signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
<1>))
)]
- [Int:Number Int int:+ int:- int:* int:/ int:% int:= int:< id 0 1 -1]
- [Real:Number Real real:+ real:- real:* real:/ real:% real:= real:< _jvm_l2d 0.0 1.0 -1.0])
+ [ 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])
+
+## Eq
+(defstruct #export Int/Eq (E;Eq Int)
+ (def E;= i=))
+
+(defstruct #export Real/Eq (E;Eq Real)
+ (def E;= r=))
+
+## Ord
+(def #export Int/Ord (O;Ord Int)
+ (O;ord$ Int/Eq i< i>))
+
+(def #export Real/Ord (O;Ord Real)
+ (O;ord$ Real/Eq r< r>))
+
+## Monoid
+(do-template [<name> <type> <unit> <++>]
+ [(defstruct #export <name> (m;Monoid <type>)
+ (def m;unit <unit>)
+ (def m;++ <++>))]
+
+ [ 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 (:: B;Int/Bounded B;bottom) (O;max Int/Ord)]
+ [ IntMin/Monoid Int (:: B;Int/Bounded B;top) (O;min Int/Ord)]
+ [RealMax/Monoid Real (:: B;Real/Bounded B;bottom) (O;max Real/Ord)]
+ [RealMin/Monoid Real (:: B;Real/Bounded B;top) (O;min Real/Ord)]
+ )
diff --git a/input/lux/data/ord.lux b/input/lux/data/ord.lux
index 573106830..60a6cc0a8 100644
--- a/input/lux/data/ord.lux
+++ b/input/lux/data/ord.lux
@@ -27,15 +27,15 @@
(All [a]
(-> (E;Eq a) (-> a a Bool) (-> a a Bool) (Ord a)))
(struct
- (def _eq eq)
- (def < <)
- (def (<= x y)
- (or (< x y)
- (:: eq (E;= x y))))
- (def > >)
- (def (>= x y)
- (or (> x y)
- (:: eq (E;= x y))))))
+ (def _eq eq)
+ (def < <)
+ (def (<= x y)
+ (or (< x y)
+ (:: eq (E;= x y))))
+ (def > >)
+ (def (>= x y)
+ (or (> x y)
+ (:: eq (E;= x y))))))
## Functions
(do-template [<name> <op>]
@@ -47,10 +47,3 @@
[max ;;>]
[min ;;<])
-
-## Structures
-(def #export Int:Ord (Ord Int)
- (ord$ E;Int:Eq int:< int:>))
-
-(def #export Real:Ord (Ord Real)
- (ord$ E;Real:Eq real:< real:>))
diff --git a/input/lux/data/reader.lux b/input/lux/data/reader.lux
new file mode 100644
index 000000000..c3bbc2830
--- /dev/null
+++ b/input/lux/data/reader.lux
@@ -0,0 +1,33 @@
+## 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 #refer (#except Reader))
+ (lux/control (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Reader r a)
+ (-> r a))
+
+## [Structures]
+(defstruct #export Reader/Functor (All [r]
+ (Functor (Reader r)))
+ (def (F;map f fa)
+ (lambda [env]
+ (f (fa env)))))
+
+(defstruct #export Reader/Monad (All [r]
+ (Monad (Reader r)))
+ (def M;_functor Reader/Functor)
+
+ (def (M;wrap x)
+ (lambda [env] x))
+
+ (def (M;join mma)
+ (lambda [env]
+ (mma env env))))
diff --git a/input/lux/data/show.lux b/input/lux/data/show.lux
index 3748d481a..e081b9239 100644
--- a/input/lux/data/show.lux
+++ b/input/lux/data/show.lux
@@ -19,9 +19,9 @@
(def (show x)
<body>))]
- [Bool:Show Bool (_jvm_invokevirtual java.lang.Object toString [] x [])]
- [Int:Show Int (_jvm_invokevirtual java.lang.Object toString [] x [])]
- [Real:Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])]
- [Char:Show Char (let [char (_jvm_invokevirtual java.lang.Object toString [] x [])]
+ [Bool/Show Bool (_jvm_invokevirtual java.lang.Object toString [] x [])]
+ [ Int/Show Int (_jvm_invokevirtual java.lang.Object toString [] x [])]
+ [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])]
+ [Char/Show Char (let [char (_jvm_invokevirtual java.lang.Object toString [] x [])]
($ text:++ "#\"" char "\""))]
- [Text:Show Text x])
+ [Text/Show Text x])
diff --git a/input/lux/data/state.lux b/input/lux/data/state.lux
index 386c7be1d..bc9858a29 100644
--- a/input/lux/data/state.lux
+++ b/input/lux/data/state.lux
@@ -6,8 +6,30 @@
## the terms of this license.
## You must not remove this notice, or any other, from this software.
-(;import lux)
+(;import lux
+ (lux/control (functor #as F #refer #all)
+ (monad #as M #refer #all)))
-## Types
+## [Types]
(deftype #export (State s a)
(-> s (, s a)))
+
+## [Structures]
+(defstruct #export State/Functor (Functor State)
+ (def (F;map f ma)
+ (lambda [state]
+ (let [[state' a] (ma state)]
+ [state' (f a)]))))
+
+(defstruct #export State/Monad (All [s]
+ (Monad (State s)))
+ (def M;_functor State/Functor)
+
+ (def (M;wrap x)
+ (lambda [state]
+ [state x]))
+
+ (def (M;join mma)
+ (lambda [state]
+ (let [[state' ma] (mma state)]
+ (ma state')))))
diff --git a/input/lux/data/text.lux b/input/lux/data/text.lux
index 1a8587f46..5f2203376 100644
--- a/input/lux/data/text.lux
+++ b/input/lux/data/text.lux
@@ -18,8 +18,8 @@
(def #export (@ idx x)
(-> Int Text (Maybe Char))
- (if (and (int:< idx (size x))
- (int:>= idx 0))
+ (if (and (i< idx (size x))
+ (i>= idx 0))
(#;Some (_jvm_invokevirtual java.lang.String charAt [int]
x [(_jvm_l2i idx)]))
#;None))
@@ -46,9 +46,9 @@
(def #export (sub' from to x)
(-> Int Int Text (Maybe Text))
- (if (and (int:< from to)
- (int:>= from 0)
- (int:<= to (size x)))
+ (if (and (i< from to)
+ (i>= from 0)
+ (i<= to (size x)))
(_jvm_invokevirtual java.lang.String substring [int int]
x [(_jvm_l2i from) (_jvm_l2i to)])
#;None))
@@ -59,8 +59,8 @@
(def #export (split at x)
(-> Int Text (Maybe (, Text Text)))
- (if (and (int:< at (size x))
- (int:>= at 0))
+ (if (and (i< at (size x))
+ (i>= at 0))
(let [pre (_jvm_invokevirtual java.lang.String substring [int int]
x [(_jvm_l2i 0) (_jvm_l2i at)])
post (_jvm_invokevirtual java.lang.String substring [int]
@@ -76,8 +76,7 @@
(do-template [<common> <general> <method>]
[(def #export (<general> pattern from x)
(-> Text Int Text (Maybe Int))
- (if (and (int:< from (size x))
- (int:>= from 0))
+ (if (and (i< from (size x)) (i>= from 0))
(case (_jvm_i2l (_jvm_invokevirtual java.lang.String <method> [java.lang.String int]
x [pattern (_jvm_l2i from)]))
-1 #;None
@@ -108,32 +107,33 @@
(-> Text Text Bool)
(case (last-index-of postfix x)
(#;Some n)
- (int:= (int:+ n (size postfix))
- (size x))
+ (i= (i+ n (size postfix))
+ (size x))
_
false))
-(defstruct #export Text:Eq (E;Eq Text)
+## [Structures]
+(defstruct #export Text/Eq (E;Eq Text)
(def (E;= x y)
(_jvm_invokevirtual java.lang.Object equals [java.lang.Object]
x [y])))
-(defstruct #export Text:Ord (O;Ord Text)
- (def O;_eq Text:Eq)
+(defstruct #export Text/Ord (O;Ord Text)
+ (def O;_eq Text/Eq)
(def (O;< x y)
- (int:< (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
- x [y]))
- 0))
+ (i< (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
+ x [y]))
+ 0))
(def (O;<= x y)
- (int:<= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
- x [y]))
- 0))
+ (i<= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
+ x [y]))
+ 0))
(def (O;> x y)
- (int:> (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
- x [y]))
- 0))
+ (i> (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
+ x [y]))
+ 0))
(def (O;>= x y)
- (int:>= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
- x [y]))
- 0)))
+ (i>= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String]
+ x [y]))
+ 0)))
diff --git a/input/lux/data/writer.lux b/input/lux/data/writer.lux
new file mode 100644
index 000000000..f71492e35
--- /dev/null
+++ b/input/lux/data/writer.lux
@@ -0,0 +1,34 @@
+## 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 #refer #all)
+ (functor #as F #refer #all)
+ (monad #as M #refer #all)))
+
+## [Types]
+(deftype #export (Writer l a)
+ (, l a))
+
+## [Structures]
+(defstruct #export Writer/Functor (All [l]
+ (Functor (Writer l)))
+ (def (F;map f fa)
+ (let [[log datum] fa]
+ [log (f datum)])))
+
+(defstruct #export (Writer/Monad mon) (All [l]
+ (-> (Monoid l) (Monad (Writer l))))
+ (def M;_functor Writer/Functor)
+
+ (def (M;wrap x)
+ [(:: mon m;unit) x])
+
+ (def (M;join mma)
+ (let [[log1 [log2 a]] mma]
+ [(:: mon (m;++ log1 log2)) a])))
diff --git a/input/lux/host/java.lux b/input/lux/host/java.lux
new file mode 100644
index 000000000..52391201d
--- /dev/null
+++ b/input/lux/host/java.lux
@@ -0,0 +1,311 @@
+## 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 list
+ (text #as text))
+ (control (functor #as F)
+ (monad #as M #refer (#only do)))
+ (meta lux
+ macro
+ syntax)))
+
+## (open List/Functor)
+
+## [Utils/Parsers]
+(def finally^
+ (Parser Syntax)
+ (form^ (do Parser/Monad
+ [_ (symbol?^ ["" "finally"])
+ expr id^
+ _ end^]
+ (M;wrap expr))))
+
+(def catch^
+ (Parser (, Text Ident Syntax))
+ (form^ (do Parser/Monad
+ [_ (symbol?^ ["" "catch"])
+ ex-class local-symbol^
+ ex symbol^
+ expr id^
+ _ end^]
+ (M;wrap [ex-class ex expr]))))
+
+(def method-decl^
+ (Parser (, (List Text) Text (List Text) Text))
+ (form^ (do Parser/Monad
+ [modifiers (*^ local-tag^)
+ name local-symbol^
+ inputs (tuple^ (*^ local-symbol^))
+ output local-symbol^
+ _ end^]
+ (M;wrap [modifiers name inputs output]))))
+
+(def field-decl^
+ (Parser (, (List Text) Text Text))
+ (form^ (do Parser/Monad
+ [modifiers (*^ local-tag^)
+ name local-symbol^
+ class local-symbol^
+ _ end^]
+ (M;wrap [modifiers name class]))))
+
+(def arg-decl^
+ (Parser (, Text Text))
+ (form^ (do Parser/Monad
+ [arg-name local-symbol^
+ arg-class local-symbol^
+ _ end^]
+ (M;wrap [arg-name arg-class]))))
+
+(def method-def^
+ (Parser (, (List Text) Text (List (, Text Text)) Text Syntax))
+ (form^ (do Parser/Monad
+ [modifiers (*^ local-tag^)
+ name local-symbol^
+ inputs (tuple^ (*^ arg-decl^))
+ output local-symbol^
+ body id^
+ _ end^]
+ (M;wrap [modifiers name inputs output body]))))
+
+(def method-call^
+ (Parser (, Text (List Text) (List Syntax)))
+ (form^ (do Parser/Monad
+ [method local-symbol^
+ arity-classes (tuple^ (*^ local-symbol^))
+ arity-args (tuple^ (*^ id^))
+ _ end^
+ _ (: (Parser (,))
+ (if (i= (size arity-classes)
+ (size arity-args))
+ (M;wrap [])
+ (lambda [_] #;None)))]
+ (M;wrap [method arity-classes arity-args])
+ )))
+
+## [Utils/Lux]
+## (def (find-class-field field class)
+## (-> Text Text (Lux Type))
+## ...)
+
+## (def (find-virtual-method method class)
+## (-> Text Text (Lux (List (, (List Type) Type))))
+## ...)
+
+## (def (find-static-method method class)
+## (-> Text Text (Lux (List (, (List Type) Type))))
+## ...)
+
+
+## [Syntax]
+(defsyntax #export (throw ex)
+ (emit (list (` (_jvm_throw (~ ex))))))
+
+(defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)])
+ (emit (list (` (_jvm_try (~ body)
+ (~@ (list:++ (:: List/Functor (F;map (: (-> (, Text Ident Syntax) Syntax)
+ (lambda [catch]
+ (let [[class ex body] catch]
+ (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body))))))
+ catches))
+ (case finally
+ #;None
+ (list)
+
+ (#;Some finally)
+ (list (` (_jvm_finally (~ finally))))))))))))
+
+(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)])
+ (do Lux/Monad
+ [current-module get-module-name
+ #let [full-name (text;++ (text;replace "/" "." current-module)
+ name)]]
+ (let [members' (:: List/Functor (F;map (: (-> (, (List Text) Text (List Text) Text) Syntax)
+ (lambda [member]
+ (let [[modifiers name inputs output] member]
+ (` ((~ (symbol$ ["" name])) [(~@ (:: List/Functor (F;map text$ inputs)))] (~ (text$ output)) [(~@ (:: List/Functor (F;map text$ modifiers)))])))))
+ members))]
+ (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (:: List/Functor (F;map text$ supers)))]
+ (~@ members'))))))))
+
+(defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))]
+ [fields (*^ field-decl^)]
+ [methods (*^ method-def^)])
+ (do Lux/Monad
+ [current-module get-module-name
+ #let [full-name (text;++ (text;replace "/" "." current-module)
+ name)
+ fields' (:: List/Functor (F;map (: (-> (, (List Text) Text Text) Syntax)
+ (lambda [field]
+ (let [[modifiers name class] field]
+ (` ((~ (symbol$ ["" name]))
+ (~ (text$ class))
+ [(~@ (:: List/Functor (F;map text$ modifiers)))])))))
+ fields))
+ methods' (:: List/Functor (F;map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax)
+ (lambda [methods]
+ (let [[modifiers name inputs output body] methods]
+ (` ((~ (symbol$ ["" name]))
+ [(~@ (:: List/Functor (F;map (: (-> (, Text Text) Syntax)
+ (lambda [in]
+ (let [[left right] in]
+ (form$ (list (text$ left)
+ (text$ right))))))
+ inputs)))]
+ (~ (text$ output))
+ [(~@ (:: List/Functor (F;map text$ modifiers)))]
+ (~ body))))))
+ methods))]]
+ (emit (list (` (_jvm_class (~ (text$ full-name)) (~ (text$ super))
+ [(~@ (:: List/Functor (F;map text$ interfaces)))]
+ [(~@ fields')]
+ [(~@ methods')]))))))
+
+(defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))])
+ (emit (list (` (_jvm_new (~ (text$ class))
+ [(~@ (:: List/Functor (F;map text$ arg-classes)))]
+ [(~@ args)])))))
+
+(defsyntax #export (instance? [class local-symbol^] obj)
+ (emit (list (` (_jvm_instanceof (~ (text$ class)) (~ obj))))))
+
+(defsyntax #export (locking lock body)
+ (do Lux/Monad
+ [g!lock (gensym "")
+ g!body (gensym "")]
+ (emit (list (` (;let [(~ g!lock) (~ lock)
+ _ (_jvm_monitor-enter (~ g!lock))
+ (~ g!body) (~ body)
+ _ (_jvm_monitor-exit (~ g!lock))]
+ (~ g!body)))))
+ ))
+
+(defsyntax #export (null? obj)
+ (emit (list (` (_jvm_null? (~ obj))))))
+
+(defsyntax #export (program [args symbol^] body)
+ (emit (list (` (_jvm_program (~ (symbol$ args))
+ (~ body))))))
+
+## (defsyntax #export (.? [field local-symbol^] obj)
+## (case obj
+## (#;Meta [_ (#;SymbolS obj-name)])
+## (do Lux/Monad
+## [obj-type (find-var-type obj-name)]
+## (case obj-type
+## (#;DataT class)
+## (do Lux/Monad
+## [field-class (find-field field class)]
+## (_jvm_getfield (~ (text$ class)) (~ (text$ field)) (~ (text$ field-class))))
+
+## _
+## (fail "Can only get field from object.")))
+
+## _
+## (do Lux/Monad
+## [g!obj (gensym "")]
+## (emit (list (` (;let [(~ g!obj) (~ obj)]
+## (.? (~ field) (~ g!obj)))))))))
+
+## (defsyntax #export (.= [field local-symbol^] value obj)
+## (case obj
+## (#;Meta [_ (#;SymbolS obj-name)])
+## (do Lux/Monad
+## [obj-type (find-var-type obj-name)]
+## (case obj-type
+## (#;DataT class)
+## (do Lux/Monad
+## [field-class (find-field field class)]
+## (_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ (text$ field-class)) (~ value)))
+
+## _
+## (fail "Can only set field of object.")))
+
+## _
+## (do Lux/Monad
+## [g!obj (gensym "")]
+## (emit (list (` (;let [(~ g!obj) (~ obj)]
+## (.= (~ field) (~ value) (~ g!obj)))))))))
+
+## (defsyntax #export (.! [call method-call^] obj)
+## (case obj
+## (#;Meta [_ (#;SymbolS obj-name)])
+## (do Lux/Monad
+## [obj-type (find-var-type obj-name)]
+## (case obj-type
+## (#;DataT class)
+## (do Lux/Monad
+## [#let [[m-name ?m-classes m-args] call]
+## all-m-details (find-virtual-method m-name class)
+## m-ins (case [?m-classes all-m-details]
+## (\ [#;None (list [m-ins m-out])])
+## (M;wrap m-ins)
+
+## (\ [(#;Some m-ins) _])
+## (M;wrap m-ins)
+
+## _
+## #;None)]
+## (emit (list (` (_jvm_invokevirtual (~ (text$ m-name)) (~ (text$ class)) [(~@ (:: List/Functor (F;map text$ m-ins)))]
+## (~ obj) [(~@ m-args)])))))
+
+## _
+## (fail "Can only call method on object.")))
+
+## _
+## (do Lux/Monad
+## [g!obj (gensym "")]
+## (emit (list (` (;let [(~ g!obj) (~ obj)]
+## (.! (~@ *tokens*)))))))))
+
+## (defsyntax #export (..? [field local-symbol^] [class local-symbol^])
+## (emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field)))))))
+
+## (defsyntax #export (..= [field local-symbol^] value [class local-symbol^])
+## (emit (list (` (_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value))))))
+
+## (defsyntax #export (..! [call method-call^] [class local-symbol^])
+## (do Lux/Monad
+## [#let [[m-name ?m-classes m-args] call]
+## all-m-details (find-static-method m-name class)
+## m-ins (case [?m-classes all-m-details]
+## (\ [#;None (list [m-ins m-out])])
+## (M;wrap m-ins)
+
+## (\ [(#;Some m-ins) _])
+## (M;wrap m-ins)
+
+## _
+## #;None)]
+## (emit (list (` (_jvm_invokestatic (~ (text$ m-name)) (~ (text$ class))
+## [(~@ (:: List/Functor (F;map text$ m-ins)))]
+## [(~@ m-args)]))))
+## ))
+
+## (definterface Function []
+## (#public #abstract apply [java.lang.Object] java.lang.Object))
+
+## (_jvm_interface "Function" []
+## (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
+
+## (defclass MyFunction [Function]
+## (#public #static foo java.lang.Object)
+## (#public <init> [] void
+## (_jvm_invokespecial java.lang.Object <init> [] this []))
+## (#public apply [(arg java.lang.Object)] java.lang.Object
+## "YOLO"))
+
+## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"]
+## [(foo "java.lang.Object" ["public" "static"])]
+## (<init> [] "void"
+## ["public"]
+## (_jvm_invokespecial java.lang.Object <init> [] this []))
+## (apply [(arg "java.lang.Object")] "java.lang.Object"
+## ["public"]
+## "YOLO"))
diff --git a/input/lux/math.lux b/input/lux/math.lux
new file mode 100644
index 000000000..2e29c5da7
--- /dev/null
+++ b/input/lux/math.lux
@@ -0,0 +1,60 @@
+## 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)
+
+## [Constants]
+(do-template [<name> <value>]
+ [(def #export <name>
+ Real
+ (_jvm_getstatic java.lang.Math <value>))]
+
+ [e E]
+ [pi PI]
+ )
+
+## [Functions]
+(do-template [<name> <method>]
+ [(def #export (<name> n)
+ (-> Real Real)
+ (_jvm_invokestatic java.lang.Math <method> [double] [n]))]
+
+ [cos cos]
+ [sin sin]
+ [tan tan]
+
+ [acos acos]
+ [asin asin]
+ [atan atan]
+
+ [cosh cosh]
+ [sinh sinh]
+ [tanh tanh]
+
+ [ceil ceil]
+ [floor floor]
+ [round round]
+
+ [exp exp]
+ [log log]
+
+ [cbrt cbrt]
+ [sqrt sqrt]
+
+ [->degrees toDegrees]
+ [->radians toRadians]
+ )
+
+(do-template [<name> <method>]
+ [(def #export (<name> x y)
+ (-> Real Real Real)
+ (_jvm_invokestatic java.lang.Math <method> [double double] [x y]))]
+
+ [atan2 atan2]
+ [pow pow]
+ )
diff --git a/input/lux/meta/lux.lux b/input/lux/meta/lux.lux
index bd4fab8b6..1fc739403 100644
--- a/input/lux/meta/lux.lux
+++ b/input/lux/meta/lux.lux
@@ -8,18 +8,25 @@
(;import lux
(.. macro)
- (lux/control (monoid #as m #refer (#only List:Monoid))
+ (lux/control (monoid #as m)
(functor #as F)
(monad #as M #refer (#only do)))
(lux/data list
+ maybe
(show #as S)))
-## Types
+## [Types]
## (deftype (Lux a)
## (-> Compiler (Either Text (, Compiler a))))
-## Structures
-(defstruct #export Lux:Functor (F;Functor Lux)
+## [Utils]
+(def (ident->text ident)
+ (-> Ident Text)
+ (let [[pre post] ident]
+ ($ text:++ pre ";" post)))
+
+## [Structures]
+(defstruct #export Lux/Functor (F;Functor Lux)
(def (F;map f fa)
(lambda [state]
(case (fa state)
@@ -29,8 +36,8 @@
(#;Right [state' a])
(#;Right [state' (f a)])))))
-(defstruct #export Lux:Monad (M;Monad Lux)
- (def M;_functor Lux:Functor)
+(defstruct #export Lux/Monad (M;Monad Lux)
+ (def M;_functor Lux/Functor)
(def (M;wrap x)
(lambda [state]
(#;Right [state x])))
@@ -68,7 +75,7 @@
(def (find-macro' modules current-module module name)
(-> (List (, Text (Module Compiler))) Text Text Text
(Maybe Macro))
- (do M;Maybe:Monad
+ (do Maybe/Monad
[$module (get module modules)
gdef (|> (: (Module Compiler) $module) (get@ #;defs) (get name))]
(case (: (, Bool (DefData' Macro)) gdef)
@@ -85,7 +92,7 @@
(def #export (find-macro ident)
(-> Ident (Lux (Maybe Macro)))
- (do Lux:Monad
+ (do Lux/Monad
[current-module get-module-name]
(let [[module name] ident]
(: (Lux (Maybe Macro))
@@ -96,50 +103,56 @@
(-> Ident (Lux Ident))
(case ident
["" name]
- (do Lux:Monad
+ (do Lux/Monad
[module-name get-module-name]
(M;wrap (: Ident [module-name name])))
_
- (:: Lux:Monad (M;wrap ident))))
+ (:: Lux/Monad (M;wrap ident))))
(def #export (macro-expand syntax)
(-> Syntax (Lux (List Syntax)))
(case syntax
(#;Meta [_ (#;FormS (#;Cons [(#;Meta [_ (#;SymbolS macro-name)]) args]))])
- (do Lux:Monad
+ (do Lux/Monad
[macro-name' (normalize macro-name)
?macro (find-macro macro-name')]
(case ?macro
(#;Some macro)
- (do Lux:Monad
+ (do Lux/Monad
[expansion (macro args)
- expansion' (M;map% Lux:Monad macro-expand expansion)]
- (M;wrap (:: M;List:Monad (M;join expansion'))))
+ expansion' (M;map% Lux/Monad macro-expand expansion)]
+ (M;wrap (:: List/Monad (M;join expansion'))))
#;None
- (do Lux:Monad
- [parts' (M;map% Lux:Monad macro-expand (list& (symbol$ macro-name) args))]
- (M;wrap (list (form$ (:: M;List:Monad (M;join parts'))))))))
+ (do Lux/Monad
+ [parts' (M;map% Lux/Monad macro-expand (list& (symbol$ macro-name) args))]
+ (M;wrap (list (form$ (:: List/Monad (M;join parts'))))))))
(#;Meta [_ (#;FormS (#;Cons [harg targs]))])
- (do Lux:Monad
+ (do Lux/Monad
[harg+ (macro-expand harg)
- targs+ (M;map% Lux:Monad macro-expand targs)]
- (M;wrap (list (form$ (list:++ harg+ (:: M;List:Monad (M;join (: (List (List Syntax)) targs+))))))))
+ targs+ (M;map% Lux/Monad macro-expand targs)]
+ (M;wrap (list (form$ (list:++ harg+ (:: List/Monad (M;join (: (List (List Syntax)) targs+))))))))
(#;Meta [_ (#;TupleS members)])
- (do Lux:Monad
- [members' (M;map% Lux:Monad macro-expand members)]
- (M;wrap (list (tuple$ (:: M;List:Monad (M;join members'))))))
+ (do Lux/Monad
+ [members' (M;map% Lux/Monad macro-expand members)]
+ (M;wrap (list (tuple$ (:: List/Monad (M;join members'))))))
_
- (:: Lux:Monad (M;wrap (list syntax)))))
+ (:: Lux/Monad (M;wrap (list syntax)))))
(def #export (gensym prefix state)
(-> Text (Lux Syntax))
(#;Right [(update@ #;seed inc state)
- (symbol$ ["__gensym__" (:: S;Int:Show (S;show (get@ #;seed state)))])]))
+ (symbol$ ["__gensym__" (:: S;Int/Show (S;show (get@ #;seed state)))])]))
+
+(def #export (emit datum)
+ (All [a]
+ (-> a (Lux a)))
+ (lambda [state]
+ (#;Right [state datum])))
(def #export (fail msg)
(All [a]
@@ -149,7 +162,7 @@
(def #export (macro-expand-1 token)
(-> Syntax (Lux Syntax))
- (do Lux:Monad
+ (do Lux/Monad
[token+ (macro-expand token)]
(case token+
(\ (list token'))
@@ -171,7 +184,7 @@
(-> Text (Lux (List Text)))
(case (get module (get@ #;modules state))
(#;Some =module)
- (using M;List:Monad
+ (using List/Monad
(#;Right [state (M;join (:: M;_functor (F;map (: (-> (, Text (, Bool (DefData' Macro)))
(List Text))
(lambda [gdef]
@@ -183,3 +196,91 @@
#;None
(#;Left ($ text:++ "Unknown module: " module))))
+
+(def (show-envs envs)
+ (-> (List (Env Text (, LuxVar Type))) Text)
+ (|> envs
+ (F;map (lambda [env]
+ (case env
+ {#;name name #;inner-closures _ #;locals {#;counter _ #;mappings locals} #;closure _}
+ ($ text:++ name ": " (|> locals
+ (F;map (: (All [a] (-> (, Text a) Text))
+ (lambda [b] (let [[label _] b] label))))
+ (:: List/Functor)
+ (interpose " ")
+ (foldL text:++ ""))))))
+ (:: List/Functor)
+ (interpose "\n")
+ (foldL text:++ "")))
+
+(def (try-both f x1 x2)
+ (All [a b]
+ (-> (-> a (Maybe b)) a a (Maybe b)))
+ (case (f x1)
+ #;None (f x2)
+ (#;Some y) (#;Some y)))
+
+(def (find-in-env name state)
+ (-> Ident Compiler (Maybe Type))
+ (let [vname' (ident->text name)]
+ (case state
+ {#;source source #;modules modules
+ #;envs envs #;types types #;host host
+ #;seed seed #;seen-sources seen-sources #;eval? eval?}
+ (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type))
+ (lambda [env]
+ (case env
+ {#;name _ #;inner-closures _ #;locals {#;counter _ #;mappings locals} #;closure {#;counter _ #;mappings closure}}
+ (try-both (some (: (-> (, Text (, LuxVar Type)) (Maybe Type))
+ (lambda [binding]
+ (let [[bname [_ type]] binding]
+ (if (text:= vname' bname)
+ (#;Some type)
+ #;None)))))
+ locals
+ closure))))
+ envs))))
+
+(def (find-in-defs name state)
+ (-> Ident Compiler (Maybe Type))
+ (let [[v-prefix v-name] name
+ {#;source source #;modules modules
+ #;envs envs #;types types #;host host
+ #;seed seed #;seen-sources seen-sources #;eval? eval?} state]
+ (case (get v-prefix modules)
+ #;None
+ #;None
+
+ (#;Some {#;defs defs #;module-aliases _ #;imports _})
+ (case (get v-name defs)
+ #;None
+ #;None
+
+ (#;Some [_ def-data])
+ (case def-data
+ #;TypeD (#;Some Type)
+ (#;ValueD type) (#;Some type)
+ (#;MacroD m) (#;Some Macro)
+ (#;AliasD name') (find-in-defs name' state))))))
+
+(def #export (find-var-type name)
+ (-> Ident (Lux Type))
+ (do Lux/Monad
+ [name' (normalize name)]
+ (: (Lux Type)
+ (lambda [state]
+ (case (find-in-env name state)
+ (#;Some struct-type)
+ (#;Right [state struct-type])
+
+ _
+ (case (find-in-defs name' state)
+ (#;Some struct-type)
+ (#;Right [state struct-type])
+
+ _
+ (let [{#;source source #;modules modules
+ #;envs envs #;types types #;host host
+ #;seed seed #;seen-sources seen-sources #;eval? eval?} state]
+ (#;Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs))))))))
+ ))
diff --git a/input/lux/meta/syntax.lux b/input/lux/meta/syntax.lux
index cf08ff0eb..3c9a9ce2e 100644
--- a/input/lux/meta/syntax.lux
+++ b/input/lux/meta/syntax.lux
@@ -8,7 +8,7 @@
(;import lux
(.. (macro #as m #refer #all)
- lux)
+ (lux #as l #refer (#only Lux/Monad gensym)))
(lux (control (functor #as F)
(monad #as M #refer (#only do)))
(data list)))
@@ -19,12 +19,18 @@
(let [[x y] xy]
x))
+(def (join-pairs pairs)
+ (All [a] (-> (List (, a a)) (List a)))
+ (case pairs
+ #;Nil #;Nil
+ (#;Cons [[x y] pairs']) (list& x y (join-pairs pairs'))))
+
## Types
(deftype #export (Parser a)
(-> (List Syntax) (Maybe (, (List Syntax) a))))
## Structures
-(defstruct #export Parser:Functor (F;Functor Parser)
+(defstruct #export Parser/Functor (F;Functor Parser)
(def (F;map f ma)
(lambda [tokens]
(case (ma tokens)
@@ -34,8 +40,8 @@
(#;Some [tokens' a])
(#;Some [tokens' (f a)])))))
-(defstruct #export Parser:Monad (M;Monad Parser)
- (def M;_functor Parser:Functor)
+(defstruct #export Parser/Monad (M;Monad Parser)
+ (def M;_functor Parser/Functor)
(def (M;wrap x tokens)
(#;Some [tokens x]))
@@ -75,6 +81,20 @@
[ tag^ Ident #;TagS]
)
+(do-template [<name> <tag>]
+ [(def #export (<name> tokens)
+ (Parser Text)
+ (case tokens
+ (#;Cons [(#;Meta [_ (<tag> ["" x])]) tokens'])
+ (#;Some [tokens' x])
+
+ _
+ #;None))]
+
+ [local-symbol^ #;SymbolS]
+ [ local-tag^ #;TagS]
+ )
+
(def (bool:= x y)
(-> Bool Bool Bool)
(if x
@@ -101,8 +121,8 @@
#;None))]
[ bool?^ Bool #;BoolS bool:=]
- [ int?^ Int #;IntS int:=]
- [ real?^ Real #;RealS real:=]
+ [ int?^ Int #;IntS i=]
+ [ real?^ Real #;RealS r=]
## [ char?^ Char #;CharS char:=]
[ text?^ Text #;TextS text:=]
[symbol?^ Ident #;SymbolS ident:=]
@@ -143,7 +163,7 @@
(-> (Parser a) (Parser (List a))))
(case (p tokens)
#;None (#;Some [tokens (list)])
- (#;Some [tokens' x]) (run-parser (do Parser:Monad
+ (#;Some [tokens' x]) (run-parser (do Parser/Monad
[xs (*^ p)]
(M;wrap (list& x xs)))
tokens')))
@@ -151,7 +171,7 @@
(def #export (+^ p)
(All [a]
(-> (Parser a) (Parser (List a))))
- (do Parser:Monad
+ (do Parser/Monad
[x p
xs (*^ p)]
(M;wrap (list& x xs))))
@@ -159,7 +179,7 @@
(def #export (&^ p1 p2)
(All [a b]
(-> (Parser a) (Parser b) (Parser (, a b))))
- (do Parser:Monad
+ (do Parser/Monad
[x1 p1
x2 p2]
(M;wrap [x1 x2])))
@@ -169,7 +189,7 @@
(-> (Parser a) (Parser b) (Parser (Either b))))
(case (p1 tokens)
(#;Some [tokens' x1]) (#;Some [tokens' (#;Left x1)])
- #;None (run-parser (do Parser:Monad
+ #;None (run-parser (do Parser/Monad
[x2 p2]
(M;wrap (#;Right x2)))
tokens)))
@@ -192,46 +212,53 @@
## Syntax
(defmacro #export (defsyntax tokens)
- (case tokens
- (\ (list (#;Meta [_ (#;FormS (list& (#;Meta [_ (#;SymbolS ["" name])]) args))])
- body))
- (do Lux:Monad
- [names+parsers (M;map% Lux:Monad
- (: (-> Syntax (Lux (, Syntax Syntax)))
- (lambda [arg]
- (case arg
- (\ (#;Meta [_ (#;TupleS (list (#;Meta [_ (#;SymbolS var-name)])
- parser))]))
- (M;wrap [(symbol$ var-name) parser])
-
- _
- (fail "Syntax pattern expects 2-tuples."))))
- args)
- g!tokens (gensym "tokens")
- #let [names (:: F;List:Functor (F;map first names+parsers))
- error-msg (text$ (text:++ "Wrong syntax for " name))
- parsing (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
+ (let [[exported? tokens] (: (, Bool (List Syntax))
+ (case tokens
+ (\ (list& (#;Meta [_ (#;TagS ["" "export"])]) tokens'))
+ [true tokens']
+
+ _
+ [false tokens]))]
+ (case tokens
+ (\ (list (#;Meta [_ (#;FormS (list& (#;Meta [_ (#;SymbolS ["" name])]) args))])
+ body))
+ (do Lux/Monad
+ [names+parsers (M;map% Lux/Monad
+ (: (-> Syntax (Lux (, Syntax Syntax)))
+ (lambda [arg]
+ (case arg
+ (\ (#;Meta [_ (#;TupleS (list (#;Meta [_ (#;SymbolS var-name)])
+ parser))]))
+ (M;wrap [(symbol$ var-name) parser])
+
+ (\ (#;Meta [_ (#;SymbolS var-name)]))
+ (M;wrap [(symbol$ var-name) (` id^)])
+
+ _
+ (l;fail "Syntax pattern expects 2-tuples or symbols."))))
+ args)
+ g!tokens (gensym "tokens")
+ g!_ (gensym "_")
+ #let [names (:: List/Functor (F;map first names+parsers))
+ error-msg (text$ (text:++ "Wrong syntax for " name))
+ body' (foldL (: (-> Syntax (, Syntax Syntax) Syntax)
(lambda [body name+parser]
(let [[name parser] name+parser]
(` (_lux_case ((~ parser) (~ g!tokens))
(#;Some [(~ g!tokens) (~ name)])
(~ body)
- _
- #;None)))))
- (: Syntax (` (#;Some [(~@ names)])))
+ (~ g!_)
+ (l;fail (~ error-msg)))))))
+ body
(reverse names+parsers))
- body' (: Syntax
- (` (_lux_case (~ parsing)
- (#;Some [#;Nil [(~@ names)]])
- (~ body)
-
- _
- (l;fail (~ (text$ (text:++ "Wrong syntax for " name)))))))
- macro-def (: Syntax
- (` (m/defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
- (~ body'))))]]
- (M;wrap (list macro-def)))
-
- _
- (fail "Wrong syntax for defsyntax")))
+ macro-def (: Syntax
+ (` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens))
+ (~ body'))))]]
+ (M;wrap (list& macro-def
+ (if exported?
+ (list (` (_lux_export (~ (symbol$ ["" name])))))
+ (list)))))
+
+ _
+ (l;fail "Wrong syntax for defsyntax"))))
diff --git a/input/program.lux b/input/program.lux
index 6495854c1..19ee964e2 100644
--- a/input/program.lux
+++ b/input/program.lux
@@ -1,25 +1,35 @@
(;import lux
- (lux (control monoid
+ (lux (codata (stream #as S))
+ (control monoid
functor
monad
lazy
comonad)
- (data eq
- bounded
- ord
+ (data bounded
+ ## cont
+ dict
+ (either #as e)
+ eq
+ error
+ id
io
list
- state
+ maybe
number
+ ord
+ (reader #as r)
+ show
+ state
(text #as t)
- dict
- show)
- (codata (stream #refer (#except iterate)))
+ writer)
+ (host java)
(meta lux
macro
- syntax)))
+ syntax)
+ math
+ ))
-(_jvm_program args
+(program args
(case args
#;Nil
(println "Hello, world!")