aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj75
-rw-r--r--src/lux/analyser/lux.clj77
-rw-r--r--src/lux/compiler.clj4
-rw-r--r--src/lux/compiler/lux.clj9
4 files changed, 84 insertions, 81 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 8fad07dfa..939a3ea0a 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -26,44 +26,45 @@
["lux;Nil" _]]]]]]]]]
(&/T catch+ ?finally-body)))
-(defn ^:private aba1 [analyse eval! exo-type token]
- (matchv ::M/objects [token]
- ;; Standard special forms
- [["lux;Meta" [meta ["lux;Bool" ?value]]]]
- (|do [_ (&type/check exo-type &type/Bool)]
- (return (&/|list (&/T (&/V "bool" ?value) exo-type))))
-
- [["lux;Meta" [meta ["lux;Int" ?value]]]]
- (|do [_ (&type/check exo-type &type/Int)]
- (return (&/|list (&/T (&/V "int" ?value) exo-type))))
-
- [["lux;Meta" [meta ["lux;Real" ?value]]]]
- (|do [_ (&type/check exo-type &type/Real)]
- (return (&/|list (&/T (&/V "real" ?value) exo-type))))
-
- [["lux;Meta" [meta ["lux;Char" ?value]]]]
- (|do [_ (&type/check exo-type &type/Char)]
- (return (&/|list (&/T (&/V "char" ?value) exo-type))))
-
- [["lux;Meta" [meta ["lux;Text" ?value]]]]
- (|do [_ (&type/check exo-type &type/Text)]
- (return (&/|list (&/T (&/V "text" ?value) exo-type))))
-
- [["lux;Meta" [meta ["lux;Tuple" ?elems]]]]
- (&&lux/analyse-tuple analyse exo-type ?elems)
+(let [unit (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list))))]
+ (defn ^:private aba1 [analyse eval! exo-type token]
+ (matchv ::M/objects [token]
+ ;; Standard special forms
+ [["lux;Meta" [meta ["lux;Bool" ?value]]]]
+ (|do [_ (&type/check exo-type &type/Bool)]
+ (return (&/|list (&/T (&/V "bool" ?value) exo-type))))
+
+ [["lux;Meta" [meta ["lux;Int" ?value]]]]
+ (|do [_ (&type/check exo-type &type/Int)]
+ (return (&/|list (&/T (&/V "int" ?value) exo-type))))
+
+ [["lux;Meta" [meta ["lux;Real" ?value]]]]
+ (|do [_ (&type/check exo-type &type/Real)]
+ (return (&/|list (&/T (&/V "real" ?value) exo-type))))
+
+ [["lux;Meta" [meta ["lux;Char" ?value]]]]
+ (|do [_ (&type/check exo-type &type/Char)]
+ (return (&/|list (&/T (&/V "char" ?value) exo-type))))
+
+ [["lux;Meta" [meta ["lux;Text" ?value]]]]
+ (|do [_ (&type/check exo-type &type/Text)]
+ (return (&/|list (&/T (&/V "text" ?value) exo-type))))
+
+ [["lux;Meta" [meta ["lux;Tuple" ?elems]]]]
+ (&&lux/analyse-tuple analyse exo-type ?elems)
+
+ [["lux;Meta" [meta ["lux;Record" ?elems]]]]
+ (&&lux/analyse-record analyse exo-type ?elems)
+
+ [["lux;Meta" [meta ["lux;Tag" ?ident]]]]
+ (&&lux/analyse-variant analyse exo-type ?ident unit)
+
+ [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]]
+ (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null"))))
- [["lux;Meta" [meta ["lux;Record" ?elems]]]]
- (&&lux/analyse-record analyse exo-type ?elems)
-
- [["lux;Meta" [meta ["lux;Tag" ?ident]]]]
- (&&lux/analyse-variant analyse exo-type ?ident (&/V "lux;Meta" (&/T (&/T "" -1 -1) (&/V "lux;Tuple" (|list)))))
-
- [["lux;Meta" [meta ["lux;Symbol" [_ "jvm-null"]]]]]
- (return (&/|list (&/T (&/V "jvm-null" nil) (&/V "lux;DataT" "null"))))
-
- [_]
- (fail "")
- ))
+ [_]
+ (fail "")
+ )))
(defn ^:private aba2 [analyse eval! exo-type token]
(matchv ::M/objects [token]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index df87a08b6..e4237d8dd 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -172,42 +172,39 @@
)))
))
-(defn ^:private analyse-apply* [analyse exo-type =fn ?args]
- (matchv ::M/objects [=fn]
- [[?fun-expr ?fun-type]]
- (matchv ::M/objects [?args]
- [["lux;Nil" _]]
- (|do [_ (&type/check exo-type ?fun-type)]
- (return =fn))
-
- [["lux;Cons" [?arg ?args*]]]
- (|do [?fun-type* (&type/actual-type ?fun-type)]
- (matchv ::M/objects [?fun-type*]
- [["lux;AllT" _]]
- (&type/with-var
- (fn [$var]
- (|do [type* (&type/apply-type ?fun-type* $var)
- output (analyse-apply* analyse exo-type (&/T ?fun-expr type*) ?args)]
- (matchv ::M/objects [output $var]
- [[?expr* ?type*] ["lux;VarT" ?id]]
- (|do [? (&type/bound? ?id)
- _ (if ?
- (return nil)
- (|do [ex &type/existential]
- (&type/set-var ?id ex)))
- type** (&type/clean $var ?type*)]
- (return (&/T ?expr* type**)))
- ))))
-
- [["lux;LambdaT" [?input-t ?output-t]]]
- (|do [=arg (&&/analyse-1 analyse ?input-t ?arg)]
- (analyse-apply* analyse exo-type (&/T (&/V "apply" (&/T =fn =arg))
- ?output-t)
- ?args*))
+(defn ^:private analyse-apply* [analyse exo-type fun-type args]
+ (matchv ::M/objects [args]
+ [["lux;Nil" _]]
+ (|do [_ (&type/check exo-type fun-type)]
+ (return (&/T (&/|list) fun-type)))
+
+ [["lux;Cons" [?arg ?args*]]]
+ (|do [?fun-type* (&type/actual-type fun-type)]
+ (matchv ::M/objects [?fun-type*]
+ [["lux;AllT" _]]
+ (&type/with-var
+ (fn [$var]
+ (|do [type* (&type/apply-type ?fun-type* $var)
+ [?args** ?type**] (analyse-apply* analyse exo-type type* args)]
+ (matchv ::M/objects [$var]
+ [["lux;VarT" ?id]]
+ (|do [? (&type/bound? ?id)
+ _ (if ?
+ (return nil)
+ (|do [ex &type/existential]
+ (&type/set-var ?id ex)))
+ type*** (&type/clean $var ?type**)]
+ (return (&/T ?args** type***)))
+ ))))
+
+ [["lux;LambdaT" [?input-t ?output-t]]]
+ (|do [[=args ?output-t*] (analyse-apply* analyse exo-type ?output-t ?args*)
+ =arg (&&/analyse-1 analyse ?input-t ?arg)]
+ (return (&/T (&/|cons =arg =args) ?output-t*)))
- [_]
- (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
- )))
+ [_]
+ (fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
+ ))
(defn analyse-apply [analyse exo-type =fn ?args]
(|do [loader &/loader]
@@ -222,12 +219,14 @@
(&/flat-map% (partial analyse exo-type) macro-expansion))
[_]
- (|do [output (analyse-apply* analyse exo-type =fn ?args)]
- (return (&/|list output)))))
+ (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)]
+ (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
+ =app-type))))))
[_]
- (|do [output (analyse-apply* analyse exo-type =fn ?args)]
- (return (&/|list output))))
+ (|do [[=args =app-type] (analyse-apply* analyse exo-type =fn-type ?args)]
+ (return (&/|list (&/T (&/V "apply" (&/T =fn =args))
+ =app-type)))))
)))
(defn analyse-case [analyse exo-type ?value ?branches]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 40bb3a710..6739c5529 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -60,8 +60,8 @@
[["lux;Global" [?owner-class ?name]]]
(&&lux/compile-global compile-expression ?type ?owner-class ?name)
- [["apply" [?fn ?arg]]]
- (&&lux/compile-apply compile-expression ?type ?fn ?arg)
+ [["apply" [?fn ?args]]]
+ (&&lux/compile-apply compile-expression ?type ?fn ?args)
[["variant" [?tag ?members]]]
(&&lux/compile-variant compile-expression ?type ?tag ?members)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index cf4a65f04..2c5073a4d 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -117,11 +117,14 @@
:let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (&host/->class (&host/location (&/|list ?owner-class ?name))) "_datum" "Ljava/lang/Object;")]]
(return nil)))
-(defn compile-apply [compile *type* ?fn ?arg]
+(defn compile-apply [compile *type* ?fn ?args]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?fn)
- _ (compile ?arg)
- :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]]
+ _ (&/map% (fn [?arg]
+ (|do [_ (compile ?arg)
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "lux/Function" "apply" &&/apply-signature)]]
+ (return nil)))
+ ?args)]
(return nil)))
(defn compile-def [compile ?name ?body ?def-data]
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 03:18:58 +0000