Source file gen_split_key_values.ml
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
open Tools
open Location
open Model
let asset_assets an = an ^ "_assets"
let to_lident f lident =
let l, v = deloc lident in
mkloc l (f v)
let lident_asset_assets = to_lident asset_assets
let split_key_values (model : model) : model =
let storage =
List.fold_right (fun x accu ->
match x.model_type with
| MTasset an ->
let an = dumloc an in
let _k, t = Utils.get_asset_key model (unloc an) in
let type_asset = Tassoc (t, Tasset an) in
let asset_assets =
mk_storage_item (dumloc (asset_assets (unloc an)))
(MTasset (unloc an))
type_asset
(mk_mterm (Marray []) type_asset)
~loc:x.loc
in
asset_assets::accu
| _ -> x::accu)
model.storage []
in
let rec f (ctx : ctx_model) (x : mterm) : mterm =
match x.node with
| Mselect (an, col, pred) ->
let col = f ctx col in
let pred = f ctx pred in
let _k, t = Utils.get_asset_key model an in
{ x with node = Mselect (an, col, pred); type_ = Tcontainer (Tbuiltin t, Collection)}
| Mletin (ids, init, _, body, o) ->
let init = f ctx init in
let body = f ctx body in
{ x with node = Mletin (ids, init, Some (init.type_), body, o); type_ = body.type_}
| Mdotasset (e, i) ->
let asset = Utils.get_asset_type e in
let containers = Utils.get_asset_containers model asset in
if List.exists (fun (pi, _pt, _pd) ->
compare (i |> unloc) pi = 0) containers then
let rec get_container_type = function
| (pi,pt,_pd)::_tl
when compare (i |> unloc) pi = 0 -> pt
| _r::tl -> get_container_type tl
| [] -> assert false in
let ty = get_container_type containers in
let pa = Utils.dest_container ty in
mk_mterm (Mshallow (pa, { x with node = Mdotasset (f ctx e, i) })) ty
else
{ x with node = Mdotasset (f ctx e, i) }
| Mvarstorecol an ->
(
let _k, t = Utils.get_asset_key model (unloc an) in
{ x with node = Mcoltokeys (unloc an); type_ = Tcontainer (Tbuiltin t, Collection) }
)
| Mfor (id, col, body, lbl) ->
let is_argument_plain_asset_collection (col : mterm) =
let id =
match col.node with
| Mvarparam an -> Some an
| _ -> None
in
match id, ctx.fs with
| Some an, Some ({args = args }) ->
List.fold_left (fun accu (name, type_, _) ->
match type_ with
| Tcontainer (Tasset _, _) when String.equal (unloc an) (unloc name) -> true
| _ -> accu
) false args
| _ -> false
in
let an =
match col.type_ with
| Tcontainer (Tasset an, _) -> an
| _ -> assert false
in
let _k, t = Utils.get_asset_key model (unloc an) in
let col = f ctx col in
let body = f ctx body in
let body =
if is_argument_plain_asset_collection col
then
body
else
let key = mk_mterm (Mvarlocal id) (Tbuiltin t) in
let get = mk_mterm (Mget (unloc an, key)) (Tasset an) in
let body = mk_mterm (Mletin ([id], get, Some (Tasset an), body, None)) (body.type_) in
body
in
{ x with node = Mfor (id, col, body, lbl) }
| _ -> map_mterm (f ctx) x
in
let model = map_mterm_model f model in
{ model with
storage = storage
}