aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--source/lux.lux36
-rw-r--r--source/lux/meta/lux.lux9
-rw-r--r--src/lux/analyser.clj43
-rw-r--r--src/lux/base.clj35
-rw-r--r--src/lux/type.clj1
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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:01:00 +0000