blob: 5ba14e3edd448f792d7ae36bb6b3c698aa900910 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
(ns lux.compiler.core
(:require (clojure [template :refer [do-template]]
[string :as string])
[clojure.java.io :as io]
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
(lux [base :as & :refer [|case |let |do return* return fail*]])
(lux.analyser [base :as &a]
[module :as &a-module])
(lux.compiler.cache [type :as &&&type]))
(:import (java.io File
BufferedOutputStream
FileOutputStream)))
;; [Constants]
(def !output-dir (atom nil))
(def ^:const section-separator (->> 29 char str))
(def ^:const datum-separator (->> 31 char str))
(def ^:const entry-separator (->> 30 char str))
;; [Utils]
(defn write-file [^String file-name ^bytes data]
(do (assert (not (.exists (File. file-name))) (str "Cannot overwrite file: " file-name))
(with-open [stream (BufferedOutputStream. (FileOutputStream. file-name))]
(.write stream data)
(.flush stream))))
;; [Exports]
(def ^String lux-module-descriptor-name "lux_module_descriptor")
(defn write-module-descriptor! [^String name ^String descriptor]
(|do [_ (return nil)
:let [lmd-dir (str @!output-dir java.io.File/separator (.replace name "/" java.io.File/separator))
_ (.mkdirs (File. lmd-dir))
_ (write-file (str lmd-dir java.io.File/separator lux-module-descriptor-name) (.getBytes descriptor java.nio.charset.StandardCharsets/UTF_8))]]
(return nil)))
(defn read-module-descriptor! [^String name]
(|do [_ (return nil)]
(return (slurp (str @!output-dir java.io.File/separator (.replace name "/" java.io.File/separator) java.io.File/separator lux-module-descriptor-name)
:encoding "UTF-8"))))
(defn generate-module-descriptor [file-hash]
(|do [module-name &/get-module-name
defs &a-module/defs
imports &a-module/imports
:let [def-entries (&/fold (fn [def-entries _def]
(|let [[?name _definition] _def]
(|case _definition
(&/$AliasG [_dmodule _dname])
(str "A"
datum-separator ?name
datum-separator _dmodule &/+name-separator+ _dname
;; Next
entry-separator def-entries)
(&/$DefinitionG [exported? ?def-type ?def-value])
(str "D"
datum-separator ?name
datum-separator (if exported? "1" "0")
datum-separator (&&&type/serialize-type ?def-type)
;; Next
entry-separator def-entries)
(&/$TypeG [exported? value labels])
(let [[record? head tail] (|case labels
(&/$Left [head tail])
[false head tail]
(&/$Right [head tail])
[true head tail])]
(str ":"
datum-separator ?name
datum-separator (if exported? "1" "0")
datum-separator (if record? "1" "0")
datum-separator head
datum-separator (->> tail
(&/|interpose &/+name-separator+)
(&/fold str ""))
;; Next
entry-separator def-entries))
(&/$TagG [?export ?type ?group ?index])
def-entries
;; (str "T"
;; datum-separator ?name
;; datum-separator (if ?export "1" "0")
;; datum-separator (&&&type/serialize-type ?type)
;; datum-separator ?index
;; datum-separator (->> ?group
;; (&/|interpose &/+name-separator+)
;; (&/fold str "")))
(&/$SlotG [?export ?type ?group ?index])
def-entries
;; (str "S"
;; datum-separator ?name
;; datum-separator (if ?export "1" "0")
;; datum-separator (&&&type/serialize-type ?type)
;; datum-separator ?index
;; datum-separator (->> ?group
;; (&/|interpose &/+name-separator+)
;; (&/fold str "")))
)))
""
defs)
import-entries (->> imports
(&/|map (fn [import]
(|let [[_module _hash] import]
(str _module datum-separator _hash))))
(&/|interpose entry-separator)
(&/fold str ""))
module-descriptor (->> (&/|list &/version
(Long/toUnsignedString file-hash)
import-entries
def-entries)
(&/|interpose section-separator)
(&/fold str ""))]]
(return module-descriptor)))
|
