From f5a063190a333cc711801f94c966ed45369e915b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 18 Nov 2016 17:10:22 -0400 Subject: - Module anns are now stored in the new module-cache file too. --- src/lux/base.clj | 2 - src/lux/compiler.clj | 31 +-------- src/lux/compiler/base.clj | 9 +-- src/lux/compiler/cache.clj | 9 ++- src/lux/compiler/lux.clj | 15 +---- src/lux/compiler/type.clj | 157 --------------------------------------------- 6 files changed, 10 insertions(+), 213 deletions(-) delete mode 100644 src/lux/compiler/type.clj (limited to 'src') 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 "" "()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 [ ] - (defn [value] - - (&a/|meta &/$VoidT &/empty-cursor - ( 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))) -- cgit v1.2.3