aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj103
-rw-r--r--src/lux/analyser/case.clj17
-rw-r--r--src/lux/analyser/lux.clj39
-rw-r--r--src/lux/base.clj30
-rw-r--r--src/lux/compiler/io.clj2
-rw-r--r--src/lux/type.clj4
6 files changed, 121 insertions, 74 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index de7fc8497..f10f6b913 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -446,45 +446,44 @@
[_]
(aba3 analyse eval! compile-module exo-type token)))
-(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list))))]
- (defn ^:private aba1 [analyse eval! compile-module exo-type token]
- (matchv ::M/objects [token]
- ;; Standard special forms
- [["lux;BoolS" ?value]]
- (|do [_ (&type/check exo-type &type/Bool)]
- (return (&/|list (&/T (&/V "bool" ?value) exo-type))))
+(defn ^:private aba1 [analyse eval! compile-module exo-type token]
+ (matchv ::M/objects [token]
+ ;; Standard special forms
+ [["lux;BoolS" ?value]]
+ (|do [_ (&type/check exo-type &type/Bool)]
+ (return (&/|list (&/T (&/V "bool" ?value) exo-type))))
- [["lux;IntS" ?value]]
- (|do [_ (&type/check exo-type &type/Int)]
- (return (&/|list (&/T (&/V "int" ?value) exo-type))))
+ [["lux;IntS" ?value]]
+ (|do [_ (&type/check exo-type &type/Int)]
+ (return (&/|list (&/T (&/V "int" ?value) exo-type))))
- [["lux;RealS" ?value]]
- (|do [_ (&type/check exo-type &type/Real)]
- (return (&/|list (&/T (&/V "real" ?value) exo-type))))
+ [["lux;RealS" ?value]]
+ (|do [_ (&type/check exo-type &type/Real)]
+ (return (&/|list (&/T (&/V "real" ?value) exo-type))))
- [["lux;CharS" ?value]]
- (|do [_ (&type/check exo-type &type/Char)]
- (return (&/|list (&/T (&/V "char" ?value) exo-type))))
+ [["lux;CharS" ?value]]
+ (|do [_ (&type/check exo-type &type/Char)]
+ (return (&/|list (&/T (&/V "char" ?value) exo-type))))
- [["lux;TextS" ?value]]
- (|do [_ (&type/check exo-type &type/Text)]
- (return (&/|list (&/T (&/V "text" ?value) exo-type))))
+ [["lux;TextS" ?value]]
+ (|do [_ (&type/check exo-type &type/Text)]
+ (return (&/|list (&/T (&/V "text" ?value) exo-type))))
- [["lux;TupleS" ?elems]]
- (&&lux/analyse-tuple analyse exo-type ?elems)
+ [["lux;TupleS" ?elems]]
+ (&&lux/analyse-tuple analyse exo-type ?elems)
- [["lux;RecordS" ?elems]]
- (&&lux/analyse-record analyse exo-type ?elems)
+ [["lux;RecordS" ?elems]]
+ (&&lux/analyse-record analyse exo-type ?elems)
- [["lux;TagS" ?ident]]
- (&&lux/analyse-variant analyse exo-type ?ident unit)
-
- [["lux;SymbolS" [_ "_jvm_null"]]]
- (&&host/analyse-jvm-null analyse exo-type)
+ [["lux;TagS" ?ident]]
+ (&&lux/analyse-variant analyse exo-type ?ident (&/|list))
+
+ [["lux;SymbolS" [_ "_jvm_null"]]]
+ (&&host/analyse-jvm-null analyse exo-type)
- [_]
- (aba2 analyse eval! compile-module exo-type token)
- )))
+ [_]
+ (aba2 analyse eval! compile-module exo-type token)
+ ))
(defn ^:private add-loc [meta ^String msg]
(if (.startsWith msg "@")
@@ -512,10 +511,10 @@
;; (assert false (aget token 0))
))
-(defn ^:private just-analyse [analyse-ast eval! compile-module syntax]
+(defn ^:private just-analyse [analyser syntax]
(&type/with-var
(fn [?var]
- (|do [[?output-term ?output-type] (&&/analyse-1 (partial analyse-ast eval! compile-module) ?var syntax)]
+ (|do [[?output-term ?output-type] (&&/analyse-1 analyser ?var syntax)]
(matchv ::M/objects [?var ?output-type]
[["lux;VarT" ?e-id] ["lux;VarT" ?a-id]]
(if (= ?e-id ?a-id)
@@ -528,25 +527,25 @@
))))
(defn ^:private analyse-ast [eval! compile-module exo-type token]
- (matchv ::M/objects [token]
- [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]] ?values]]]]]]
- (do (assert (.equals ^Object (&/|length ?values) 1) "[Analyser Error] Can only tag 1 value.")
- (&&lux/analyse-variant (partial analyse-ast eval! compile-module) exo-type ?ident (&/|head ?values)))
-
- [["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]]
- (fn [state]
- (matchv ::M/objects [((just-analyse analyse-ast eval! compile-module ?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) exo-type meta =fn ?args) state*))
-
- [_]
- ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state)))
-
- [_]
- (analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module 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) 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) ?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) exo-type meta =fn ?args) state*))
+
+ [_]
+ ((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state)))
+
+ [_]
+ (analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token))))
;; [Resources]
(defn analyse [eval! compile-module]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index ebbb6911a..77f8c418c 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -16,6 +16,9 @@
[env :as &env])))
;; [Utils]
+(def ^:private unit
+ (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" (&/|list)))))
+
(defn ^:private resolve-type [type]
(matchv ::M/objects [type]
[["lux;VarT" ?id]]
@@ -198,19 +201,19 @@
(|do [=tag (&&/resolved-ident ?ident)
value-type* (adjust-type value-type)
case-type (&type/variant-case =tag value-type*)
- [=test =kont] (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1)
- (&/V "lux;TupleS" (&/|list))))
- kont)]
+ [=test =kont] (analyse-pattern case-type unit kont)]
(return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont)))
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TagS" ?ident]]]
- ["lux;Cons" [?value
- ["lux;Nil" _]]]]]]]
+ ?values]]]]
(|do [=tag (&&/resolved-ident ?ident)
value-type* (adjust-type value-type)
case-type (&type/variant-case =tag value-type*)
- [=test =kont] (analyse-pattern case-type ?value
- kont)]
+ [=test =kont] (case (&/|length ?values)
+ 0 (analyse-pattern case-type unit kont)
+ 1 (analyse-pattern case-type (&/|head ?values) kont)
+ ;; 1+
+ (analyse-pattern case-type (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;TupleS" ?values))) kont))]
(return (&/T (&/V "VariantTestAC" (&/T =tag =test)) =kont)))
)))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 065e150d9..4fb9d1533 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -55,7 +55,25 @@
[_]
(fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*))))))
-(defn analyse-variant [analyse exo-type ident ?value]
+(defn ^:private analyse-variant-body [analyse exo-type ?values]
+ (|do [output (matchv ::M/objects [?values]
+ [["lux;Nil" _]]
+ (analyse-tuple analyse exo-type (&/|list))
+
+ [["lux;Cons" [?value ["lux;Nil" _]]]]
+ (analyse exo-type ?value)
+
+ [_]
+ (analyse-tuple analyse exo-type ?values)
+ )]
+ (matchv ::M/objects [output]
+ [["lux;Cons" [x ["lux;Nil" _]]]]
+ (return x)
+
+ [_]
+ (fail "[Analyser Error] Can't expand to other than 1 element."))))
+
+(defn analyse-variant [analyse exo-type ident ?values]
(|do [exo-type* (matchv ::M/objects [exo-type]
[["lux;VarT" ?id]]
(&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
@@ -69,7 +87,7 @@
[["lux;VariantT" ?cases]]
(|do [?tag (&&/resolved-ident ident)]
(if-let [vtype (&/|get ?tag ?cases)]
- (|do [=value (&&/analyse-1 analyse vtype ?value)]
+ (|do [=value (analyse-variant-body analyse vtype ?values)]
(return (&/|list (&/T (&/V "variant" (&/T ?tag =value))
exo-type))))
(fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*)))))
@@ -78,7 +96,7 @@
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)]
- (analyse-variant analyse exo-type** ident ?value))))
+ (analyse-variant analyse exo-type** ident ?values))))
[_]
(fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*))))))
@@ -108,6 +126,8 @@
(fail (str "[Analyser Error] The type of a record must be a record type:\n"
(&type/show-type exo-type*)
"\n")))
+ _ (&/assert! (= (&/|length types) (&/|length ?elems))
+ (str "[Analyser Error] Record length mismatch. Expected: " (&/|length types) "; actual: " (&/|length ?elems)))
=slots (&/map% (fn [kv]
(matchv ::M/objects [kv]
[[["lux;Meta" [_ ["lux;TagS" ?ident]]] ?value]]
@@ -258,14 +278,17 @@
(|do [[[r-module r-name] $def] (&&module/find-def ?module ?name)]
(matchv ::M/objects [$def]
[["lux;MacroD" macro]]
- (|do [macro-expansion #(-> macro (.apply ?args) (.apply %))
+ (|do [;; :let [_ (prn 'MACRO-EXPAND|PRE (str r-module ";" r-name))]
+ macro-expansion #(-> macro (.apply ?args) (.apply %))
+ ;; :let [_ (prn 'MACRO-EXPAND|POST (str r-module ";" r-name))]
:let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
- ;; :let [_ (when (and ;; (= "lux/control/monad" ?module)
- ;; (= "case" ?name))
+ ;; :let [_ (when (or (= "loop" r-name)
+ ;; ;; (= "struct" r-name)
+ ;; )
;; (->> (&/|map &/show-ast macro-expansion*)
;; (&/|interpose "\n")
;; (&/fold str "")
- ;; (prn ?module "case")))]
+ ;; (prn (str r-module ";" r-name))))]
]
(&/flat-map% (partial analyse exo-type) macro-expansion*))
@@ -356,6 +379,8 @@
(defn analyse-def [analyse ?name ?value]
;; (prn 'analyse-def/BEGIN ?name)
+ ;; (when (= "PList/Dict" ?name)
+ ;; (prn 'DEF ?name (&/show-ast ?value)))
(|do [module-name &/get-module-name
? (&&module/defined? module-name ?name)]
(if ?
diff --git a/src/lux/base.clj b/src/lux/base.clj
index eb94c2c90..ef3c81041 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -11,6 +11,9 @@
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array))
+;; [Tags]
+(def $Cons "lux;Cons")
+
;; [Fields]
;; Binding
(def $COUNTER 0)
@@ -27,14 +30,15 @@
(def $LOADER 1)
(def $WRITER 2)
-;; CompilerState
+;; Compiler
(def $ENVS 0)
(def $EVAL? 1)
-(def $HOST 2)
-(def $MODULES 3)
-(def $SEED 4)
-(def $SOURCE 5)
-(def $TYPES 6)
+(def $EXPECTED 2)
+(def $HOST 3)
+(def $MODULES 4)
+(def $SEED 5)
+(def $SOURCE 6)
+(def $TYPES 7)
;; [Exports]
(def +name-separator+ ";")
@@ -487,6 +491,8 @@
(|list)
;; "lux;eval?"
false
+ ;; "lux;expected"
+ (V "lux;VariantT" (|list))
;; "lux;host"
(host nil)
;; "lux;modules"
@@ -610,6 +616,18 @@
[_]
output))))
+(defn with-expected-type [type body]
+ "(All [a] (-> Type (Lux a)))"
+ (fn [state]
+ (let [output (body (set$ $EXPECTED type state))]
+ (matchv ::M/objects [output]
+ [["lux;Right" [?state ?value]]]
+ (return* (set$ $EXPECTED (get$ $EXPECTED state) ?state)
+ ?value)
+
+ [_]
+ output))))
+
(defn show-ast [ast]
(matchv ::M/objects [ast]
[["lux;Meta" [_ ["lux;BoolS" ?value]]]]
diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj
index 176b4340d..0e7982a7f 100644
--- a/src/lux/compiler/io.clj
+++ b/src/lux/compiler/io.clj
@@ -11,7 +11,7 @@
))
;; [Resources]
-(defn read-file [path]
+(defn read-file [^String path]
(let [file (new java.io.File path)]
(if (.exists file)
(return (slurp file))
diff --git a/src/lux/type.clj b/src/lux/type.clj
index f5b8d3f25..e3255ac5c 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -177,7 +177,9 @@
(&/T "lux;types" (&/V "lux;AppT" (&/T (&/V "lux;AppT" (&/T Bindings Int)) Type)))
(&/T "lux;host" HostState)
(&/T "lux;seed" Int)
- (&/T "lux;eval?" Bool))))
+ (&/T "lux;eval?" Bool)
+ (&/T "lux;expected" Type)
+ )))
$Void)))
(def Macro
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 02:43:15 +0000