blob: 9d5a8e97fde779f7d1c3936eb0341d26922cb290 (
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
(ns lux.compiler.cache.ann
(:require (clojure [template :refer [do-template]]
[string :as string])
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array
(lux [base :as & :refer [|let |do return* return |case]])))
(def ^:private stop (->> 7 char str))
(def ^:private cons-signal (->> 5 char str))
(def ^:private nil-signal (->> 6 char str))
(defn ^:private serialize-seq [serialize params]
(str (&/fold (fn [so-far param]
(str so-far cons-signal (serialize param)))
""
params)
nil-signal))
(defn ^:private serialize-ident [ident]
(|let [[module name] ident]
(str module &/+name-separator+ name)))
(defn serialize
"(-> Code Text)"
[ann]
(|case ann
[_ (&/$Bit value)]
(str "B" value stop)
[_ (&/$Nat value)]
(str "N" value stop)
[_ (&/$Int value)]
(str "I" value stop)
[_ (&/$Rev value)]
(str "D" value stop)
[_ (&/$Frac value)]
(str "F" value stop)
[_ (&/$Text value)]
(str "T" value stop)
[_ (&/$Identifier ident)]
(str "@" (serialize-ident ident) stop)
[_ (&/$Tag ident)]
(str "#" (serialize-ident ident) stop)
[_ (&/$Form elems)]
(str "(" (serialize-seq serialize elems))
[_ (&/$Tuple elems)]
(str "[" (serialize-seq serialize elems))
[_ (&/$Record kvs)]
(str "{" (serialize-seq (fn [kv]
(|let [[k v] kv]
(str (serialize k)
(serialize v))))
kvs))
_
(assert false)
))
(declare deserialize)
(def dummy-location
(&/T ["" 0 0]))
(do-template [<name> <signal> <ctor> <parser>]
(defn <name> [^String input]
(when (.startsWith input <signal>)
(let [[value* ^String input*] (.split (.substring input 1) stop 2)]
[(&/T [dummy-location (<ctor> (<parser> value*))]) input*])))
^:private deserialize-bit "B" &/$Bit Boolean/parseBoolean
^:private deserialize-nat "N" &/$Nat Long/parseLong
^:private deserialize-int "I" &/$Int Long/parseLong
^:private deserialize-rev "D" &/$Rev Long/parseLong
^:private deserialize-frac "F" &/$Frac Double/parseDouble
^:private deserialize-text "T" &/$Text identity
)
(do-template [<name> <marker> <tag>]
(defn <name> [^String input]
(when (.startsWith input <marker>)
(let [[^String ident* ^String input*] (.split (.substring input 1) stop 2)
[_module _name] (.split ident* "\\." 2)]
[(&/T [dummy-location (<tag> (&/T [_module _name]))]) input*])))
^:private deserialize-identifier "@" &/$Identifier
^:private deserialize-tag "#" &/$Tag)
(defn ^:private deserialize-seq [deserializer ^String input]
(cond (.startsWith input nil-signal)
[&/$End (.substring input 1)]
(.startsWith input cons-signal)
(when-let [[head ^String input*] (deserializer (.substring input 1))]
(when-let [[tail ^String input*] (deserialize-seq deserializer input*)]
[(&/$Item head tail) input*]))
))
(defn ^:private deserialize-kv [input]
(when-let [[key input*] (deserialize input)]
(when-let [[ann input*] (deserialize input*)]
[(&/T [key ann]) input*])))
(do-template [<name> <signal> <type> <deserializer>]
(defn <name> [^String input]
(when (.startsWith input <signal>)
(when-let [[elems ^String input*] (deserialize-seq <deserializer>
(.substring input 1))]
[(&/T [dummy-location (<type> elems)]) input*])))
^:private deserialize-form "(" &/$Form deserialize
^:private deserialize-tuple "[" &/$Tuple deserialize
^:private deserialize-record "{" &/$Record deserialize-kv
)
(defn deserialize
"(-> Text V[Code Text])"
[input]
(or (deserialize-bit input)
(deserialize-nat input)
(deserialize-int input)
(deserialize-rev input)
(deserialize-frac input)
(deserialize-text input)
(deserialize-identifier input)
(deserialize-tag input)
(deserialize-form input)
(deserialize-tuple input)
(deserialize-record input)
(assert false "[Cache Error] Cannot deserialize annocation.")))
|
