aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj32
-rw-r--r--src/lux/analyser/case.clj11
-rw-r--r--src/lux/analyser/env.clj16
-rw-r--r--src/lux/analyser/host.clj9
-rw-r--r--src/lux/analyser/lux.clj109
-rw-r--r--src/lux/analyser/module.clj79
-rw-r--r--src/lux/base.clj14
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/compiler/host.clj27
-rw-r--r--src/lux/compiler/lux.clj13
-rw-r--r--src/lux/lexer.clj20
-rw-r--r--src/lux/type.clj37
12 files changed, 247 insertions, 122 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 039db810a..8c8be29d2 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -115,6 +115,12 @@
["lux;Nil" _]]]]]]]
(&&lux/analyse-export analyse ?ident)
+ [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_alias"]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?alias]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?module]]]
+ ["lux;Nil" _]]]]]]]]]
+ (&&lux/analyse-alias analyse ?alias ?module)
+
[_]
(fail "")))
@@ -447,7 +453,7 @@
;; Programs
[["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_program"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?args]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ?args]]]
["lux;Cons" [?body
["lux;Nil" _]]]]]]]]]
(&&host/analyse-jvm-program analyse ?args ?body)
@@ -500,6 +506,9 @@
[["lux;Right" [state* output]]]
(return* state* output)
+ [["lux;Left" ""]]
+ (fail* (add-loc meta (str "[Analyser Error] Unrecognized token: " (&/show-ast token))))
+
[["lux;Left" msg]]
(fail* (add-loc meta msg)))
@@ -522,6 +531,21 @@
(fail* (add-loc meta msg))
))))
+(defn ^:private just-analyse [analyse-ast eval! compile-module syntax]
+ (&type/with-var
+ (fn [?var]
+ (|do [[?output-term ?output-type] (&&/analyse-1 (partial analyse-ast eval! compile-module) ?var syntax)]
+ (matchv ::M/objects [?var ?output-type]
+ [["lux;VarT" ?e-id] ["lux;VarT" ?a-id]]
+ (if (= ?e-id ?a-id)
+ (|do [?output-type* (&type/deref ?e-id)]
+ (return (&/T ?output-term ?output-type*)))
+ (return (&/T ?output-term ?output-type)))
+
+ [_ _]
+ (return (&/T ?output-term ?output-type)))
+ ))))
+
(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]]]]]]
@@ -530,10 +554,12 @@
[["lux;Meta" [meta ["lux;FormS" ["lux;Cons" [?fn ?args]]]]]]
(fn [state]
- (matchv ::M/objects [((&type/with-var #(&&/analyse-1 (partial analyse-ast eval! compile-module) % ?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 =fn ?args) state*))
+ ((&&lux/analyse-apply (partial analyse-ast eval! compile-module) exo-type =fn ?args) state*))
[_]
((analyse-basic-ast (partial analyse-ast eval! compile-module) eval! compile-module exo-type token) state)))
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 43e5ee5e7..6efe7fd5f 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -15,6 +15,15 @@
(fail "##9##")))]
(resolve-type type*))
+ [["lux;AllT" ?id]]
+ (|do [$var &type/existential
+ =type (&type/apply-type type $var)]
+ (&type/actual-type =type))
+ ;; (&type/with-var
+ ;; (fn [$var]
+ ;; (|do [=type (&type/apply-type type $var)]
+ ;; (&type/actual-type =type))))
+
[_]
(&type/actual-type type)))
@@ -68,7 +77,7 @@
(return (&/T (&/V "TupleTestAC" =tests) =kont))))
[_]
- (fail "[Analyser Error] Tuple requires tuple-type."))
+ (fail "[Analyser Error] Tuples require tuple-type."))
[["lux;RecordS" ?slots]]
(|do [value-type* (resolve-type value-type)]
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index fa7b9aa1a..de6bdb036 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -16,18 +16,20 @@
=return (body (&/update$ &/$ENVS
(fn [stack]
(let [bound-unit (&/V "lux;Local" (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))]
- (&/|cons (->> (&/|head stack)
- (&/update$ &/$LOCALS #(&/update$ &/$COUNTER inc %))
- (&/update$ &/$LOCALS #(&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m)) %)))
+ (&/|cons (&/update$ &/$LOCALS #(->> %
+ (&/update$ &/$COUNTER inc)
+ (&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m))))
+ (&/|head stack))
(&/|tail stack))))
state))]
(matchv ::M/objects [=return]
[["lux;Right" [?state ?value]]]
(return* (&/update$ &/$ENVS (fn [stack*]
- (&/|cons (->> (&/|head stack*)
- (&/update$ &/$LOCALS #(&/update$ &/$COUNTER dec %))
- (&/update$ &/$LOCALS #(&/set$ &/$MAPPINGS old-mappings %)))
- (&/|tail stack*)))
+ (&/|cons (&/update$ &/$LOCALS #(->> %
+ (&/update$ &/$COUNTER dec)
+ (&/set$ &/$MAPPINGS old-mappings))
+ (&/|head stack*))
+ (&/|tail stack*)))
?state)
?value)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index b9361b8c3..3db4bd16d 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -352,7 +352,8 @@
)
(defn analyse-jvm-program [analyse ?args ?body]
- (|do [=body (&/with-scope ""
- (&&env/with-local ?args (&/V "lux;AppT" (&/T &type/List &type/Text))
- (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))]
- (return (&/|list (&/V "jvm-program" =body)))))
+ (|let [[_module _name] ?args]
+ (|do [=body (&/with-scope ""
+ (&&env/with-local (str _module ";" _name) (&/V "lux;AppT" (&/T &type/List &type/Text))
+ (&&/analyse-1 analyse (&/V "lux;AppT" (&/T &type/IO &type/Unit)) ?body)))]
+ (return (&/|list (&/V "jvm-program" =body))))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 6bbcd0fcf..d02599f10 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -76,6 +76,15 @@
(|do [exo-type* (&type/deref ?id)]
(&type/actual-type exo-type*))
+ [["lux;AllT" _]]
+ (|do [$var &type/existential
+ =type (&type/apply-type exo-type $var)]
+ (&type/actual-type =type))
+ ;; (&type/with-var
+ ;; (fn [$var]
+ ;; (|do [=type (&type/apply-type exo-type $var)]
+ ;; (&type/actual-type =type))))
+
[_]
(&type/actual-type exo-type))
types (matchv ::M/objects [exo-type*]
@@ -83,7 +92,9 @@
(return ?table)
[_]
- (fail "[Analyser Error] The type of a record must be a record type."))
+ (fail (str "[Analyser Error] The type of a record must be a record type:\n"
+ (&type/show-type exo-type*)
+ "\n")))
=slots (&/map% (fn [kv]
(matchv ::M/objects [kv]
[[["lux;Meta" [_ ["lux;TagS" ?ident]]] ?value]]
@@ -196,6 +207,9 @@
(|do [?fun-type* (&type/actual-type fun-type)]
(matchv ::M/objects [?fun-type*]
[["lux;AllT" _]]
+ ;; (|do [$var &type/existential
+ ;; type* (&type/apply-type ?fun-type* $var)]
+ ;; (analyse-apply* analyse exo-type type* ?args))
(&type/with-var
(fn [$var]
(|do [type* (&type/apply-type ?fun-type* $var)
@@ -216,6 +230,9 @@
=arg (&&/analyse-1 analyse ?input-t ?arg)]
(return (&/T =output-t (&/|cons =arg =args))))
+ ;; [["lux;VarT" ?id-t]]
+ ;; (|do [ (&type/deref ?id-t)])
+
[_]
(fail (str "[Analyser Error] Can't apply a non-function: " (&type/show-type ?fun-type*)))))
))
@@ -229,7 +246,14 @@
(|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 [macro-expansion #(-> macro (.apply ?args) (.apply %))
+ :let [_ (when (and ;; (= "lux/control/monad" ?module)
+ (= "do" ?name))
+ (->> (&/|map &/show-ast macro-expansion)
+ (&/|interpose "\n")
+ (&/fold str "")
+ (prn ?module "do")))]
+ ]
(&/flat-map% (partial analyse exo-type) macro-expansion))
[_]
@@ -254,16 +278,26 @@
exo-type)))))
(defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
- (matchv ::M/objects [exo-type]
- [["lux;LambdaT" [?arg-t ?return-t]]]
- (|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type
- ?arg ?arg-t
- (&&/analyse-1 analyse ?return-t ?body))]
- (return (&/T (&/V "lambda" (&/T =scope =captured =body)) exo-type)))
-
- [_]
- (fail (str "[Analyser Error] Functions require function types: "
- (&type/show-type exo-type)))))
+ (|do [exo-type* (&type/actual-type exo-type)]
+ (matchv ::M/objects [exo-type]
+ [["lux;AllT" _]]
+ (&type/with-var
+ (fn [$var]
+ (|do [exo-type** (&type/apply-type exo-type* $var)]
+ (analyse-lambda* analyse exo-type** ?self ?arg ?body))))
+ ;; (|do [$var &type/existential
+ ;; exo-type** (&type/apply-type exo-type* $var)]
+ ;; (analyse-lambda* analyse exo-type** ?self ?arg ?body))
+
+ [["lux;LambdaT" [?arg-t ?return-t]]]
+ (|do [[=scope =captured =body] (&&lambda/with-lambda ?self exo-type*
+ ?arg ?arg-t
+ (&&/analyse-1 analyse ?return-t ?body))]
+ (return (&/T (&/V "lambda" (&/T =scope =captured =body)) exo-type*)))
+
+ [_]
+ (fail (str "[Analyser Error] Functions require function types: "
+ (&type/show-type exo-type*))))))
(defn analyse-lambda** [analyse exo-type ?self ?arg ?body]
(matchv ::M/objects [exo-type]
@@ -281,6 +315,14 @@
[["lux;ExT" _]]
(return (&/T _expr exo-type))
+ [["lux;VarT" ?_id]]
+ (|do [?? (&type/bound? ?_id)]
+ ;; (return (&/T _expr exo-type))
+ (if ??
+ (fail (str "[Analyser Error] Can't use type-var in any type-specific way inside polymorphic functions: " ?id ":" _arg " " (&type/show-type dtype)))
+ (return (&/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)))))
(return (&/T _expr exo-type))))))))
@@ -295,7 +337,7 @@
(return (&/|list output))))
(defn analyse-def [analyse ?name ?value]
- (prn 'analyse-def/BEGIN ?name)
+ ;; (prn 'analyse-def/BEGIN ?name)
(|do [module-name &/get-module-name
? (&&module/defined? module-name ?name)]
(if ?
@@ -306,14 +348,16 @@
(matchv ::M/objects [=value]
[[["lux;Global" [?r-module ?r-name]] _]]
(|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type)
- :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name))
- _ (println)]]
+ ;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name))
+ ;; _ (println)]
+ ]
(return (&/|list)))
[_]
(|do [=value-type (&&/expr-type =value)
- :let [_ (prn 'analyse-def/END ?name)
- _ (println)
+ :let [;; _ (prn 'analyse-def/END ?name)
+ _ (println 'DEF (str module-name ";" ?name))
+ ;; _ (println)
def-data (cond (&type/type= &type/Type =value-type)
(&/V "lux;TypeD" nil)
@@ -328,23 +372,32 @@
(return (&/|list (&/V "declare-macro" (&/T module-name ?name))))))
(defn analyse-import [analyse compile-module ?path]
- (prn 'analyse-import ?path)
- (fn [state]
- (let [already-compiled? (&/fold false #(or %1 (= %2 ?path)) (&/get$ &/$SEEN-SOURCES state))]
- (&/run-state (|do [_ (&&module/add-import ?path)
- _ (if already-compiled?
- (return nil)
- (compile-module ?path))]
- (return (&/|list)))
- (if already-compiled?
- state
- (&/update$ &/$SEEN-SOURCES (partial &/|cons ?path) state))))))
+ (|do [module-name &/get-module-name]
+ (if (= module-name ?path)
+ (fail (str "[Analyser Error] Module can't import itself: " ?path))
+ (&/save-module
+ (fn [state]
+ (let [already-compiled? (&/fold #(or %1 (= %2 ?path)) false (&/get$ &/$SEEN-SOURCES state))]
+ (prn 'analyse-import module-name ?path already-compiled?)
+ (&/run-state (|do [_ (&&module/add-import ?path)
+ _ (if already-compiled?
+ (return nil)
+ (compile-module ?path))]
+ (return (&/|list)))
+ (if already-compiled?
+ state
+ (&/update$ &/$SEEN-SOURCES (partial &/|cons ?path) state)))))))))
(defn analyse-export [analyse name]
(|do [module-name &/get-module-name
_ (&&module/export module-name name)]
(return (&/|list))))
+(defn analyse-alias [analyse ex-alias ex-module]
+ (|do [module-name &/get-module-name
+ _ (&&module/alias module-name ex-alias ex-module)]
+ (return (&/|list))))
+
(defn analyse-check [analyse eval! exo-type ?type ?value]
(|do [=type (&&/analyse-1 analyse &type/Type ?type)
==type (eval! =type)
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index f0e5b82b4..27aa7374c 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -1,5 +1,6 @@
(ns lux.analyser.module
- (:require [clojure.core.match :as M :refer [matchv]]
+ (:require [clojure.string :as string]
+ [clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
(lux [base :as & :refer [|let |do return return* fail fail*]]
[type :as &type]
@@ -46,13 +47,14 @@
#(&/|put name (&/T false def-data) %)
m))
ms)))
- (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
- (&/update$ &/$MAPPINGS (fn [mappings]
- (&/|put (str "" &/+name-separator+ name)
- (&/T (&/V "lux;Global" (&/T module name)) type)
- mappings))
- locals))
- ?env))))
+ ;; (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
+ ;; (&/update$ &/$MAPPINGS (fn [mappings]
+ ;; (&/|put (str "" &/+name-separator+ name)
+ ;; (&/T (&/V "lux;Global" (&/T module name)) type)
+ ;; mappings))
+ ;; locals))
+ ;; ?env)))
+ )
nil)
[_]
@@ -93,14 +95,15 @@
#(&/|put a-name (&/T false (&/V "lux;AliasD" (&/T r-module r-name))) %)
m))
ms)))
- (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
- (&/update$ &/$MAPPINGS (fn [mappings]
- (&/|put (str "" &/+name-separator+ a-name)
- (&/T (&/V "lux;Global" (&/T r-module r-name)) type)
- ;; (aget (->> state (&/get$ &/$MODULES) (&/|get r-module) (&/get$ $DEFS) (&/|get r-name)) 1)
- mappings))
- locals))
- ?env))))
+ ;; (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
+ ;; (&/update$ &/$MAPPINGS (fn [mappings]
+ ;; (&/|put (str "" &/+name-separator+ a-name)
+ ;; (&/T (&/V "lux;Global" (&/T r-module r-name)) type)
+ ;; ;; (aget (->> state (&/get$ &/$MODULES) (&/|get r-module) (&/get$ $DEFS) (&/|get r-name)) 1)
+ ;; mappings))
+ ;; locals))
+ ;; ?env)))
+ )
nil)
[_]
@@ -112,7 +115,7 @@
(return* state
(->> state (&/get$ &/$MODULES) (&/|contains? name)))))
-(defn alias-module [module reference alias]
+(defn alias [module alias reference]
(fn [state]
(return* (->> state
(&/update$ &/$MODULES
@@ -136,23 +139,23 @@
(|do [current-module &/get-module-name]
(fn [state]
;; (prn 'find-def/_0 module name 'current-module current-module)
- (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $DEFS))]
+ (if-let [$module (->> state (&/get$ &/$MODULES) (&/|get module))]
(do ;; (prn 'find-def/_0.1 module (&/->seq (&/|keys $module)))
- (if-let [$def (&/|get name $module)]
- (matchv ::M/objects [$def]
- [[exported? $$def]]
- (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module))
- (if (or exported? (.equals ^Object current-module module))
- (matchv ::M/objects [$$def]
- [["lux;AliasD" [?r-module ?r-name]]]
- (do ;; (prn 'find-def/_2 [module name] [?r-module ?r-name])
- ((find-def ?r-module ?r-name)
- state))
-
- [_]
- (return* state (&/T (&/T module name) $$def)))
- (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))))
- (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name)))))
+ (if-let [$def (->> $module (&/get$ $DEFS) (&/|get name))]
+ (matchv ::M/objects [$def]
+ [[exported? $$def]]
+ (do ;; (prn 'find-def/_1 module name 'exported? exported? (.equals ^Object current-module module))
+ (if (or exported? (.equals ^Object current-module module))
+ (matchv ::M/objects [$$def]
+ [["lux;AliasD" [?r-module ?r-name]]]
+ (do ;; (prn 'find-def/_2 [module name] [?r-module ?r-name])
+ ((find-def ?r-module ?r-name)
+ state))
+
+ [_]
+ (return* state (&/T (&/T module name) $$def)))
+ (fail* (str "[Analyser Error] Can't use unexported definition: " (str module &/+name-separator+ name))))))
+ (fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name)))))
(do (prn [module name]
(str "[Analyser Error] Module doesn't exist: " module)
(->> state (&/get$ &/$MODULES) &/|keys &/->seq))
@@ -171,7 +174,7 @@
[[exported? ["lux;ValueD" ?type]]]
((|do [_ (&type/check &type/Macro ?type)
^ClassLoader loader &/loader
- :let [macro (-> (.loadClass loader (str module ".$" (&/normalize-ident name)))
+ :let [macro (-> (.loadClass loader (str (string/replace module #"/" ".") ".$" (&/normalize-ident name)))
(.getField "_datum")
(.get nil))]]
(fn [state*]
@@ -191,9 +194,9 @@
(fail* (str "[Analyser Error] Can't re-declare a macro: " (str module &/+name-separator+ name)))
[[_ ["lux;TypeD" _]]]
- (fail* (str "[Analyser Error] Definition doesn't have macro type: " module ";" name)))
- (fail* (str "[Analyser Error] Definition doesn't exist: " (str module &/+name-separator+ name))))
- (fail* (str "[Analyser Error] Module doesn't exist: " module)))))
+ (fail* (str "[Analyser Error] Definition does not have macro type: " (str module &/+name-separator+ name))))
+ (fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name))))
+ (fail* (str "[Analyser Error] Module does not exist: " module)))))
(defn export [module name]
(fn [state]
@@ -213,7 +216,7 @@
m))
ms))))
nil))
- (fail* (str "[Analyser Error] Can't export an inexistent definition: " module ";" name)))
+ (fail* (str "[Analyser Error] Can't export an inexistent definition: " (str module &/+name-separator+ name))))
[_]
(fail* "[Analyser Error] Can't export a global definition outside of a global environment."))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index aecb3fd13..d88bb2ec1 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -483,13 +483,25 @@
;; "lux;seed"
0
;; "lux;seen-sources"
- (|list)
+ (|list "lux")
;; "lux;source"
(V "lux;None" nil)
;; "lux;types"
+init-bindings+
))
+(defn save-module [body]
+ (fn [state]
+ (matchv ::M/objects [(body state)]
+ [["lux;Right" [state* output]]]
+ (return* (->> state*
+ (set$ $ENVS (get$ $ENVS state))
+ (set$ $SOURCE (get$ $SOURCE state)))
+ output)
+
+ [["lux;Left" msg]]
+ (fail* msg))))
+
(defn with-eval [body]
(fn [state]
(matchv ::M/objects [(body (set$ $EVAL? true state))]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 1970c548a..04f4fb4c2 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -342,7 +342,7 @@
.visitEnd))]
_ (&&/save-class! (str id) bytecode)
loader &/loader]
- (-> (.loadClass ^ClassLoader loader (str module "." id))
+ (-> (.loadClass ^ClassLoader loader (str (string/replace module #"/" ".") "." id))
(.getField "_eval")
(.get nil)
return))))
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index bc1ab23f1..2a8bdac89 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -146,7 +146,7 @@
compile-jvm-igt Opcodes/IF_ICMPGT "java.lang.Integer" "intValue" "()I"
)
-(do-template [<name> <cmpcode> <ifcode> <wrapper-class> <value-method> <value-method-sig>]
+(do-template [<name> <cmpcode> <cmp-output> <wrapper-class> <value-method> <value-method-sig>]
(defn <name> [compile *type* ?x ?y]
(|do [:let [+wrapper-class+ (&host/->class <wrapper-class>)]
^MethodVisitor *writer* &/get-writer
@@ -162,25 +162,26 @@
$end (new Label)
_ (doto *writer*
(.visitInsn <cmpcode>)
- (.visitJumpInsn <ifcode> $then)
- (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean"))
+ (.visitLdcInsn (int <cmp-output>))
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean"))
(.visitJumpInsn Opcodes/GOTO $end)
(.visitLabel $then)
- (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "FALSE" (&host/->type-signature "java.lang.Boolean"))
+ (.visitFieldInsn Opcodes/GETSTATIC (&host/->class "java.lang.Boolean") "TRUE" (&host/->type-signature "java.lang.Boolean"))
(.visitLabel $end))]]
(return nil)))
- compile-jvm-leq Opcodes/LCMP Opcodes/IFEQ "java.lang.Long" "longValue" "()J"
- compile-jvm-llt Opcodes/LCMP Opcodes/IFLT "java.lang.Long" "longValue" "()J"
- compile-jvm-lgt Opcodes/LCMP Opcodes/IFGT "java.lang.Long" "longValue" "()J"
+ compile-jvm-leq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J"
+ compile-jvm-llt Opcodes/LCMP 1 "java.lang.Long" "longValue" "()J"
+ compile-jvm-lgt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J"
- compile-jvm-feq Opcodes/FCMPG Opcodes/IFEQ "java.lang.Float" "floatValue" "()F"
- compile-jvm-flt Opcodes/FCMPG Opcodes/IFLT "java.lang.Float" "floatValue" "()F"
- compile-jvm-fgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Float" "floatValue" "()F"
+ compile-jvm-feq Opcodes/FCMPG 0 "java.lang.Float" "floatValue" "()F"
+ compile-jvm-flt Opcodes/FCMPG 1 "java.lang.Float" "floatValue" "()F"
+ compile-jvm-fgt Opcodes/FCMPG -1 "java.lang.Float" "floatValue" "()F"
- compile-jvm-deq Opcodes/DCMPG Opcodes/IFEQ "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dlt Opcodes/DCMPG Opcodes/IFLT "java.lang.Double" "doubleValue" "()I"
- compile-jvm-dgt Opcodes/FCMPG Opcodes/IFGT "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-deq Opcodes/DCMPG 0 "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-dlt Opcodes/DCMPG 1 "java.lang.Double" "doubleValue" "()I"
+ compile-jvm-dgt Opcodes/FCMPG -1 "java.lang.Double" "doubleValue" "()I"
)
(defn compile-jvm-invokestatic [compile *type* ?class ?method ?classes ?args]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index ecb614732..7d6b2b502 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -25,6 +25,17 @@
:let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC "java/lang/Boolean" (if ?value "TRUE" "FALSE") "Ljava/lang/Boolean;")]]
(return nil)))
+(defn compile-int [compile *type* value]
+ (|do [^MethodVisitor *writer* &/get-writer
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW "java/lang/Long")
+ (.visitInsn Opcodes/DUP)
+ (.visitLdcInsn (bit-shift-left (long value) 0)
+ ;; (bit-shift-left (long value) 32)
+ )
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Long" "<init>" "(J)V"))]]
+ (return nil)))
+
(do-template [<name> <class> <sig> <caster>]
(defn <name> [compile *type* value]
(|do [^MethodVisitor *writer* &/get-writer
@@ -35,7 +46,7 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>))]]
(return nil)))
- compile-int "java/lang/Long" "(J)V" long
+ ;; compile-int "java/lang/Long" "(J)V" long
compile-real "java/lang/Double" "(D)V" double
compile-char "java/lang/Character" "(C)V" char
)
diff --git a/src/lux/lexer.clj b/src/lux/lexer.clj
index a137ca863..fbfe1f757 100644
--- a/src/lux/lexer.clj
+++ b/src/lux/lexer.clj
@@ -67,8 +67,8 @@
(return (&/V "lux;Meta" (&/T meta (&/V <tag> token))))))
^:private lex-bool "Bool" #"^(true|false)"
- ^:private lex-int "Int" #"^-?(0|[1-9][0-9]*)"
- ^:private lex-real "Real" #"^-?(0|[1-9][0-9]*)\.[0-9]+"
+ ^:private lex-int "Int" #"^(-?0|-?[1-9][0-9]*)"
+ ^:private lex-real "Real" #"^-?(-?0\.[0-9]+|-?[1-9][0-9]*\.[0-9]+)"
)
(def ^:private lex-char
@@ -89,14 +89,14 @@
(def ^:private lex-ident
(&/try-all% (&/|list (|do [[meta token] (&reader/read-regex +ident-re+)]
(&/try-all% (&/|list (|do [_ (&reader/read-text ";")
- [_ local-token] (&reader/read-regex +ident-re+)]
- (&/try-all% (&/|list (|do [unaliased (&module/dealias token)]
- (return (&/T meta (&/T unaliased local-token))))
- (|do [? (&module/exists? token)]
- (if ?
- (return (&/T meta (&/T token local-token)))
- (fail (str "[Lexer Error] Unknown module: " token))))
- )))
+ [_ local-token] (&reader/read-regex +ident-re+)
+ ? (&module/exists? token)]
+ (if ?
+ (return (&/T meta (&/T token local-token)))
+ (|do [unaliased (do ;; (prn "Unaliasing: " token ";" local-token)
+ (&module/dealias token))]
+ (do ;; (prn "Unaliased: " unaliased ";" local-token)
+ (return (&/T meta (&/T unaliased local-token)))))))
(return (&/T meta (&/T "" token)))
)))
(|do [[meta _] (&reader/read-text ";;")
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e0315f8e7..e7d6353e8 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -349,16 +349,18 @@
(str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
[["lux;VariantT" cases]]
- (str "(| " (->> cases
- (&/|map (fn [kv]
- (matchv ::M/objects [kv]
- [[k ["Tuple" ["Nil" _]]]]
- (str "#" k)
-
- [[k v]]
- (str "(#" k " " (show-type v) ")"))))
- (&/|interpose " ")
- (&/fold str "")) ")")
+ (if (&/|empty? cases)
+ "(|)"
+ (str "(| " (->> cases
+ (&/|map (fn [kv]
+ (matchv ::M/objects [kv]
+ [[k ["lux;TupleT" ["lux;Nil" _]]]]
+ (str "#" k)
+
+ [[k v]]
+ (str "(#" k " " (show-type v) ")"))))
+ (&/|interpose " ")
+ (&/fold str "")) ")"))
[["lux;RecordT" fields]]
@@ -485,7 +487,9 @@
(&/|cons (&/T k v) fixpoints))
(defn ^:private check-error [expected actual]
- (str "Type " (show-type expected) " does not subsume type " (show-type actual)))
+ (str "[Type Checker]\nExpected: " (show-type expected)
+ "\n\nActual: " (show-type actual)
+ "\n"))
(defn beta-reduce [env type]
(matchv ::M/objects [type]
@@ -555,7 +559,7 @@
(apply-type type-fn* param))
[_]
- (fail (str "[Type System] Can't apply type function " (show-type type-fn) " to type " (show-type param)))))
+ (fail (str "[Type System] Not type function:\n" (show-type type-fn) "\n"))))
(def init-fixpoints (&/|list))
@@ -826,10 +830,10 @@
[["lux;ExT" e!id] ["lux;ExT" a!id]]
(if (.equals ^Object e!id a!id)
(return (&/T fixpoints nil))
- (check-error expected actual))
+ (fail (check-error expected actual)))
[_ _]
- (fail (println-str "[Type Error] Can't type-check: " (show-type expected) (show-type actual)))
+ (fail (check-error expected actual))
)))
(defn check [expected actual]
@@ -850,7 +854,7 @@
(clean $var =return))))
[_]
- (fail (str "[Type System] Can't apply type " (show-type func) " to type " (show-type param)))
+ (fail (str "[Type System] Not a function type:\n" (show-type func) "\n"))
))
(defn actual-type [type]
@@ -859,6 +863,9 @@
(|do [type* (apply-type ?all ?param)]
(actual-type type*))
+ [["lux;VarT" ?id]]
+ (deref ?id)
+
[_]
(return type)
))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 16:59:08 +0000