aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux292
-rw-r--r--src/lux/analyser.clj22
-rw-r--r--src/lux/analyser/lux.clj16
-rw-r--r--src/lux/analyser/module.clj24
-rw-r--r--src/lux/host.clj8
-rw-r--r--src/lux/lexer.clj13
-rw-r--r--src/lux/reader.clj2
-rw-r--r--src/lux/type.clj2
8 files changed, 218 insertions, 161 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 04ffcf91f..70ebaf67e 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -646,7 +646,7 @@
_
(fail "Wrong syntax for lambda"))))
-(defmacro #export (def tokens)
+(defmacro (def__ tokens)
(case' tokens
(#Cons [(#Meta [_ (#Tag ["" "export"])])
(#Cons [(#Meta [_ (#Form (#Cons [name args]))])
@@ -693,7 +693,7 @@
(fail "Wrong syntax for def")
))
-(def (as-pairs xs)
+(def__ (as-pairs xs)
(All' [a]
(->' ($' List (B' a)) ($' List (#TupleT (list (B' a) (B' a))))))
(case' xs
@@ -724,7 +724,7 @@
_
(fail "Wrong syntax for let")))
-(def #export (map f xs)
+(def__ #export (map f xs)
(All' [a b]
(->' (->' (B' a) (B' b)) ($' List (B' a)) ($' List (B' b))))
(case' xs
@@ -734,7 +734,7 @@
(#Cons [x xs'])
(#Cons [(f x) (map f xs')])))
-(def #export (any? p xs)
+(def__ #export (any? p xs)
(All' [a]
(->' (->' (B' a) Bool) ($' List (B' a)) Bool))
(case' xs
@@ -746,7 +746,7 @@
true true
false (any? p xs'))))
-(def (spliced? token)
+(def__ (spliced? token)
(->' Syntax Bool)
(case' token
(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol ["" "~@"])]) (#Cons [_ #Nil])]))])
@@ -755,13 +755,13 @@
_
false))
-(def (wrap-meta content)
+(def__ (wrap-meta content)
(->' Syntax Syntax)
(_meta (#Form (list (_meta (#Tag ["lux" "Meta"]))
(_meta (#Tuple (list (_meta (#Tuple (list (_meta (#Text "")) (_meta (#Int -1)) (_meta (#Int -1)))))
content)))))))
-(def (untemplate-list tokens)
+(def__ (untemplate-list tokens)
(->' ($' List Syntax) Syntax)
(case' tokens
#Nil
@@ -771,7 +771,7 @@
(_meta (#Form (list (_meta (#Tag ["lux" "Cons"]))
(_meta (#Tuple (list token (untemplate-list tokens')))))))))
-(def (list:++ xs ys)
+(def__ (list:++ xs ys)
(All' [a] (->' ($' List (B' a)) ($' List (B' a)) ($' List (B' a))))
(case' xs
(#Cons [x xs'])
@@ -793,7 +793,7 @@
_
(fail "Wrong syntax for $")))
-(def (splice untemplate tag elems)
+(def__ (splice untemplate tag elems)
(->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
(case' (any? spliced? elems)
true
@@ -816,7 +816,7 @@
false
(wrap-meta ($form (list tag (untemplate-list (map untemplate elems)))))))
-(def (untemplate token)
+(def__ (untemplate token)
(->' Syntax Syntax)
(case' token
(#Meta [_ (#Bool value)])
@@ -898,7 +898,7 @@
## (deftype (Lux a)
## (-> CompilerState (Either Text (, CompilerState a))))
-(def #export Lux
+(def__ #export Lux
Type
(All' [a]
(->' CompilerState ($' Either Text (#TupleT (list CompilerState (B' a)))))))
@@ -908,7 +908,7 @@
## return)
## (: (All [a b] (-> (-> a (m b)) (m a) (m b)))
## bind))
-(def Monad
+(def__ Monad
Type
(All' [m]
(#RecordT (list ["lux;return" (All' [a] (->' (B' a) ($' (B' m) (B' a))))]
@@ -916,7 +916,7 @@
($' (B' m) (B' a))
($' (B' m) (B' b))))]))))
-(def Maybe:Monad
+(def__ Maybe:Monad
($' Monad Maybe)
{#lux;return
(lambda return [x]
@@ -928,7 +928,7 @@
#None #None
(#Some a) (f a)))})
-(def Lux:Monad
+(def__ Lux:Monad
($' Monad Lux)
{#lux;return
(lambda return [x]
@@ -996,7 +996,7 @@
_
(fail "Wrong syntax for do")))
-(def (map% m f xs)
+(def__ (map% m f xs)
## (All [m a b]
## (-> (Monad m) (-> a (m b)) (List a) (m (List b))))
(All' [m a b]
@@ -1016,13 +1016,13 @@
(;return (:' List (#Cons [y ys]))))
)))
-(def #export (. f g)
+(def__ #export (. f g)
(All' [a b c]
(-> (-> (B' b) (B' c)) (-> (B' a) (B' b)) (-> (B' a) (B' c))))
(lambda [x]
(f (g x))))
-(def (get-ident x)
+(def__ (get-ident x)
(-> Syntax ($' Maybe Text))
(case' x
(#Meta [_ (#Symbol ["" sname])])
@@ -1031,7 +1031,7 @@
_
#None))
-(def (tuple->list tuple)
+(def__ (tuple->list tuple)
(-> Syntax ($' Maybe ($' List Syntax)))
(case' tuple
(#Meta [_ (#Tuple members)])
@@ -1040,11 +1040,11 @@
_
#None))
-(def RepEnv
+(def__ RepEnv
Type
($' List (, Text Syntax)))
-(def (make-env xs ys)
+(def__ (make-env xs ys)
(-> ($' List Text) ($' List Syntax) RepEnv)
(case' (:' (, ($' List Text) ($' List Syntax))
[xs ys])
@@ -1054,12 +1054,12 @@
_
#Nil))
-(def (text:= x y)
+(def__ (text:= x y)
(-> Text Text Bool)
(jvm-invokevirtual java.lang.Object equals [java.lang.Object]
x [y]))
-(def (get-rep key env)
+(def__ (get-rep key env)
(-> Text RepEnv ($' Maybe Syntax))
(case' env
#Nil
@@ -1070,7 +1070,7 @@
(#Some v)
(get-rep key env'))))
-(def (apply-template env template)
+(def__ (apply-template env template)
(-> RepEnv Syntax Syntax)
(case' template
(#Meta [_ (#Symbol ["" sname])])
@@ -1097,7 +1097,7 @@
_
template))
-(def (join-map f xs)
+(def__ (join-map f xs)
(All' [a b]
(-> (-> (B' a) ($' List (B' b))) ($' List (B' a)) ($' List (B' b))))
(case' xs
@@ -1127,7 +1127,7 @@
(fail "Wrong syntax for do-template")))
(do-template [<name> <cmp> <type>]
- [(def #export (<name> x y)
+ [(def__ #export (<name> x y)
(-> <type> <type> Bool)
(<cmp> x y))]
@@ -1140,7 +1140,7 @@
)
(do-template [<name> <cmp> <type>]
- [(def #export (<name> x y)
+ [(def__ #export (<name> x y)
(-> <type> <type> <type>)
(<cmp> x y))]
@@ -1156,24 +1156,24 @@
[real:% jvm-drem Real]
)
-(def (multiple? div n)
+(def__ (multiple? div n)
(-> Int Int Bool)
(int:= 0 (int:% n div)))
-(def #export (length list)
+(def__ #export (length list)
(-> List Int)
(fold (lambda [acc _] (int:+ 1 acc)) 0 list))
-(def #export (not x)
+(def__ #export (not x)
(-> Bool Bool)
(if x false true))
-(def (text:++ x y)
+(def__ (text:++ x y)
(-> Text Text Text)
(jvm-invokevirtual java.lang.String concat [java.lang.String]
x [y]))
-(def (ident->text ident)
+(def__ (ident->text ident)
(-> Ident Text)
(let [[module name] ident]
($ text:++ module ";" name)))
@@ -1211,7 +1211,7 @@
(as-pairs tokens))]
(;return (:' SyntaxList (list (` (#;RecordT (;list (~@ pairs))))))))))
-(def (replace-syntax reps syntax)
+(def__ (replace-syntax reps syntax)
(-> RepEnv Syntax Syntax)
(case' syntax
(#Meta [_ (#Symbol ["" name])])
@@ -1274,7 +1274,7 @@
(fail "Wrong syntax for All"))
))
-(def (get k plist)
+(def__ (get k plist)
(All [a]
(-> Text ($' List (, Text a)) ($' Maybe a)))
(case' plist
@@ -1286,7 +1286,7 @@
#Nil
#None))
-(def #export (find-macro ident state)
+(def__ #export (find-macro ident state)
(-> Ident ($' Lux ($' Maybe Macro)))
(let [[module name] ident]
(case' state
@@ -1303,12 +1303,12 @@
_
#None))]))))
-(def (list:join xs)
+(def__ (list:join xs)
(All [a]
(-> ($' List ($' List a)) ($' List a)))
(fold list:++ #Nil xs))
-(def #export (normalize ident state)
+(def__ #export (normalize ident state)
(-> Ident ($' Lux Ident))
(case' ident
["" name]
@@ -1326,40 +1326,63 @@
_
(#Right [state ident])))
-## (def #export (macro-expand syntax)
-## (-> Syntax ($' Lux ($' List Syntax)))
-## (case' syntax
-## (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
-## (do Lux:Monad
-## [macro-name' (normalize macro-name)
-## ?macro (find-macro macro-name')]
-## (case' (:' ($' Maybe Macro) ?macro)
-## (#Some macro)
-## (do Lux:Monad
-## [expansion (macro args)
-## expansion' (map% Lux:Monad macro-expand expansion)]
-## (;return (:' SyntaxList (list:join expansion'))))
-
-## #None
-## (do Lux:Monad
-## [parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
-## (;return (:' SyntaxList (list ($form (list:join parts'))))))))
-
-## ## (#Meta [_ (#Form (#Cons [harg targs]))])
-## ## (do Lux:Monad
-## ## [harg+ (macro-expand harg)
-## ## targs+ (map% Lux:Monad macro-expand targs)]
-## ## (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
-
-## (#Meta [_ (#Tuple members)])
-## (do Lux:Monad
-## [members' (map% Lux:Monad macro-expand members)]
-## (;return (:' SyntaxList (list ($tuple (list:join members'))))))
-
-## _
-## (return (:' SyntaxList (list syntax)))))
-
-(def #export (macro-expand syntax)
+(def__ (->text x)
+ (-> (^ java.lang.Object) Text)
+ (jvm-invokevirtual java.lang.Object toString [] x []))
+
+(def__ #export (interpose sep xs)
+ (All [a]
+ (-> a ($' List a) ($' List a)))
+ (case' xs
+ #Nil
+ xs
+
+ (#Cons [x #Nil])
+ xs
+
+ (#Cons [x xs'])
+ (list& x sep (interpose sep xs'))))
+
+(def__ #export (syntax:show syntax)
+ (-> Syntax Text)
+ (case' syntax
+ (#Meta [_ (#Bool value)])
+ (->text value)
+
+ (#Meta [_ (#Int value)])
+ (->text value)
+
+ (#Meta [_ (#Real value)])
+ (->text value)
+
+ (#Meta [_ (#Char value)])
+ ($ text:++ "#\"" (->text value) "\"")
+
+ (#Meta [_ (#Text value)])
+ value
+
+ (#Meta [_ (#Symbol ident)])
+ (ident->text ident)
+
+ (#Meta [_ (#Tag ident)])
+ (text:++ "#" (ident->text ident))
+
+ (#Meta [_ (#Tuple members)])
+ ($ text:++ "[" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) "]")
+
+ (#Meta [_ (#Form members)])
+ ($ text:++ "(" (|> members (map syntax:show) (interpose " ") (fold text:++ "")) ")")
+
+ (#Meta [_ (#Record slots)])
+ ($ text:++ "(" (|> slots
+ (map (:' (-> (, Syntax Syntax) Text)
+ (lambda [slot]
+ (let [[k v] slot]
+ ($ text:++ (syntax:show k) " " (syntax:show v))))))
+ (interpose " ") (fold text:++ "")) ")")
+ ))
+
+(def__ #export (macro-expand syntax)
(-> Syntax ($' Lux ($' List Syntax)))
(case' syntax
(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) args]))])
@@ -1378,11 +1401,11 @@
[parts' (map% Lux:Monad macro-expand (list& ($symbol macro-name) args))]
(;return (:' SyntaxList (list ($form (list:join parts'))))))))
- ## (#Meta [_ (#Form (#Cons [harg targs]))])
- ## (do Lux:Monad
- ## [harg+ (macro-expand harg)
- ## targs+ (map% Lux:Monad macro-expand targs)]
- ## (;return (:' SyntaxList (list:++ harg+ (list:join targs+)))))
+ (#Meta [_ (#Form (#Cons [harg targs]))])
+ (do Lux:Monad
+ [harg+ (macro-expand harg)
+ targs+ (map% Lux:Monad macro-expand targs)]
+ (;return (:' SyntaxList (list ($form (list:++ harg+ (list:join (:' ($' List ($' List Syntax)) targs+))))))))
(#Meta [_ (#Tuple members)])
(do Lux:Monad
@@ -1392,7 +1415,7 @@
_
(return (:' SyntaxList (list syntax)))))
-(def (walk-type type)
+(def__ (walk-type type)
(-> Syntax Syntax)
(case' type
(#Meta [_ (#Form (#Cons [(#Meta [_ (#Tag tag)]) parts]))])
@@ -1450,36 +1473,37 @@
_
[false tokens]))
- ## parts (: (Maybe (, Syntax (List Syntax) Syntax))
- ## (case' tokens'
- ## (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
- ## (#Some [($symbol name) #Nil type])
+ parts (: (Maybe (, Syntax (List Syntax) Syntax))
+ (case' tokens'
+ (#Cons [(#Meta [_ (#Symbol name)]) (#Cons [type #Nil])])
+ (#Some [($symbol name) #Nil type])
- ## (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
- ## (#Some [($symbol name) args type])
+ (#Cons [(#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol name)]) args]))]) (#Cons [type #Nil])])
+ (#Some [($symbol name) args type])
- ## _
- ## #None))
+ _
+ #None))
]
- (return (: (List Syntax) #Nil))
- ## (case' parts
- ## (#Some [name args type])
- ## (let [with-export (: (List Syntax)
- ## (if export?
- ## (list (` (export' (~ name))))
- ## #Nil))
- ## type' (: Syntax
- ## (case' args
- ## #Nil
- ## type
-
- ## _
- ## (` (;All (~ name) [(~@ args)] (~ type)))))]
- ## (return (: (List Syntax)
- ## (list& type' with-export))))
-
- ## #None
- ## (fail "Wrong syntax for deftype"))
+ ## (return (: (List Syntax) #Nil))
+ (case' parts
+ (#Some [name args type])
+ (let [with-export (: (List Syntax)
+ (if export?
+ (list (` (export' (~ name))))
+ #Nil))
+ type' (: Syntax
+ (case' args
+ #Nil
+ type
+
+ _
+ (` (;All (~ name) [(~@ args)] (~ type)))))]
+ (return (: (List Syntax)
+ (list& (` (def' (~ name) (;type` (~ type'))))
+ with-export))))
+
+ #None
+ (fail "Wrong syntax for deftype"))
))
(deftype #export (IO a)
@@ -1489,7 +1513,8 @@
(case' tokens
(#Cons [value #Nil])
(let [blank ($symbol ["" ""])]
- (return (list (` (lambda' (~ blank) (~ blank) (~ value))))))
+ (return (: (List Syntax)
+ (list (` (lambda' (~ blank) (~ blank) (~ value)))))))
_
(fail "Wrong syntax for io")))
@@ -1508,6 +1533,51 @@
_
(fail "Wrong syntax for exec")))
+(defmacro #export (def tokens)
+ (let [[export? tokens'] (: (, Bool (List Syntax))
+ (case' tokens
+ (#Cons [(#Meta [_ (#Tag ["" "export"])]) tokens'])
+ [true tokens']
+
+ _
+ [false tokens]))
+ parts (: (Maybe (, Syntax (List Syntax) (Maybe Syntax) Syntax))
+ (case' tokens'
+ (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [type (#Cons [body #Nil])])])
+ (#Some [name args (#Some type) body])
+
+ (#Cons [name (#Cons [type (#Cons [body #Nil])])])
+ (#Some [name #Nil (#Some type) body])
+
+ (#Cons [(#Meta [_ (#Form (#Cons [name args]))]) (#Cons [body #Nil])])
+ (#Some [name args #None body])
+
+ (#Cons [name (#Cons [body #Nil])])
+ (#Some [name #Nil #None body])
+
+ _
+ #None))]
+ (case' parts
+ (#Some [name args ?type body])
+ (let [body' (: Syntax
+ (case' args
+ #Nil
+ body
+
+ _
+ (` (;lambda (~ name) [(~@ args)] (~ body)))))
+ body'' (: Syntax
+ (case' ?type
+ (#Some type)
+ (` (: (~ type) (~ body')))
+
+ #None
+ body'))]
+ (return (: (List Syntax) (list (` (def' (~ name) (~ body'')))))))
+
+ #None
+ (fail "Wrong syntax for def"))))
+
(def (rejoin-pair pair)
(-> (, Syntax Syntax) (List Syntax))
(let [[left right] pair]
@@ -1515,24 +1585,26 @@
(defmacro #export (case tokens)
(case' tokens
- (#Cons value branches)
+ (#Cons [value branches])
(do Lux:Monad
[expansions (map% Lux:Monad
(: (-> (, Syntax Syntax) (Lux (List (, Syntax Syntax))))
(lambda expander [branch]
(let [[pattern body] branch]
(case' pattern
- (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args])
+ (#Meta [_ (#Form (#Cons [(#Meta [_ (#Symbol macro-name)]) macro-args]))])
(do Lux:Monad
- [expansion (macro-expand (list& ($symbol macro-name) body macro-args))]
- (map% Lux:Monad expander (as-pairs expansion)))
+ [expansion (macro-expand ($form (list& ($symbol macro-name) body macro-args)))
+ expansions (map% Lux:Monad expander (as-pairs (: (List Syntax) expansion)))]
+ (;return (list:join (: (List (List (, Syntax Syntax))) expansions))))
_
(;return (: (List (, Syntax Syntax)) (list branch)))))))
(as-pairs branches))]
- (;return (: (List (, Syntax Syntax))
+ (;return (: (List Syntax)
(list (` (case' (~ value)
- (~@ (|> expansions list:join (map rejoin-pair) list:join))))))))
+ (~@ (|> (: (List (List (, Syntax Syntax))) expansions) list:join (map rejoin-pair) list:join))
+ ))))))
_
(fail "Wrong syntax for case")))
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 31b665c49..f3292ad49 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -232,35 +232,35 @@
(&&host/analyse-jvm-new analyse ?class ?classes ?args)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-getstatic"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Nil" _]]]]]]]]]]]
(&&host/analyse-jvm-getstatic analyse ?class ?field)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-getfield"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Cons" [?object
["lux;Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-getfield analyse ?class ?field ?object)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-putstatic"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]]]
(&&host/analyse-jvm-putstatic analyse ?class ?field ?value)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-putfield"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Text" ?field]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?field]]]]
["lux;Cons" [?object
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]]]]]
(&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokestatic"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?args]]]
@@ -268,7 +268,7 @@
(&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokevirtual"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [?object
@@ -286,7 +286,7 @@
(&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args)
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-invokespecial"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?class]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?class]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ?method]]]]
["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?classes]]]
["lux;Cons" [?object
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 59f3fbb1f..62b99a5b7 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -262,16 +262,12 @@
[["global" [?module ?name]]]
(|do [$def (&&module/find-def ?module ?name)]
(matchv ::M/objects [$def]
- [["lux;MacroD" _macro]]
- (matchv ::M/objects [_macro]
- [["lux;Some" macro]]
- (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))]
- (do (when (= "type`" ?name)
- (prn 'macro-expansion (str ?module ";" ?name) (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))
- (&/flat-map% (partial analyse exo-type) macro-expansion)))
-
- [["lux;None" _]]
- (fail (str "[Analyser Error] Macro has yet to be compiled: " (str ?module ";" ?name))))
+ [["lux;MacroD" macro]]
+ (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))]
+ (do (when (or (= "type`" ?name)
+ (= "deftype" ?name))
+ (prn 'macro-expansion (str ?module ";" ?name) (->> macro-expansion (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))
+ (&/flat-map% (partial analyse exo-type) macro-expansion)))
[_]
(|do [output (analyse-apply* analyse exo-type =fn ?args)]
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index b9a92c120..921417c17 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -70,7 +70,7 @@
(fn [state*]
(return* (&/update$ &/$MODULES
(fn [$modules]
- (&/|put module (&/|put name (&/V "lux;MacroD" (&/V "lux;Some" macro)) $module)
+ (&/|put module (&/|put name (&/V "lux;MacroD" macro) $module)
$modules))
state*)
nil)))
@@ -83,25 +83,3 @@
(fail* (str "[Analyser Error] Definition doesn't have macro type: " module ";" name)))
(fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
(fail* (str "[Analyser Error] Module doesn't exist: " module)))))
-
-(defn install-macro [module name macro]
- (fn [state]
- (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
- (if-let [$def (&/|get name $module)]
- (matchv ::M/objects [$def]
- [["lux;MacroD" ["lux;None" _]]]
- (return* (&/update$ &/$MODULES
- (fn [$modules]
- (&/|put module (&/|put name (&/V "lux;MacroD" (&/V "lux;Some" macro)) $module)
- $modules))
- state)
- nil)
-
- [["lux;MacroD" ["lux;Some" _]]]
- (fail* (str "[Analyser Error] Can't re-install a macro: " (str module &/+name-separator+ name)))
-
- [_]
- (fail* (str "[Analyser Error] Can't install a non-macro: " (str module &/+name-separator+ name))))
- (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
- (fail* (str "[Analyser Error] Module doesn't exist: " module)))
- ))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 26a270199..9d6f72fab 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -79,7 +79,13 @@
(->type-signature ?name)
[["lux;LambdaT" [_ _]]]
- (->type-signature function-class)))
+ (->type-signature function-class)
+
+ [["lux;VariantT" ["lux;Nil" _]]]
+ "V"
+
+ [_]
+ (assert false (prn-str '->java-sig (aget type 0)))))
(defn extract-jvm-param [token]
(matchv ::M/objects [token]
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index 38fe77264..983d94dc9 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -6,6 +6,7 @@
;; [Utils]
(defn ^:private escape-char [escaped]
+ ;; (prn 'escape-char escaped)
(condp = escaped
"\\t" (return "\t")
"\\b" (return "\b")
@@ -17,10 +18,14 @@
;; else
(fail (str "[Lexer Error] Unknown escape character: " escaped))))
-(defn ^:private lex-text-body [_____]
+(defn ^:private lex-text-body [_]
(&/try-all% (&/|list (|do [[_ [_ [prefix escaped]]] (&reader/read-regex2 #"(?s)^([^\"\\]*)(\\.)")
- unescaped (escape-char escaped)
- [_ [_ postfix]] (lex-text-body nil)]
+ ;; :let [_ (prn '[prefix escaped] [prefix escaped])]
+ unescaped (escape-char escaped)
+ ;; :let [_ (prn 'unescaped unescaped)]
+ postfix (lex-text-body nil)
+ ;; :let [_ (prn 'postfix postfix)]
+ ]
(return (str prefix unescaped postfix)))
(|do [[_ [_ body]] (&reader/read-regex #"(?s)^([^\"\\]*)")]
(return body)))))
@@ -37,7 +42,7 @@
[_ [_ comment]] (&reader/read-regex #"^(.*)$")]
(return (&/V "lux;Meta" (&/T meta (&/V "Comment" comment))))))
-(defn ^:private lex-multi-line-comment [___]
+(defn ^:private lex-multi-line-comment [_]
(|do [_ (&reader/read-text "#(")
[meta comment] (&/try-all% (&/|list (|do [[_ [meta comment]] (&reader/read-regex #"(?is)^((?!#\().)*?(?=\)#)")]
(return comment))
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index 2eacdafcc..d163bcae3 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -52,7 +52,7 @@
line* (.substring line match-length)
;; _ (prn 'with-line line*)
]
- (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) [tok1 tok2]))
+ (&/V "Yes" (&/T (&/V "lux;Meta" (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))
(if (empty? line*)
(&/V "lux;None" nil)
(&/V "lux;Some" (&/V "lux;Meta" (&/T (&/T file-name line-num (+ column-num match-length)) line*)))))))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index caa210d2a..766e28a39 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -813,7 +813,7 @@
[["lux;VariantT" ?cases]]
(if-let [case-type (&/|get case ?cases)]
(return case-type)
- (fail (str "[Type Error] Variant lacks case: " case)))
+ (fail (str "[Type Error] Variant lacks case: " case " | " (show-type type))))
[_]
(fail (str "[Type Error] Type is not a variant: " (show-type type)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-16 12:04:20 +0000