diff options
| -rw-r--r-- | source/lux.lux | 36 | ||||
| -rw-r--r-- | source/lux/meta/lux.lux | 9 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 43 | ||||
| -rw-r--r-- | src/lux/base.clj | 35 | ||||
| -rw-r--r-- | src/lux/type.clj | 1 |
5 files changed, 79 insertions, 45 deletions
diff --git a/source/lux.lux b/source/lux.lux index ced208d40..36a0997f4 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -270,7 +270,8 @@ ## #host HostState ## #seed Int ## #eval? Bool -## #expected Type)) +## #expected Type +## #cursor Cursor)) (_lux_def Compiler (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" "" (#RecordT (#Cons [["lux;source" Reader] @@ -284,7 +285,8 @@ (#Cons [["lux;seed" Int] (#Cons [["lux;eval?" Bool] (#Cons [["lux;expected" Type] - #Nil])])])])])])])]))]) + (#Cons [["lux;cursor" Cursor] + #Nil])])])])])])])])]))]) Void])) (_lux_export Compiler) @@ -1316,7 +1318,8 @@ (_lux_case state {#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} + #seed seed #eval? eval? #expected expected + #cursor cursor} (_lux_case (reverse envs) #Nil (#Left "Can't get the module name without a module!") @@ -1355,7 +1358,8 @@ (_lux_case state {#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} + #seed seed #eval? eval? #expected expected + #cursor cursor} (#Right [state (find-macro' modules current-module module name)])))))) (def''' (list:join xs) @@ -1912,10 +1916,12 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} + #seed seed #eval? eval? #expected expected + #cursor cursor} (#Right {#source source #modules modules #envs envs #types types #host host - #seed (i+ 1 seed) #eval? eval? #expected expected} + #seed (i+ 1 seed) #eval? eval? #expected expected + #cursor cursor} (symbol$ ["__gensym__" (->text seed)])))) (defmacro #export (sig tokens) @@ -2187,7 +2193,8 @@ (lambda [state] (let [{#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} state] + #seed seed #eval? eval? #expected expected + #cursor cursor} state] (#Right state expected)))) (defmacro #export (struct tokens) @@ -2403,7 +2410,8 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} + #seed seed #eval? eval? #expected expected + #cursor cursor} (case (get module modules) (#Some =module) (#Right state true) @@ -2417,7 +2425,8 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} + #seed seed #eval? eval? #expected expected + #cursor cursor} (case (get module modules) (#Some =module) (let [to-alias (map (: (-> (, Text (, Bool (DefData' (-> (List AST) (StateE Compiler (List AST)))))) @@ -2600,7 +2609,8 @@ (case state {#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} + #seed seed #eval? eval? #expected expected + #cursor cursor} (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type)) (lambda [env] (case env @@ -2634,7 +2644,8 @@ (let [[v-prefix v-name] name {#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} state] + #seed seed #eval? eval? #expected expected + #cursor cursor} state] (case (get v-prefix modules) #None #None @@ -2686,7 +2697,8 @@ _ (let [{#source source #modules modules #envs envs #types types #host host - #seed seed #eval? eval? #expected expected} state] + #seed seed #eval? eval? #expected expected + #cursor cursor} state] (#Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs))))))))) (def (use-field field-name type) diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux index 26513ed81..4d6c15bde 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -255,7 +255,8 @@ (case state {#;source source #;modules modules #;envs envs #;types types #;host host - #;seed seed #;eval? eval? #;expected expected} + #;seed seed #;eval? eval? #;expected expected + #;cursor cursor} (some (: (-> (Env Text (, LuxVar Type)) (Maybe Type)) (lambda [env] (case env @@ -275,7 +276,8 @@ (let [[v-prefix v-name] name {#;source source #;modules modules #;envs envs #;types types #;host host - #;seed seed #;eval? eval? #;expected expected} state] + #;seed seed #;eval? eval? #;expected expected + #;cursor cursor} state] (case (get v-prefix modules) #;None #;None @@ -310,6 +312,7 @@ _ (let [{#;source source #;modules modules #;envs envs #;types types #;host host - #;seed seed #;eval? eval? #;expected expected} state] + #;seed seed #;eval? eval? #;expected expected + #;cursor cursor} state] (#;Left ($ text:++ "Unknown var: " (ident->text name) "\n\n" (show-envs envs)))))))) )) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 774188d82..d18c2cfcf 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -501,10 +501,10 @@ (return* state* output) [["lux;Left" ""]] - (fail* (add-loc meta (str "[Analyser Error] Unrecognized token: " (&/show-ast token)))) + (fail* (add-loc (&/get$ &/$cursor state) (str "[Analyser Error] Unrecognized token: " (&/show-ast token)))) [["lux;Left" msg]] - (fail* (add-loc meta msg)) + (fail* (add-loc (&/get$ &/$cursor state) msg)) )) ;; [_] @@ -527,25 +527,26 @@ )))) (defn ^:private analyse-ast [eval! compile-module compile-token exo-type token] - (&/with-expected-type exo-type - (matchv ::M/objects [token] - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] - (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values) - - [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] - (fn [state] - (matchv ::M/objects [((just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn) state) - ;; ((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state) - ] - [["lux;Right" [state* =fn]]] - (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0)) - ((&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-token) exo-type meta =fn ?args) state*)) - - [_] - ((analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token) state))) - - [_] - (analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token)))) + (&/with-cursor (aget token 1 0) + (&/with-expected-type exo-type + (matchv ::M/objects [token] + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]] + (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values) + + [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]] + (fn [state] + (matchv ::M/objects [((just-analyse (partial analyse-ast eval! compile-module compile-token) ?fn) state) + ;; ((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?fn)) state) + ] + [["lux;Right" [state* =fn]]] + (do ;; (prn 'GOT_FUN (&/show-ast ?fn) (&/show-ast token) (aget =fn 0 0) (aget =fn 1 0)) + ((&&lux/analyse-apply (partial analyse-ast eval! compile-module compile-token) exo-type meta =fn ?args) state*)) + + [_] + ((analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token) state))) + + [_] + (analyse-basic-ast (partial analyse-ast eval! compile-module compile-token) eval! compile-module compile-token exo-type token))))) ;; [Resources] (defn analyse [eval! compile-module compile-token] diff --git a/src/lux/base.clj b/src/lux/base.clj index ef3c81041..85e8df4d1 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -31,14 +31,15 @@ (def $WRITER 2) ;; Compiler -(def $ENVS 0) -(def $EVAL? 1) -(def $EXPECTED 2) -(def $HOST 3) -(def $MODULES 4) -(def $SEED 5) -(def $SOURCE 6) -(def $TYPES 7) +(def $cursor 0) +(def $ENVS 1) +(def $EVAL? 2) +(def $EXPECTED 3) +(def $HOST 4) +(def $MODULES 5) +(def $SEED 6) +(def $SOURCE 7) +(def $TYPES 8) ;; [Exports] (def +name-separator+ ";") @@ -487,7 +488,9 @@ (V "lux;None" nil)))) (defn init-state [_] - (R ;; "lux;envs" + (R ;; "lux;cursor" + (T "" -1 -1) + ;; "lux;envs" (|list) ;; "lux;eval?" false @@ -628,6 +631,20 @@ [_] output)))) +(defn with-cursor [cursor body] + "(All [a] (-> Cursor (Lux a)))" + (if (= "" (aget cursor 0)) + body + (fn [state] + (let [output (body (set$ $cursor cursor state))] + (matchv ::M/objects [output] + [["lux;Right" [?state ?value]]] + (return* (set$ $cursor (get$ $cursor state) ?state) + ?value) + + [_] + output))))) + (defn show-ast [ast] (matchv ::M/objects [ast] [["lux;Meta" [_ ["lux;BoolS" ?value]]]] diff --git a/src/lux/type.clj b/src/lux/type.clj index 18f618b43..e4117492c 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -179,6 +179,7 @@ (&/T "lux;seed" Int) (&/T "lux;eval?" Bool) (&/T "lux;expected" Type) + (&/T "lux;cursor" Cursor) ))) $Void))) |