aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux291
-rw-r--r--source/lux/codata/function.lux4
-rw-r--r--source/lux/codata/lazy.lux8
-rw-r--r--source/lux/codata/reader.lux8
-rw-r--r--source/lux/codata/state.lux8
-rw-r--r--source/lux/codata/stream.lux8
-rw-r--r--source/lux/data/bool.lux8
-rw-r--r--source/lux/data/char.lux4
-rw-r--r--source/lux/data/either.lux8
-rw-r--r--source/lux/data/id.lux14
-rw-r--r--source/lux/data/io.lux8
-rw-r--r--source/lux/data/list.lux16
-rw-r--r--source/lux/data/maybe.lux12
-rw-r--r--source/lux/data/number/int.lux40
-rw-r--r--source/lux/data/number/real.lux40
-rw-r--r--source/lux/data/text.lux18
-rw-r--r--source/lux/data/writer.lux8
-rw-r--r--source/lux/meta/lux.lux8
-rw-r--r--source/lux/meta/syntax.lux8
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/reader.clj27
-rw-r--r--test/test/lux/reader.clj57
22 files changed, 331 insertions, 274 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 422fb4fad..3ba8ec897 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -539,9 +539,9 @@
#Nil))))))
#Nil))
- (#Cons [_ (#SymbolS self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)))
+ (#Cons [_ (#SymbolS "" self)] (#Cons [_ (#TupleS (#Cons arg args'))] (#Cons body #Nil)))
(return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
- (#Cons (_meta (#SymbolS self))
+ (#Cons (_meta (#SymbolS "" self))
(#Cons arg
(#Cons (_lux_case args'
#Nil
@@ -649,26 +649,6 @@
(defmacro #export (comment tokens)
(return #Nil))
-(defmacro (->' tokens)
- (_lux_case tokens
- (#Cons input (#Cons output #Nil))
- (return (#Cons (_meta (#FormS (#Cons (tag$ ["lux" "LambdaT"])
- (#Cons (_meta (#TupleS (#Cons input (#Cons output #Nil))))
- #Nil))))
- #Nil))
-
- (#Cons input (#Cons output others))
- (return (#Cons (_meta (#FormS (#Cons (tag$ ["lux" "LambdaT"])
- (#Cons (_meta (#TupleS (#Cons input
- (#Cons (_meta (#FormS (#Cons (symbol$ ["lux" "->'"])
- (#Cons output others))))
- #Nil))))
- #Nil))))
- #Nil))
-
- _
- (fail "Wrong syntax for ->'")))
-
(defmacro ($' tokens)
(_lux_case tokens
(#Cons x #Nil)
@@ -687,7 +667,9 @@
(def'' (map f xs)
(#UnivQ #Nil
(#UnivQ #Nil
- (->' (->' (#BoundT 3) (#BoundT 1)) ($' List (#BoundT 3)) ($' List (#BoundT 1)))))
+ (#LambdaT (#LambdaT (#BoundT 3) (#BoundT 1))
+ (#LambdaT ($' List (#BoundT 3))
+ ($' List (#BoundT 1))))))
(_lux_case xs
#Nil
#Nil
@@ -700,7 +682,7 @@
($' List (#TupleT (#Cons Text (#Cons AST #Nil)))))
(def'' (make-env xs ys)
- (->' ($' List Text) ($' List AST) RepEnv)
+ (#LambdaT ($' List Text) (#LambdaT ($' List AST) RepEnv))
(_lux_case (_lux_: (#TupleT (#Cons ($' List Text) (#Cons ($' List AST) #Nil)))
[xs ys])
[(#Cons x xs') (#Cons y ys')]
@@ -710,12 +692,12 @@
#Nil))
(def'' (text:= x y)
- (->' Text Text Bool)
+ (#LambdaT Text (#LambdaT Text Bool))
(_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"]
x [y]))
(def'' (get-rep key env)
- (->' Text RepEnv ($' Maybe AST))
+ (#LambdaT Text (#LambdaT RepEnv ($' Maybe AST)))
(_lux_case env
#Nil
#None
@@ -729,7 +711,7 @@
(get-rep key env'))))
(def'' (replace-syntax reps syntax)
- (->' RepEnv AST AST)
+ (#LambdaT RepEnv (#LambdaT AST AST))
(_lux_case syntax
[_ (#SymbolS "" name)]
(_lux_case (get-rep name reps)
@@ -746,7 +728,7 @@
[meta (#TupleS (map (replace-syntax reps) members))]
[meta (#RecordS slots)]
- [meta (#RecordS (map (_lux_: (->' (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil))))
+ [meta (#RecordS (map (_lux_: (#LambdaT (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil))))
(lambda'' [slot]
(_lux_case slot
[k v]
@@ -758,7 +740,7 @@
)
(def'' (update-bounds ast)
- (->' AST AST)
+ (#LambdaT AST AST)
(_lux_case ast
[_ (#BoolS value)]
(bool$ value)
@@ -785,7 +767,7 @@
(tuple$ (map update-bounds members))
[_ (#RecordS pairs)]
- (record$ (map (_lux_: (->' (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil))))
+ (record$ (map (_lux_: (#LambdaT (#TupleT (#Cons AST (#Cons AST #Nil))) (#TupleT (#Cons AST (#Cons AST #Nil))))
(lambda'' [pair]
(let'' [name val] pair
[name (update-bounds val)])))
@@ -798,32 +780,33 @@
(form$ (map update-bounds members)))
)
-(defmacro (All' tokens)
- (_lux_case tokens
- (#Cons [_ (#TupleS (#Cons [_ (#SymbolS "" arg-name)] other-args))]
- (#Cons body #Nil))
- (let'' bound-var (_meta (#FormS (#Cons (tag$ ["lux" "BoundT"]) (#Cons (int$ 1) #Nil))))
- (let'' body' (replace-syntax (#Cons [arg-name bound-var] #Nil)
- (update-bounds body))
- (return (#Cons (_meta (#FormS (#Cons (tag$ ["lux" "UnivQ"])
- (#Cons (tag$ ["lux" "Nil"])
- (#Cons (_lux_case other-args
- #Nil
- body'
-
- _
- (_meta (#FormS (#Cons (symbol$ ["lux" "All'"])
- (#Cons (_meta (#TupleS other-args))
- (#Cons body'
- #Nil))))))
- #Nil)))))
- #Nil))))
+(def'' (parse-univq-args args next)
+ ## (All [a] (-> (List AST) (-> (List Text) (Lux a)) (Lux a)))
+ (#UnivQ #Nil (#LambdaT ($' List AST)
+ (#LambdaT (#LambdaT ($' List Text) (#AppT (#AppT StateE Compiler) (#BoundT 1)))
+ (#AppT (#AppT StateE Compiler) (#BoundT 1)))))
+ (_lux_case args
+ #Nil
+ (next #Nil)
+
+ (#Cons [_ (#SymbolS "" arg-name)] args')
+ (parse-univq-args args' (lambda'' [names] (next (#Cons arg-name names))))
_
- (fail "Wrong syntax for All'")))
+ (fail "Expected symbol.")))
+
+(def'' (make-bound idx)
+ (#LambdaT Int AST)
+ (form$ (#Cons (tag$ ["lux" "BoundT"]) (#Cons (int$ idx) #Nil))))
(def'' (foldL f init xs)
- (All' [a b] (->' (->' a b a) a ($' List b) a))
+ ## (All [a b] (-> (-> a b a) a (List b) a))
+ (#UnivQ #Nil (#UnivQ #Nil (#LambdaT (#LambdaT (#BoundT 3)
+ (#LambdaT (#BoundT 1)
+ (#BoundT 3)))
+ (#LambdaT (#BoundT 3)
+ (#LambdaT ($' List (#BoundT 1))
+ (#BoundT 3))))))
(_lux_case xs
#Nil
init
@@ -831,27 +814,66 @@
(#Cons x xs')
(foldL f (f init x) xs')))
+(defmacro #export (All tokens)
+ (let'' [self-name tokens] (_lux_: (#TupleT (#Cons Text (#Cons ASTList #Nil)))
+ (_lux_case tokens
+ (#Cons [_ (#SymbolS "" self-name)] tokens)
+ [self-name tokens]
+
+ _
+ ["" tokens]))
+ (_lux_case tokens
+ (#Cons [_ (#TupleS args)] (#Cons body #Nil))
+ (parse-univq-args args
+ (lambda'' [names]
+ (let'' body' (foldL (_lux_: (#LambdaT AST (#LambdaT Text AST))
+ (lambda'' [body' name']
+ (form$ (#Cons (tag$ ["lux" "UnivQ"])
+ (#Cons (tag$ ["lux" "Nil"])
+ (#Cons (replace-syntax (#Cons [name' (make-bound 1)] #Nil)
+ (update-bounds body')) #Nil))))))
+ (replace-syntax (#Cons [self-name (make-bound -2)] #Nil)
+ body)
+ names)
+ (return (#Cons body' #Nil)))))
+
+ _
+ (fail "Wrong syntax for All"))
+ ))
+
(def'' (reverse list)
- (All' [a] (->' ($' List a) ($' List a)))
+ (All [a] (#LambdaT ($' List a) ($' List a)))
(foldL (lambda'' [tail head] (#Cons head tail))
#Nil
list))
+(defmacro #export (-> tokens)
+ (_lux_case (reverse tokens)
+ (#Cons output inputs)
+ (return (#Cons (foldL (_lux_: (#LambdaT AST (#LambdaT AST AST))
+ (lambda'' [o i] (form$ (#Cons (tag$ ["lux" "LambdaT"]) (#Cons i (#Cons o #Nil))))))
+ output
+ inputs)
+ #Nil))
+
+ _
+ (fail "Wrong syntax for ->")))
+
(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])]))))
- (_meta (#TagS ["lux" "Nil"]))
- (reverse xs))
- #Nil])))
+ (return (#Cons (foldL (lambda'' [tail head]
+ (form$ (#Cons (tag$ ["lux" "Cons"])
+ (#Cons (tuple$ (#Cons [head (#Cons [tail #Nil])]))
+ #Nil))))
+ (tag$ ["lux" "Nil"])
+ (reverse xs))
+ #Nil)))
(defmacro (list& xs)
(_lux_case (reverse xs)
- (#Cons [last init])
+ (#Cons last init)
(return (list (foldL (lambda'' [tail head]
- (_meta (#FormS (list (_meta (#TagS ["lux" "Cons"]))
- (_meta (#TupleS (list head tail)))))))
+ (form$ (list (tag$ ["lux" "Cons"])
+ (tuple$ (list head tail)))))
last
init)))
@@ -859,13 +881,13 @@
(fail "Wrong syntax for list&")))
(defmacro (lambda' tokens)
- (let'' [name tokens'] (_lux_: (#TupleT (list Ident ($' List AST)))
+ (let'' [name tokens'] (_lux_: (#TupleT (list Text ($' List AST)))
(_lux_case tokens
- (#Cons [[_ (#SymbolS name)] tokens'])
+ (#Cons [[_ (#SymbolS ["" name])] tokens'])
[name tokens']
_
- [["" ""] tokens]))
+ ["" tokens]))
(_lux_case tokens'
(#Cons [[_ (#TupleS args)] (#Cons [body #Nil])])
(_lux_case args
@@ -874,7 +896,7 @@
(#Cons [harg targs])
(return (list (form$ (list (symbol$ ["" "_lux_lambda"])
- (symbol$ name)
+ (symbol$ ["" name])
harg
(foldL (lambda'' [body' arg]
(form$ (list (symbol$ ["" "_lux_lambda"])
@@ -931,7 +953,7 @@
))
(def''' (as-pairs xs)
- (All' [a] (->' ($' List a) ($' List (#TupleT (list a a)))))
+ (All [a] (-> ($' List a) ($' List (#TupleT (list a a)))))
(_lux_case xs
(#Cons x (#Cons y xs'))
(#Cons [x y] (as-pairs xs'))
@@ -942,8 +964,8 @@
(defmacro (let' tokens)
(_lux_case tokens
(#Cons [[_ (#TupleS bindings)] (#Cons [body #Nil])])
- (return (list (foldL (_lux_: (->' AST (#TupleT (list AST AST))
- AST)
+ (return (list (foldL (_lux_: (-> AST (#TupleT (list AST AST))
+ AST)
(lambda' [body binding]
(_lux_case binding
[label value]
@@ -955,8 +977,8 @@
(fail "Wrong syntax for let'")))
(def''' (any? p xs)
- (All' [a]
- (->' (->' a Bool) ($' List a) Bool))
+ (All [a]
+ (-> (-> a Bool) ($' List a) Bool))
(_lux_case xs
#Nil
false
@@ -967,7 +989,7 @@
false (any? p xs'))))
(def''' (spliced? token)
- (->' AST Bool)
+ (-> AST Bool)
(_lux_case token
[_ (#FormS (#Cons [[_ (#SymbolS ["" "~@"])] (#Cons [_ #Nil])]))]
true
@@ -976,12 +998,12 @@
false))
(def''' (wrap-meta content)
- (->' AST AST)
+ (-> AST AST)
(tuple$ (list (tuple$ (list (text$ "") (int$ -1) (int$ -1)))
content)))
(def''' (untemplate-list tokens)
- (->' ($' List AST) AST)
+ (-> ($' List AST) AST)
(_lux_case tokens
#Nil
(_meta (#TagS ["lux" "Nil"]))
@@ -991,7 +1013,7 @@
(_meta (#TupleS (list token (untemplate-list tokens')))))))))
(def''' #export (list:++ xs ys)
- (All' [a] (->' ($' List a) ($' List a) ($' List a)))
+ (All [a] (-> ($' List a) ($' List a) ($' List a)))
(_lux_case xs
(#Cons x xs')
(#Cons x (list:++ xs' ys))
@@ -1010,7 +1032,7 @@
(fail "Wrong syntax for $")))
(def''' (splice replace? untemplate tag elems)
- (->' Bool (->' AST AST) AST ($' List AST) AST)
+ (-> Bool (-> AST AST) AST ($' List AST) AST)
(_lux_case replace?
true
(_lux_case (any? spliced? elems)
@@ -1037,7 +1059,7 @@
(wrap-meta (form$ (list tag (untemplate-list (map untemplate elems)))))))
(def''' (untemplate replace? subst token)
- (->' Bool Text AST AST)
+ (-> Bool Text AST AST)
(_lux_case (_lux_: (#TupleT (list Bool AST)) [replace? token])
[_ [_ (#BoolS value)]]
(wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))
@@ -1084,7 +1106,7 @@
[_ [_ (#RecordS fields)]]
(wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
- (untemplate-list (map (_lux_: (->' (#TupleT (list AST AST)) AST)
+ (untemplate-list (map (_lux_: (-> (#TupleT (list AST AST)) AST)
(lambda' [kv]
(let' [[k v] kv]
(tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
@@ -1110,7 +1132,7 @@
(defmacro #export (|> tokens)
(_lux_case tokens
(#Cons [init apps])
- (return (list (foldL (_lux_: (->' AST AST AST)
+ (return (list (foldL (_lux_: (-> AST AST AST)
(lambda' [acc app]
(_lux_case app
[_ (#TupleS parts)]
@@ -1141,8 +1163,8 @@
## (-> Compiler (Either Text (, Compiler a))))
(def''' #export Lux
Type
- (All' [a]
- (->' Compiler ($' Either Text (#TupleT (list Compiler a))))))
+ (All [a]
+ (-> Compiler ($' Either Text (#TupleT (list Compiler a))))))
## (defsig (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1152,11 +1174,11 @@
(def''' Monad
Type
(#NamedT ["lux" "Monad"]
- (All' [m]
- (#TupleT (list (All' [a] (->' a ($' m a)))
- (All' [a b] (->' (->' a ($' m b))
- ($' m a)
- ($' m b))))))))
+ (All [m]
+ (#TupleT (list (All [a] (-> a ($' m a)))
+ (All [a b] (-> (-> a ($' m b))
+ ($' m a)
+ ($' m b))))))))
(_lux_declare-tags [#return #bind] Monad)
(def''' Maybe/Monad
@@ -1196,17 +1218,6 @@
_
(fail "Wrong syntax for ^")))
-(defmacro #export (-> tokens)
- (_lux_case (reverse tokens)
- (#Cons output inputs)
- (return (list (foldL (_lux_: (->' AST AST AST)
- (lambda' [o i] (`' (#;LambdaT (~ i) (~ o)))))
- output
- inputs)))
-
- _
- (fail "Wrong syntax for ->")))
-
(defmacro #export (, tokens)
(return (list (`' (#;TupleT (~ (untemplate-list tokens)))))))
@@ -1237,11 +1248,11 @@
(def''' (map% m f xs)
## (All [m a b]
## (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
- (All' [m a b]
- (-> ($' Monad m)
- (-> a ($' m b))
- ($' List a)
- ($' m ($' List b))))
+ (All [m a b]
+ (-> ($' Monad m)
+ (-> a ($' m b))
+ ($' List a)
+ ($' m ($' List b))))
(let' [{#;return wrap #;bind _} m]
(_lux_case xs
#Nil
@@ -1255,8 +1266,8 @@
)))
(def''' (. f g)
- (All' [a b c]
- (-> (-> b c) (-> a b) (-> a c)))
+ (All [a b c]
+ (-> (-> b c) (-> a b) (-> a c)))
(lambda' [x]
(f (g x))))
@@ -1315,8 +1326,8 @@
template))
(def''' (join-map f xs)
- (All' [a b]
- (-> (-> a ($' List b)) ($' List a) ($' List b)))
+ (All [a b]
+ (-> (-> a ($' List b)) ($' List a) ($' List b)))
(_lux_case xs
#Nil
#Nil
@@ -1408,39 +1419,6 @@
(let' [[module name] ident]
($ text:++ module ";" name)))
-(def''' (make-bound idx)
- (-> Int AST)
- (`' (#;BoundT (~ (int$ idx)))))
-
-(defmacro #export (All tokens)
- (let' [[self-name tokens] (_lux_: (, Text ASTList)
- (_lux_case tokens
- (#Cons [_ (#SymbolS "" self-name)] tokens)
- [self-name tokens]
-
- _
- ["" tokens]))]
- (_lux_case tokens
- (#Cons [_ (#TupleS (#Cons harg targs))] (#Cons body #Nil))
- (_lux_case (map% Maybe/Monad get-name (#Cons harg targs))
- (#Some names)
- (let' [body' (foldL (_lux_: (-> AST Text AST)
- (lambda' [body' name']
- (`' (#;UnivQ #;Nil (~ (|> body'
- (update-bounds)
- (replace-syntax (list [name' (make-bound 1)]))))))))
- (replace-syntax (list [self-name (make-bound -2)])
- body)
- names)]
- (return (list body')))
-
- #None
- (fail "\"All\" arguments must be symbols."))
-
- _
- (fail "Wrong syntax for All"))
- ))
-
(def''' (get k plist)
(All [a]
(-> Text ($' List (, Text a)) ($' Maybe a)))
@@ -1980,7 +1958,7 @@
(\ (list [_ (#TupleS (#Cons head tail))] body))
(#Some ["" ""] head tail body)
- (\ (list [_ (#SymbolS [_ name])] [_ (#TupleS (#Cons head tail))] body))
+ (\ (list [_ (#SymbolS ["" name])] [_ (#TupleS (#Cons head tail))] body))
(#Some ["" name] head tail body)
_
@@ -2379,17 +2357,40 @@
(defmacro #export (struct tokens)
(do Lux/Monad
- [tokens' (map% Lux/Monad macro-expand tokens)]
+ [tokens' (map% Lux/Monad macro-expand tokens)
+ struct-type expected-type
+ tags+type (resolve-type-tags struct-type)
+ tags (: (Lux (List Ident))
+ (case tags+type
+ (#Some [tags _])
+ (return tags)
+
+ _
+ (fail "No tags available for type.")))
+ #let [tag-mappings (: (List (, Text AST))
+ (map (lambda [tag] [(second tag) (tag$ tag)])
+ tags))]
+ _ (: (Lux Unit)
+ (let [msg ($ text:++ "struct/tag-mappings: " "[" (|> tag-mappings (map first) (interpose " ") (foldL text:++ "")) "]" " " (type:show struct-type))
+ _ (_jvm_invokevirtual "java.io.PrintStream" "println" ["java.lang.Object"]
+ (_jvm_getstatic "java.lang.System" "out") [msg])]
+ (return (: Unit []))))
+ ]
(do Lux/Monad
[members (map% Lux/Monad
(: (-> AST (Lux (, AST AST)))
(lambda [token]
(case token
- (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS tag-name)] value))])
- (wrap (: (, AST AST) [(tag$ tag-name) value]))
+ (\ [_ (#FormS (list [_ (#SymbolS _ "_lux_def")] [_ (#SymbolS "" tag-name)] value))])
+ (case (get tag-name tag-mappings)
+ (#Some tag)
+ (wrap (: (, AST AST) [tag value]))
+
+ _
+ (fail (text:++ "Unknown structure member: " tag-name)))
_
- (fail "Structures members must be unqualified."))))
+ (fail (text:++ "Invalid structure member: " (ast:show token))))))
(list:join tokens'))]
(wrap (list (record$ members))))))
diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux
index ea79ff9ad..a23e969b3 100644
--- a/source/lux/codata/function.lux
+++ b/source/lux/codata/function.lux
@@ -23,5 +23,5 @@
## [Structures]
(defstruct #export Comp/Monoid (All [a] (m;Monoid (-> a a)))
- (def m;unit id)
- (def m;++ .))
+ (def unit id)
+ (def ++ .))
diff --git a/source/lux/codata/lazy.lux b/source/lux/codata/lazy.lux
index 9c72fdb16..1529c0dae 100644
--- a/source/lux/codata/lazy.lux
+++ b/source/lux/codata/lazy.lux
@@ -34,13 +34,13 @@
## [Structs]
(defstruct #export Lazy/Functor (Functor Lazy)
- (def (F;map f ma)
+ (def (map f ma)
(lambda [k] (ma (. k f)))))
(defstruct #export Lazy/Monad (Monad Lazy)
- (def M;_functor Lazy/Functor)
+ (def _functor Lazy/Functor)
- (def (M;wrap a)
+ (def (wrap a)
(... a))
- (def M;join !))
+ (def join !))
diff --git a/source/lux/codata/reader.lux b/source/lux/codata/reader.lux
index 56b3e0286..e776f73ec 100644
--- a/source/lux/codata/reader.lux
+++ b/source/lux/codata/reader.lux
@@ -14,17 +14,17 @@
## [Structures]
(defstruct #export Reader/Functor (All [r]
(Functor (Reader r)))
- (def (F;map f fa)
+ (def (map f fa)
(lambda [env]
(f (fa env)))))
(defstruct #export Reader/Monad (All [r]
(Monad (Reader r)))
- (def M;_functor Reader/Functor)
+ (def _functor Reader/Functor)
- (def (M;wrap x)
+ (def (wrap x)
(lambda [env] x))
- (def (M;join mma)
+ (def (join mma)
(lambda [env]
(mma env env))))
diff --git a/source/lux/codata/state.lux b/source/lux/codata/state.lux
index d85ef3dbc..ec0a6bf63 100644
--- a/source/lux/codata/state.lux
+++ b/source/lux/codata/state.lux
@@ -13,20 +13,20 @@
## [Structures]
(defstruct #export State/Functor (Functor State)
- (def (F;map f ma)
+ (def (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 _functor State/Functor)
- (def (M;wrap x)
+ (def (wrap x)
(lambda [state]
[state x]))
- (def (M;join mma)
+ (def (join mma)
(lambda [state]
(let [[state' ma] (mma state)]
(ma state')))))
diff --git a/source/lux/codata/stream.lux b/source/lux/codata/stream.lux
index 5415213d7..d0f84f0c7 100644
--- a/source/lux/codata/stream.lux
+++ b/source/lux/codata/stream.lux
@@ -110,14 +110,14 @@
## [Structures]
(defstruct #export Stream/Functor (Functor Stream)
- (def (F;map f fa)
+ (def (map f fa)
(let [[h t] (! fa)]
(... [(f h) (map f t)]))))
(defstruct #export Stream/CoMonad (CoMonad Stream)
- (def CM;_functor Stream/Functor)
- (def CM;unwrap head)
- (def (CM;split wa)
+ (def _functor Stream/Functor)
+ (def unwrap head)
+ (def (split wa)
(:: Stream/Functor (F;map repeat wa))))
## [Pattern-matching]
diff --git a/source/lux/data/bool.lux b/source/lux/data/bool.lux
index 29de09328..defaee22e 100644
--- a/source/lux/data/bool.lux
+++ b/source/lux/data/bool.lux
@@ -11,19 +11,19 @@
## [Structures]
(defstruct #export Bool/Eq (E;Eq Bool)
- (def (E;= x y)
+ (def (= x y)
(if x
y
(not y))))
(defstruct #export Bool/Show (S;Show Bool)
- (def (S;show x)
+ (def (show x)
(if x "true" "false")))
(do-template [<name> <unit> <op>]
[(defstruct #export <name> (m;Monoid Bool)
- (def m;unit <unit>)
- (def (m;++ x y)
+ (def unit <unit>)
+ (def (++ x y)
(<op> x y)))]
[ Or/Monoid false or]
diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux
index e6e796123..4e0d41b22 100644
--- a/source/lux/data/char.lux
+++ b/source/lux/data/char.lux
@@ -10,9 +10,9 @@
## [Structures]
(defstruct #export Char/Eq (E;Eq Char)
- (def (E;= x y)
+ (def (= x y)
(_jvm_ceq x y)))
(defstruct #export Char/Show (S;Show Char)
- (def (S;show x)
+ (def (show x)
($ text:++ "#\"" (_jvm_invokevirtual "java.lang.Object" "toString" [] x []) "\"")))
diff --git a/source/lux/data/either.lux b/source/lux/data/either.lux
index 86d778965..38de1e2d1 100644
--- a/source/lux/data/either.lux
+++ b/source/lux/data/either.lux
@@ -46,18 +46,18 @@
## [Structures]
(defstruct #export Error/Functor (All [a] (Functor (Either a)))
- (def (F;map f ma)
+ (def (map f ma)
(case ma
(#;Left msg) (#;Left msg)
(#;Right datum) (#;Right (f datum)))))
(defstruct #export Error/Monad (All [a] (Monad (Either a)))
- (def M;_functor Error/Functor)
+ (def _functor Error/Functor)
- (def (M;wrap a)
+ (def (wrap a)
(#;Right a))
- (def (M;join mma)
+ (def (join mma)
(case mma
(#;Left msg) (#;Left msg)
(#;Right ma) ma)))
diff --git a/source/lux/data/id.lux b/source/lux/data/id.lux
index e06a24f94..6b996cf1e 100644
--- a/source/lux/data/id.lux
+++ b/source/lux/data/id.lux
@@ -14,16 +14,16 @@
## [Structures]
(defstruct #export Id/Functor (Functor Id)
- (def (F;map f fa)
+ (def (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)))
+ (def _functor Id/Functor)
+ (def (wrap a) (#Id a))
+ (def (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)))
+ (def _functor Id/Functor)
+ (def (unwrap wa) (let [(#Id a) wa] a))
+ (def (split wa) (#Id wa)))
diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux
index 144410f5c..032381404 100644
--- a/source/lux/data/io.lux
+++ b/source/lux/data/io.lux
@@ -27,16 +27,16 @@
## [Structures]
(defstruct #export IO/Functor (F;Functor IO)
- (def (F;map f ma)
+ (def (map f ma)
(io (f (ma [])))))
(defstruct #export IO/Monad (M;Monad IO)
- (def M;_functor IO/Functor)
+ (def _functor IO/Functor)
- (def (M;wrap x)
+ (def (wrap x)
(io x))
- (def (M;join mma)
+ (def (join mma)
(mma [])))
## [Functions]
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 10bbb8086..c9a4c7598 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -235,14 +235,14 @@
## [Structures]
## (defstruct #export (List/Eq eq) (All [a] (-> (Eq a) (Eq (List a))))
-## (def (E;= xs ys)
+## (def (= xs ys)
## (case [xs ys]
## [#;Nil #;Nil]
## true
## [(#;Cons x xs') (#;Cons y ys')]
## (and (:: eq (E;= x y))
-## (E;= xs' ys'))
+## (= xs' ys'))
## [_ _]
## false
@@ -250,25 +250,25 @@
(defstruct #export List/Monoid (All [a]
(Monoid (List a)))
- (def m;unit #;Nil)
- (def (m;++ xs ys)
+ (def unit #;Nil)
+ (def (++ xs ys)
(case xs
#;Nil ys
(#;Cons x xs') (#;Cons x (++ xs' ys)))))
(defstruct #export List/Functor (Functor List)
- (def (F;map f ma)
+ (def (map f ma)
(case ma
#;Nil #;Nil
(#;Cons [a ma']) (#;Cons [(f a) (map f ma')]))))
(defstruct #export List/Monad (Monad List)
- (def M;_functor List/Functor)
+ (def _functor List/Functor)
- (def (M;wrap a)
+ (def (wrap a)
(#;Cons [a #;Nil]))
- (def (M;join mma)
+ (def (join mma)
(using List/Monoid
(foldL ++ unit mma))))
diff --git a/source/lux/data/maybe.lux b/source/lux/data/maybe.lux
index bb4eee6df..5df03f378 100644
--- a/source/lux/data/maybe.lux
+++ b/source/lux/data/maybe.lux
@@ -18,25 +18,25 @@
## [Structures]
(defstruct #export Maybe/Monoid (All [a] (Monoid (Maybe a)))
- (def m;unit #;None)
- (def (m;++ xs ys)
+ (def unit #;None)
+ (def (++ xs ys)
(case xs
#;None ys
(#;Some x) (#;Some x))))
(defstruct #export Maybe/Functor (Functor Maybe)
- (def (F;map f ma)
+ (def (map f ma)
(case ma
#;None #;None
(#;Some a) (#;Some (f a)))))
(defstruct #export Maybe/Monad (Monad Maybe)
- (def M;_functor Maybe/Functor)
+ (def _functor Maybe/Functor)
- (def (M;wrap x)
+ (def (wrap x)
(#;Some x))
- (def (M;join mma)
+ (def (join mma)
(case mma
#;None #;None
(#;Some xs) xs)))
diff --git a/source/lux/data/number/int.lux b/source/lux/data/number/int.lux
index cc327ad0c..2d94ad43b 100644
--- a/source/lux/data/number/int.lux
+++ b/source/lux/data/number/int.lux
@@ -15,20 +15,20 @@
## 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)
+ (def (+ x y) (<+> x y))
+ (def (- x y) (<-> x y))
+ (def (* x y) (<*> x y))
+ (def (/ x y) (</> x y))
+ (def (% x y) (<%> x y))
+ (def (from-int x)
(<from> x))
- (def (N;negate x)
+ (def (negate x)
(<*> <-1> x))
- (def (N;abs x)
+ (def (abs x)
(if (<<> x <0>)
(<*> <-1> x)
x))
- (def (N;signum x)
+ (def (signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
@@ -39,18 +39,18 @@
## Eq
(defstruct #export Int/Eq (E;Eq Int)
- (def (E;= x y) (_jvm_leq x y)))
+ (def (= 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)
+ (def _eq <eq>)
+ (def (< x y) (<lt> x y))
+ (def (<= x y)
(or (<lt> x y)
(<=> x y)))
- (def (O;> x y) (<gt> x y))
- (def (O;>= x y)
+ (def (> x y) (<gt> x y))
+ (def (>= x y)
(or (<gt> x y)
(<=> x y))))]
@@ -59,16 +59,16 @@
## Bounded
(do-template [<name> <type> <top> <bottom>]
[(defstruct #export <name> (B;Bounded <type>)
- (def B;top <top>)
- (def B;bottom <bottom>))]
+ (def top <top>)
+ (def 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)))]
+ (def unit <unit>)
+ (def (++ x y) (<++> x y)))]
[ IntAdd/Monoid Int 0 _jvm_ladd]
[ IntMul/Monoid Int 1 _jvm_lmul]
@@ -79,7 +79,7 @@
## Show
(do-template [<name> <type> <body>]
[(defstruct #export <name> (S;Show <type>)
- (def (S;show x)
+ (def (show x)
<body>))]
[ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])]
diff --git a/source/lux/data/number/real.lux b/source/lux/data/number/real.lux
index 27f1bf7b0..2b7090265 100644
--- a/source/lux/data/number/real.lux
+++ b/source/lux/data/number/real.lux
@@ -15,20 +15,20 @@
## 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)
+ (def (+ x y) (<+> x y))
+ (def (- x y) (<-> x y))
+ (def (* x y) (<*> x y))
+ (def (/ x y) (</> x y))
+ (def (% x y) (<%> x y))
+ (def (from-int x)
(<from> x))
- (def (N;negate x)
+ (def (negate x)
(<*> <-1> x))
- (def (N;abs x)
+ (def (abs x)
(if (<<> x <0>)
(<*> <-1> x)
x))
- (def (N;signum x)
+ (def (signum x)
(cond (<=> x <0>) <0>
(<<> x <0>) <-1>
## else
@@ -39,18 +39,18 @@
## Eq
(defstruct #export Real/Eq (E;Eq Real)
- (def (E;= x y) (_jvm_deq x y)))
+ (def (= x y) (_jvm_deq 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)
+ (def _eq <eq>)
+ (def (< x y) (<lt> x y))
+ (def (<= x y)
(or (<lt> x y)
(<=> x y)))
- (def (O;> x y) (<gt> x y))
- (def (O;>= x y)
+ (def (> x y) (<gt> x y))
+ (def (>= x y)
(or (<gt> x y)
(<=> x y))))]
@@ -59,16 +59,16 @@
## Bounded
(do-template [<name> <type> <top> <bottom>]
[(defstruct #export <name> (B;Bounded <type>)
- (def B;top <top>)
- (def B;bottom <bottom>))]
+ (def top <top>)
+ (def bottom <bottom>))]
[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;++ x y) (<++> x y)))]
+ (def unit <unit>)
+ (def (++ x y) (<++> x y)))]
[RealAdd/Monoid Real 0.0 _jvm_dadd]
[RealMul/Monoid Real 1.0 _jvm_dmul]
@@ -79,7 +79,7 @@
## Show
(do-template [<name> <type> <body>]
[(defstruct #export <name> (S;Show <type>)
- (def (S;show x)
+ (def (show x)
<body>))]
[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 0040a96c5..533308dd0 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -115,12 +115,12 @@
## [Structures]
(defstruct #export Text/Eq (E;Eq Text)
- (def (E;= x y)
+ (def (= 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)
+ (def _eq Text/Eq)
(do-template [<name> <op>]
[(def (<name> x y)
@@ -128,17 +128,17 @@
x [y]))
0))]
- [O;< i<]
- [O;<= i<=]
- [O;> i>]
- [O;>= i>=]))
+ [< i<]
+ [<= i<=]
+ [> i>]
+ [>= i>=]))
(defstruct #export Text/Show (S;Show Text)
- (def S;show id))
+ (def show id))
(defstruct #export Text/Monoid (m;Monoid Text)
- (def m;unit "")
- (def (m;++ x y)
+ (def unit "")
+ (def (++ x y)
(_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"]
x [y])))
diff --git a/source/lux/data/writer.lux b/source/lux/data/writer.lux
index 316e1fbcc..bf26eac9a 100644
--- a/source/lux/data/writer.lux
+++ b/source/lux/data/writer.lux
@@ -15,17 +15,17 @@
## [Structures]
(defstruct #export Writer/Functor (All [l]
(Functor (Writer l)))
- (def (F;map f fa)
+ (def (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 _functor Writer/Functor)
- (def (M;wrap x)
+ (def (wrap x)
[(:: mon m;unit) x])
- (def (M;join mma)
+ (def (join mma)
(let [[log1 [log2 a]] mma]
[(:: mon (m;++ log1 log2)) a])))
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 92c43bbee..32ca78570 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -26,7 +26,7 @@
## [Structures]
(defstruct #export Lux/Functor (F;Functor Lux)
- (def (F;map f fa)
+ (def (map f fa)
(lambda [state]
(case (fa state)
(#;Left msg)
@@ -36,11 +36,11 @@
(#;Right [state' (f a)])))))
(defstruct #export Lux/Monad (M;Monad Lux)
- (def M;_functor Lux/Functor)
- (def (M;wrap x)
+ (def _functor Lux/Functor)
+ (def (wrap x)
(lambda [state]
(#;Right [state x])))
- (def (M;join mma)
+ (def (join mma)
(lambda [state]
(case (mma state)
(#;Left msg)
diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux
index 1732350ce..7d888f659 100644
--- a/source/lux/meta/syntax.lux
+++ b/source/lux/meta/syntax.lux
@@ -35,7 +35,7 @@
## [Structures]
(defstruct #export Parser/Functor (F;Functor Parser)
- (def (F;map f ma)
+ (def (map f ma)
(lambda [tokens]
(case (ma tokens)
#;None
@@ -45,12 +45,12 @@
(#;Some [tokens' (f a)])))))
(defstruct #export Parser/Monad (M;Monad Parser)
- (def M;_functor Parser/Functor)
+ (def _functor Parser/Functor)
- (def (M;wrap x tokens)
+ (def (wrap x tokens)
(#;Some [tokens x]))
- (def (M;join mma)
+ (def (join mma)
(lambda [tokens]
(case (mma tokens)
#;None
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index b8ffa825f..694c6bfc4 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -421,7 +421,7 @@
(fn [state]
(|case ((&/with-writer =class
(&/exhaust% compiler-step))
- (&/set$ &/$source (&reader/from file-name file-content) state))
+ (&/set$ &/$source (&reader/from name file-content) state))
(&/$Right ?state _)
(&/run-state (|do [defs &a-module/defs
imports &a-module/imports
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 0fcb5097b..af6c1ecc3 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -48,7 +48,6 @@
(fail* msg)
)))
-;; [Exports]
(defn ^:private re-find! [^java.util.regex.Pattern regex column ^String line]
(let [matcher (doto (.matcher regex line)
(.region column (.length line))
@@ -72,6 +71,7 @@
(.group matcher 1)
(.group matcher 2)))))
+;; [Exports]
(defn read-regex [regex]
(with-line
(fn [file-name line-num column-num ^String line]
@@ -125,7 +125,6 @@
(defn read-text [^String text]
(with-line
(fn [file-name line-num column-num ^String line]
- ;; (prn 'read-text [file-name line-num column-num text line])
(if (.startsWith line text column-num)
(let [match-length (.length text)
column-num* (+ column-num match-length)]
@@ -135,15 +134,15 @@
(&/T (&/T file-name line-num column-num*) line)))))
(&/V $No (str "[Reader Error] Text failed: " text))))))
-(def ^:private ^String +source-dir+ "input/")
-(defn from [^String file-name ^String file-content]
- (let [lines (&/->list (string/split-lines file-content))
- file-name (.substring file-name (.length +source-dir+))]
- (&/|map (fn [line+line-num]
- (|let [[line-num line] line+line-num]
- (&/T (&/T file-name (inc line-num) 0)
- line)))
- (&/|filter (fn [line+line-num]
- (|let [[line-num line] line+line-num]
- (not= "" line)))
- (&/enumerate lines)))))
+(defn from [^String name ^String source-code]
+ (->> source-code
+ (string/split-lines)
+ (&/->list)
+ (&/enumerate)
+ (&/|filter (fn [line+line-num]
+ (|let [[line-num line] line+line-num]
+ (not= "" line))))
+ (&/|map (fn [line+line-num]
+ (|let [[line-num line] line+line-num]
+ (&/T (&/T name (inc line-num) 0)
+ line))))))
diff --git a/test/test/lux/reader.clj b/test/test/lux/reader.clj
new file mode 100644
index 000000000..9b4954c5a
--- /dev/null
+++ b/test/test/lux/reader.clj
@@ -0,0 +1,57 @@
+(ns text.lux.reader
+ (:use clojure.test)
+ (:require (lux [base :as & :refer [deftags |do return* return fail fail* |let |case]]
+ [reader :as &reader])
+ :reload-all))
+
+;; [Utils]
+(def source (&reader/from "yolo" "lol\nmeme\nnyan cat\n\nlolcat"))
+(def init-state (&/set$ &/$source source (&/init-state nil)))
+
+;; [Tests]
+(deftest test-source-code-reading
+ (is (= 4 (&/|length source))))
+
+(deftest test-text-reading
+ ;; Should be capable of recognizing literal texts.
+ (let [input "lo"]
+ (|case (&/run-state (&reader/read-text input) init-state)
+ (&/$Right state [cursor output])
+ (is (= input output))
+
+ _
+ (is false "Couldn't read.")
+ )))
+
+(deftest test-regex-reading
+ ;; Should be capable of matching simple, grouping regex-patterns.
+ (|case (&/run-state (&reader/read-regex #"l(.)l") init-state)
+ (&/$Right state [cursor output])
+ (is (= "lol" "lol"))
+
+ _
+ (is false "Couldn't read.")
+ ))
+
+(deftest test-regex2-reading
+ ;; Should be capable of matching double, grouping regex-patterns.
+ (|case (&/run-state (&reader/read-regex2 #"(.)(..)") init-state)
+ (&/$Right state [cursor [left right]])
+ (is (and (= "l" left)
+ (= "ol" right)))
+
+ _
+ (is false "Couldn't read.")
+ ))
+
+(deftest test-regex+-reading
+ ;; Should be capable of matching multi-line regex-patterns.
+ (|case (&/run-state (&reader/read-regex+ #"(?is)^(.*?)(cat|$)") init-state)
+ (&/$Right state [cursor output])
+ (is (= "lol\nmeme\nnyan " output))
+
+ _
+ (is false "Couldn't read.")
+ ))
+
+;; (run-all-tests)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 14:26:46 +0000