From 6d803df4bdb4a68bba80cbbc4eeed02170813e96 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 May 2015 08:54:50 -0400 Subject: - The type syntax is finally complete ^_^ - Finally, the "case" macro has been implemented ^_^ - The macro-expand function is also alive! - Corrected the field-access special forms so they take their field as a symbol instead of text. - Macros are no longer stored inside the CompilerState as (Maybe Macro), but as Macro. - Void is implemented as - Fixed an error when parsing escaped characters in text. - Fixed an error in the reader in which parsing regex2 gave back a 2-vector instead of a 2-tuple. --- source/lux.lux | 292 +++++++++++++++++++++++++++----------------- src/lux/analyser.clj | 22 ++-- src/lux/analyser/lux.clj | 16 +-- src/lux/analyser/module.clj | 24 +--- src/lux/host.clj | 8 +- src/lux/lexer.clj | 13 +- src/lux/reader.clj | 2 +- src/lux/type.clj | 2 +- 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 [ ] - [(def #export ( x y) + [(def__ #export ( x y) (-> Bool) ( x y))] @@ -1140,7 +1140,7 @@ ) (do-template [ ] - [(def #export ( x y) + [(def__ #export ( x y) (-> ) ( 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))))) -- cgit v1.2.3