aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/lux.clj16
-rw-r--r--src/lux/base.clj12
-rw-r--r--src/lux/compiler.clj3
-rw-r--r--src/lux/compiler/lux.clj4
-rw-r--r--src/lux/type.clj73
5 files changed, 74 insertions, 34 deletions
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 7c9b9b5f0..191a16235 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -320,7 +320,17 @@
(|do [? (&type/bound? ?id)]
(if ?
(|do [dtype (&type/deref ?id)]
- (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype))))
+ (matchv ::M/objects [dtype]
+ [["lux;BoundT" _]]
+ (matchv ::M/objects [output]
+ [["Expression" [_expr _]]]
+ ;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))]
+ ;; (return (&/V "Expression" (&/T _expr exo-type))))
+ (return (&/V "Expression" (&/T _expr exo-type)))
+ )
+
+ [_]
+ (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))))
(matchv ::M/objects [output]
[["Expression" [_expr _]]]
;; (|do [_ (&type/set-var ?id (&/V "lux;BoundT" _arg))]
@@ -388,6 +398,10 @@
_ (&&module/declare-macro module-name ?name)]
(return (&/|list))))
+(defn analyse-declare-macro [analyse ?name]
+ (|do [module-name &/get-module-name]
+ (return (&/|list (&/V "Statement" (&/V "declare-macro" (&/T module-name ?name)))))))
+
(defn analyse-import [analyse exo-type ?path]
(return (&/|list)))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 4f3e6f028..306c09b19 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -24,8 +24,9 @@
(def $HOST 1)
(def $MODULE-ALIASES 2)
(def $MODULES 3)
-(def $SOURCE 4)
-(def $TYPES 5)
+(def $SEED 4)
+(def $SOURCE 5)
+(def $TYPES 6)
;; [Exports]
(def +name-separator+ ";")
@@ -555,6 +556,8 @@
(|table)
;; "lux;modules"
(|table)
+ ;; "lux;seed"
+ 0
;; "lux;source"
(V "lux;None" nil)
;; "lux;types"
@@ -593,6 +596,11 @@
(catch Throwable _
(fail* "No local environment.")))))
+(def gen-id
+ (fn [state]
+ (let [seed (get$ $SEED state)]
+ (return* (set$ $SEED (inc seed) state) seed))))
+
(defn ->seq [xs]
(matchv ::M/objects [xs]
[["lux;Nil" _]]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 6a9cc58c6..e6879f4da 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -317,6 +317,9 @@
(matchv ::M/objects [?form]
[["def" [?name ?body ?def-data]]]
(&&lux/compile-def compile-expression ?name ?body ?def-data)
+
+ [["declare-macro" [?module ?name]]]
+ (&&lux/compile-declare-macro compile-expression ?module ?name)
[["jvm-interface" [?package ?name ?methods]]]
(&&host/compile-jvm-interface compile-expression ?package ?name ?methods)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 1553d3975..35a706f05 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -165,3 +165,7 @@
;; :let [_ (prn 'compile-def/_2 ?name)]
]
(return nil)))
+
+(defn compile-declare-macro [compile module name]
+ (|do [_ (&a-module/declare-macro module name)]
+ (return nil)))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 217a167a4..b739be3c2 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -150,7 +150,8 @@
(&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Env Text))
$Void)))))
(&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
- (&/T "lux;host" HostState))))
+ (&/T "lux;host" HostState)
+ (&/T "lux;seed" Int))))
$Void)))
(def Macro
@@ -212,37 +213,42 @@
(declare clean*)
(defn ^:private delete-var [id]
- (fn [state]
- (&/run-state (|do [mappings* (&/map% (fn [binding]
- (|let [[?id ?type] binding]
- (if (= id ?id)
- (return binding)
- (matchv ::M/objects [?type]
- [["lux;None" _]]
+ (|do [? (bound? id)
+ _ (if ?
+ (return nil)
+ (|do [seed &/gen-id]
+ (set-var id (&/V "lux;BoundT" (str seed)))))]
+ (fn [state]
+ (&/run-state (|do [mappings* (&/map% (fn [binding]
+ (|let [[?id ?type] binding]
+ (if (= id ?id)
(return binding)
-
- [["lux;Some" ?type*]]
- (matchv ::M/objects [?type*]
- [["lux;VarT" ?id*]]
- (if (= id ?id*)
- (return (&/T ?id (&/V "lux;None" nil)))
- (return binding)
- ;; (|do [?type** (clean* id ?type*)]
- ;; (return (&/T ?id (&/V "lux;Some" ?type**))))
- )
-
- [_]
- (|do [?type** (clean* id ?type*)]
- (return (&/T ?id (&/V "lux;Some" ?type**)))))
- ))))
- (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
- (fn [state]
- (return* (&/update$ &/$TYPES #(->> %
- (&/update$ &/$COUNTER dec)
- (&/set$ &/$MAPPINGS (&/|remove id mappings*)))
- state)
- nil)))
- state)))
+ (matchv ::M/objects [?type]
+ [["lux;None" _]]
+ (return binding)
+
+ [["lux;Some" ?type*]]
+ (matchv ::M/objects [?type*]
+ [["lux;VarT" ?id*]]
+ (if (= id ?id*)
+ (return (&/T ?id (&/V "lux;None" nil)))
+ (return binding)
+ ;; (|do [?type** (clean* id ?type*)]
+ ;; (return (&/T ?id (&/V "lux;Some" ?type**))))
+ )
+
+ [_]
+ (|do [?type** (clean* id ?type*)]
+ (return (&/T ?id (&/V "lux;Some" ?type**)))))
+ ))))
+ (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS)))]
+ (fn [state]
+ (return* (&/update$ &/$TYPES #(->> %
+ (&/update$ &/$COUNTER dec)
+ (&/set$ &/$MAPPINGS (&/|remove id mappings*)))
+ state)
+ nil)))
+ state))))
(defn with-var [k]
(|do [id create-var
@@ -749,6 +755,11 @@
(return (&/T fixpoints* nil)))
(fail "[Type Error] Records don't match in size."))
+ [["lux;BoundT" e!name] ["lux;BoundT" a!name]]
+ (if (= e!name a!name)
+ (return (&/T fixpoints nil))
+ (check-error expected actual))
+
[_ _]
(fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual)))
))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 10:11:24 +0000