aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/base.clj2
-rw-r--r--src/lux/compiler.clj31
-rw-r--r--src/lux/compiler/base.clj9
-rw-r--r--src/lux/compiler/cache.clj9
-rw-r--r--src/lux/compiler/lux.clj15
-rw-r--r--src/lux/compiler/type.clj157
6 files changed, 10 insertions, 213 deletions
diff --git a/src/lux/base.clj b/src/lux/base.clj
index da5ef48f8..b6aaa57b4 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -231,11 +231,9 @@
(def ^:const name-field "_name")
(def ^:const hash-field "_hash")
(def ^:const type-field "_type")
-(def ^:const anns-field "_anns")
(def ^:const value-field "_value")
(def ^:const compiler-field "_compiler")
(def ^:const imports-field "_imports")
-(def ^:const defs-field "_defs")
(def ^:const eval-field "_eval")
(def ^:const tags-field "_tags")
(def ^:const module-class-name "_")
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 869ee84d7..71a83b559 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -198,8 +198,6 @@
.visitEnd)
(-> (.visitField +field-flags+ &/compiler-field "Ljava/lang/String;" nil &/compiler-version)
.visitEnd)
- (-> (.visitField +field-flags+ &/anns-field +datum-sig+ nil nil)
- (doto (.visitEnd)))
(.visitSource file-name nil))]
_ (if (= "lux" name)
(|do [_ &&host/compile-Function-class
@@ -211,7 +209,7 @@
(&/exhaust% compiler-step))
(&/set$ &/$source (&reader/from name file-content) state))
(&/$Right ?state _)
- (&/run-state (|do [==anns (&a-module/get-anns name)
+ (&/run-state (|do [module-anns (&a-module/get-anns name)
defs &a-module/defs
imports &a-module/imports
tag-groups &&module/tag-groups
@@ -222,22 +220,9 @@
(str ?name &&/def-datum-separator (&&&type/serialize-type ?def-type) &&/def-datum-separator (&&&ann/serialize-anns ?def-anns))
(str ?name &&/def-datum-separator ?alias)))))
(&/|interpose &&/def-entry-separator)
- (&/fold str ""))
- ^String defs-value (->> defs
- (&/|filter (fn [_def]
- (|let [[?name ?alias [?def-type ?def-meta ?def-value]] _def]
- (= "" ?alias))))
- (&/|map (fn [_def]
- (|let [[?name ?alias [?def-type ?def-meta ?def-value]] _def]
- (str ?name
- &&/exported-separator
- ?alias))))
- (&/|interpose &&/def-separator)
- (&/fold str ""))
+ (&/fold str "")
+ (str (&&&ann/serialize-anns module-anns) &&/section-separator))
_ (doto =class
- (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/defs-field "Ljava/lang/String;" nil
- defs-value)
- .visitEnd)
(-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/imports-field "Ljava/lang/String;" nil
(->> imports
(&/|map (fn [import]
@@ -256,16 +241,6 @@
(&/fold str "")))
.visitEnd)
)]
- _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
- (|do [^MethodVisitor **writer** &/get-writer
- :let [_ (.visitCode **writer**)]
- _ (&&/compile-meta compile-expression ==anns)
- :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC module-class-name &/anns-field +datum-sig+)]
- :let [_ (doto **writer**
- (.visitInsn Opcodes/RETURN)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))
:let [_ (.visitEnd =class)]
_ (&/flag-compiled-module name)
_ (&&/save-class! &/module-class-name (.toByteArray =class))
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index fcb153662..2a482e5ff 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -14,8 +14,7 @@
[host :as &host])
(lux.analyser [base :as &a]
[module :as &a-module])
- [lux.host.generics :as &host-generics]
- (lux.compiler [type :as &&type]))
+ [lux.host.generics :as &host-generics])
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -43,7 +42,6 @@
(def ^:const arity-field "_arity_")
(def ^:const partials-field "_partials_")
-(def ^:const exported-separator " ")
(def ^:const def-separator "\t")
(def ^:const tag-separator " ")
(def ^:const type-separator "\t")
@@ -52,6 +50,7 @@
(def ^:const field-separator "\t")
(def ^:const entry-separator "\n")
+(def ^:const section-separator (->> 29 char str))
(def ^:const def-datum-separator (->> 31 char str))
(def ^:const def-entry-separator (->> 30 char str))
@@ -123,7 +122,3 @@
wrap-double unwrap-double "java/lang/Double" "doubleValue" "D" Opcodes/DUP_X2
wrap-char unwrap-char "java/lang/Character" "charValue" "C" Opcodes/DUP_X1
)
-
-(defn compile-meta [compile anns]
- (|let [analysis (&&type/defmeta->analysis anns)]
- (compile nil analysis)))
diff --git a/src/lux/compiler/cache.clj b/src/lux/compiler/cache.clj
index ba221b73d..9de105aa4 100644
--- a/src/lux/compiler/cache.clj
+++ b/src/lux/compiler/cache.clj
@@ -143,8 +143,7 @@
&/$Nil
(&/->list imports)))]
(if (->> loads &/->seq (every? true?))
- (let [defs (string/split (get-field &/defs-field module-class) def-separator-re)
- tag-groups (let [all-tags (get-field &/tags-field module-class)]
+ (let [tag-groups (let [all-tags (get-field &/tags-field module-class)]
(if (= "" all-tags)
&/$Nil
(-> all-tags
@@ -155,11 +154,11 @@
&/->list)))]
(|do [_ (&a-module/create-module module module-hash)
^String descriptor (&&/read-module-descriptor! module)
- :let [module-anns (get-field &/anns-field module-class)]
- _ (&a-module/set-anns module-anns module)
+ :let [[module-anns-section ^String defs-section] (.split descriptor &&/section-separator)]
+ _ (&a-module/set-anns (&&&ann/deserialize-anns module-anns-section) module)
_ (&/flag-cached-module module)
_ (&a-module/set-imports imports)
- :let [desc-defs (vec (.split descriptor &&/def-entry-separator))]
+ :let [desc-defs (vec (.split defs-section &&/def-entry-separator))]
_ (&/map% (fn [^String _def-entry]
(let [parts (.split _def-entry &&/def-datum-separator)]
(case (alength parts)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 1ea078e76..9d5837fe2 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -21,8 +21,7 @@
[module :as &a-module]
[meta :as &a-meta])
(lux.compiler [base :as &&]
- [lambda :as &&lambda]
- [type :as &&type]))
+ [lambda :as &&lambda]))
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
@@ -236,18 +235,6 @@
_ (.visitLabel *writer* $end)]]
(return nil)))
-(defn ^:private compile-def-type [compile ?body]
- (|do [:let [?def-type (|case ?body
- [[?def-type ?def-cursor] (&o/$ann ?def-value ?type-expr)]
- (&o/optimize ?type-expr)
-
- [[?def-type ?def-cursor] ?def-value]
- (if (&type/type= &type/Type ?def-type)
- (&/T [(&/T [?def-type ?def-cursor])
- (&o/$tuple (&/|list))])
- (&&type/type->analysis ?def-type)))]]
- (compile nil ?def-type)))
-
(defn ^:private de-ann [optim]
(|case optim
[_ (&o/$ann value-expr _)]
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
deleted file mode 100644
index b2b0f9cb9..000000000
--- a/src/lux/compiler/type.clj
+++ /dev/null
@@ -1,157 +0,0 @@
-;; Copyright (c) Eduardo Julian. All rights reserved.
-;; This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-;; If a copy of the MPL was not distributed with this file,
-;; You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(ns lux.compiler.type
- (:require [clojure.template :refer [do-template]]
- clojure.core.match
- clojure.core.match.array
- (lux [base :as & :refer [|do return* return fail fail* |let |case]]
- [type :as &type]
- [optimizer :as &o])
- [lux.analyser.base :as &a]))
-
-;; [Utils]
-(defn ^:private variant$ [tag body]
- "(-> clojure.lang.Var Analysis Analysis)"
- (let [tag-meta (meta tag)]
- (&a/|meta &/$VoidT &/empty-cursor
- (&o/$variant (::&/idx tag-meta) (::&/is-last? tag-meta) body))))
-
-(defn ^:private tuple$ [members]
- "(-> (List Analysis) Analysis)"
- (&a/|meta &/$VoidT &/empty-cursor
- (&o/$tuple members)))
-
-(do-template [<name> <tag> <doc>]
- (defn <name> [value]
- <doc>
- (&a/|meta &/$VoidT &/empty-cursor
- (<tag> value)))
-
- ^:private bool$ &o/$bool "(-> Bool Analysis)"
- ^:private nat$ &o/$nat "(-> Nat Analysis)"
- ^:private int$ &o/$int "(-> Int Analysis)"
- ^:private frac$ &o/$frac "(-> Nat Analysis)"
- ^:private real$ &o/$real "(-> Real Analysis)"
- ^:private char$ &o/$char "(-> Char Analysis)"
- ^:private text$ &o/$text "(-> Text Analysis)"
- )
-
-(defn ^:private ident$ [value]
- "(-> Ident Analysis)"
- (|let [[p n] value]
- (tuple$ (&/|list (text$ p) (text$ n)))))
-
-(def ^:private $Nil
- "Analysis"
- (variant$ #'&/$Nil (tuple$ &/$Nil)))
-
-(defn ^:private Cons$ [head tail]
- "(-> Analysis Analysis Analysis)"
- (variant$ #'&/$Cons (tuple$ (&/|list head tail))))
-
-(defn ^:private List$ [elems]
- "(-> (List Analysis) Analysis)"
- (&/fold (fn [tail head]
- (Cons$ head tail))
- $Nil
- (&/|reverse elems)))
-
-;; [Exports]
-(defn type->analysis [type]
- "(-> Type Analysis)"
- (|case type
- (&/$HostT class params)
- (variant$ #'&/$HostT (tuple$ (&/|list (text$ class)
- (List$ (&/|map type->analysis params)))))
-
- (&/$VoidT)
- (variant$ #'&/$VoidT (tuple$ (&/|list)))
-
- (&/$UnitT)
- (variant$ #'&/$UnitT (tuple$ (&/|list)))
-
- (&/$ProdT left right)
- (variant$ #'&/$ProdT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
-
- (&/$SumT left right)
- (variant$ #'&/$SumT (tuple$ (&/|list (type->analysis left) (type->analysis right))))
-
- (&/$LambdaT input output)
- (variant$ #'&/$LambdaT (tuple$ (&/|list (type->analysis input) (type->analysis output))))
-
- (&/$UnivQ env body)
- (variant$ #'&/$UnivQ
- (tuple$ (&/|list (List$ (&/|map type->analysis env))
- (type->analysis body))))
-
- (&/$ExQ env body)
- (variant$ #'&/$ExQ
- (tuple$ (&/|list (List$ (&/|map type->analysis env))
- (type->analysis body))))
-
- (&/$BoundT idx)
- (variant$ #'&/$BoundT (int$ idx))
-
- (&/$AppT fun arg)
- (variant$ #'&/$AppT (tuple$ (&/|list (type->analysis fun) (type->analysis arg))))
-
- (&/$NamedT [module name] type*)
- (variant$ #'&/$NamedT (tuple$ (&/|list (tuple$ (&/|list (text$ module) (text$ name)))
- (type->analysis type*))))
-
- _
- (assert false (prn 'type->analysis (&type/show-type type)))
- ))
-
-(defn ^:private defmetavalue->analysis [dmv]
- "(-> Ann-Value Analysis)"
- (|case dmv
- (&/$BoolM value)
- (variant$ #'&/$BoolM (bool$ value))
-
- (&/$NatM value)
- (variant$ #'&/$NatM (nat$ value))
-
- (&/$IntM value)
- (variant$ #'&/$IntM (int$ value))
-
- (&/$FracM value)
- (variant$ #'&/$FracM (frac$ value))
-
- (&/$RealM value)
- (variant$ #'&/$RealM (real$ value))
-
- (&/$CharM value)
- (variant$ #'&/$CharM (char$ value))
-
- (&/$TextM value)
- (variant$ #'&/$TextM (text$ value))
-
- (&/$IdentM value)
- (variant$ #'&/$IdentM (ident$ value))
-
- (&/$ListM xs)
- (variant$ #'&/$ListM (List$ (&/|map defmetavalue->analysis xs)))
-
- (&/$DictM kvs)
- (variant$ #'&/$DictM
- (List$ (&/|map (fn [kv]
- (|let [[k v] kv]
- (tuple$ (&/|list (text$ k)
- (defmetavalue->analysis v)))))
- kvs)))
-
- _
- (assert false (prn 'defmetavalue->analysis (&/adt->text dmv)))
- ))
-
-(defn defmeta->analysis [xs]
- "(-> Anns Analysis)"
- (List$ (&/|map (fn [kv]
- (|let [[k v] kv]
- (tuple$ (&/|list (ident$ k)
- (defmetavalue->analysis v)))))
- xs)))
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-31 08:43:56 +0000