@@ -44,6 +44,7 @@ let typed_phrase' f x =
4444 let n' = typ_note x.note in
4545 { x with it = f x.at n' x.it; note = n' }
4646
47+ let is_empty_tup e = e.it = S. TupE []
4748
4849let rec exps es = List. map exp es
4950
@@ -54,6 +55,7 @@ and exp e =
5455 | _ -> typed_phrase' exp' e
5556
5657and exp' at note = function
58+ | S. HoleE (_ , e ) -> (exp ! e).it
5759 | S. VarE i -> I. VarE ((match i.note with Var -> I. Var | Const -> I. Const ), i.it)
5860 | S. ActorUrlE e ->
5961 I. (PrimE (ActorOfIdBlob note.Note. typ, [url e at]))
@@ -125,110 +127,118 @@ and exp' at note = function
125127 let tys = List. map (T. open_ vars) res_tys in
126128 I. FuncE (name, s, control, tbs', args, tys, wrap (exp e))
127129 (* Primitive functions in the prelude have particular shapes *)
128- | S. CallE (None , {it= S. AnnotE ({it= S. PrimE p;_}, _);note;_}, _, e )
130+ | S. CallE (None , {it= S. AnnotE ({it= S. PrimE p;_}, _);note;_}, _, (_, e) )
129131 when Lib.String. chop_prefix " num_conv" p <> None ->
130132 begin match String. split_on_char '_' p with
131133 | [" num" ; " conv" ; s1; s2] ->
132134 let p1 = Type. prim s1 in
133135 let p2 = Type. prim s2 in
134- I. PrimE (I. NumConvTrapPrim (p1, p2), [exp e])
136+ I. PrimE (I. NumConvTrapPrim (p1, p2), [exp ! e])
135137 | _ -> assert false
136138 end
137- | S. CallE (None , {it= S. AnnotE ({it= S. PrimE p;_}, _);note;_}, _, e )
139+ | S. CallE (None , {it= S. AnnotE ({it= S. PrimE p;_}, _);note;_}, _, (_, e) )
138140 when Lib.String. chop_prefix " num_wrap" p <> None ->
139141 begin match String. split_on_char '_' p with
140142 | [" num" ; " wrap" ; s1; s2] ->
141143 let p1 = Type. prim s1 in
142144 let p2 = Type. prim s2 in
143- I. PrimE (I. NumConvWrapPrim (p1, p2), [exp e])
145+ I. PrimE (I. NumConvWrapPrim (p1, p2), [exp ! e])
144146 | _ -> assert false
145147 end
146- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "decodeUtf8" ;_} ,_ );_} , _ , e ) ->
147- I. PrimE (I. DecodeUtf8 , [exp e])
148- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "encodeUtf8" ;_} ,_ );_} , _ , e ) ->
149- I. PrimE (I. EncodeUtf8 , [exp e])
150- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cast" ;_} , _ );note;_} , _ , e ) ->
148+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "decodeUtf8" ;_} ,_ );_} , _ , ( _ , e ) ) ->
149+ I. PrimE (I. DecodeUtf8 , [exp ! e])
150+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "encodeUtf8" ;_} ,_ );_} , _ , ( _ , e ) ) ->
151+ I. PrimE (I. EncodeUtf8 , [exp ! e])
152+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cast" ;_} , _ );note;_} , _ , ( _ , e ) ) ->
151153 begin match note.S. note_typ with
152154 | T. Func (T. Local, T. Returns, [] , ts1 , ts2 ) ->
153- I. PrimE (I. CastPrim (T. seq ts1, T. seq ts2), [exp e])
155+ I. PrimE (I. CastPrim (T. seq ts1, T. seq ts2), [exp ! e])
154156 | _ -> assert false
155157 end
156- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "serialize" ;_} , _ );note;_} , _ , e ) ->
158+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "serialize" ;_} , _ );note;_} , _ , ( _ , e ) ) ->
157159 begin match note.S. note_typ with
158160 | T. Func (T. Local, T. Returns, [] , ts1 , ts2 ) ->
159- I. PrimE (I. SerializePrim ts1, [exp e])
161+ I. PrimE (I. SerializePrim ts1, [exp ! e])
160162 | _ -> assert false
161163 end
162- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "deserialize" ;_} , _ );note;_} , _ , e ) ->
164+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "deserialize" ;_} , _ );note;_} , _ , ( _ , e ) ) ->
163165 begin match note.S. note_typ with
164166 | T. Func (T. Local, T. Returns, [] , ts1 , ts2 ) ->
165- I. PrimE (I. DeserializePrim ts2, [exp e ])
167+ I. PrimE (I. DeserializePrim ts2, [exp ( ! e) ])
166168 | _ -> assert false
167169 end
168- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "caller" ;_} ,_ );_} , _ , {it =S. TupE es ;_} ) ->
169- assert (es = [] );
170- I. PrimE (I. ICCallerPrim , [] )
171- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "deadline" ;_} ,_ );_} , _ , {it =S. TupE es ;_} ) ->
172- assert (es = [] );
170+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "caller" ;_} ,_ );_} , _ , (_ , e )) ->
171+ (match ! e with
172+ | {it =S. TupE [] ;_} ->
173+ I. PrimE (I. ICCallerPrim , [] )
174+ | _ -> assert false )
175+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "deadline" ;_} ,_ );_} , _ , (_ , e )) ->
176+ assert ((! e).it = S. TupE [] );
173177 I. PrimE (I. ICReplyDeadlinePrim , [] )
174- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "time" ;_} ,_ );_} , _ , { it = S. TupE es ;_} ) ->
175- assert (es = [] );
178+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "time" ;_} ,_ );_} , _ , ( _ , e ) ) ->
179+ assert (( ! e).it = S. TupE [] );
176180 I. PrimE (I. SystemTimePrim , [] )
177181 (* Cycles *)
178- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesBalance" ;_} ,_ );_} , _ , { it = S. TupE es ;_} ) ->
179- assert (es = [] );
182+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesBalance" ;_} ,_ );_} , _ , ( _ , e ) ) ->
183+ assert (is_empty_tup ! e );
180184 I. PrimE (I. SystemCyclesBalancePrim , [] )
181- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesAvailable" ;_} ,_ );_} , _ , { it = S. TupE es ;_} ) ->
182- assert (es = [] );
185+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesAvailable" ;_} ,_ );_} , _ , ( _ , e ) ) ->
186+ assert (is_empty_tup ! e );
183187 I. PrimE (I. SystemCyclesAvailablePrim , [] )
184- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesRefunded" ;_} ,_ );_} , _ , { it = S. TupE es ;_} ) ->
185- assert (es = [] );
188+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesRefunded" ;_} ,_ );_} , _ , ( _ , e ) ) ->
189+ assert (is_empty_tup ! e );
186190 I. PrimE (I. SystemCyclesRefundedPrim , [] )
187- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesAccept" ;_} ,_ );_} , _ , e ) ->
188- I. PrimE (I. SystemCyclesAcceptPrim , [exp e])
189- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesAdd" ;_} ,_ );_} , _ , e ) ->
190- I. PrimE (I. SystemCyclesAddPrim , [exp e])
191- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesBurn" ;_} ,_ );_} , _ , e ) ->
192- I. PrimE (I. SystemCyclesBurnPrim , [exp e])
193- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "timeoutSet" ;_} ,_ );_} , _ , e ) ->
194- I. PrimE (I. SystemTimeoutSetPrim , [exp e])
191+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesAccept" ;_} ,_ );_} , _ , ( _ , e ) ) ->
192+ I. PrimE (I. SystemCyclesAcceptPrim , [exp ! e])
193+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesAdd" ;_} ,_ );_} , _ , ( _ , e ) ) ->
194+ I. PrimE (I. SystemCyclesAddPrim , [exp ! e])
195+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "cyclesBurn" ;_} ,_ );_} , _ , ( _ , e ) ) ->
196+ I. PrimE (I. SystemCyclesBurnPrim , [exp ! e])
197+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "timeoutSet" ;_} ,_ );_} , _ , ( _ , e ) ) ->
198+ I. PrimE (I. SystemTimeoutSetPrim , [exp ! e])
195199 (* Certified data *)
196- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "setCertifiedData" ;_} ,_ );_} , _ , e ) ->
197- I. PrimE (I. SetCertifiedData , [exp e])
198- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "getCertificate" ;_} ,_ );_} , _ , {it =S. TupE es ;_} ) ->
200+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "setCertifiedData" ;_} ,_ );_} , _ , (_ , e )) ->
201+ I. PrimE (I. SetCertifiedData , [exp ! e])
202+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE "getCertificate" ;_} ,_ );_} , _ , (_ , e )) ->
203+ assert (is_empty_tup ! e);
199204 I. PrimE (I. GetCertificate , [] )
200205 (* Other *)
201- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE p ;_} ,_ );_} , _ , {it =S. TupE es ;_} ) ->
202- I. PrimE (I. OtherPrim p, exps es)
203- | S. CallE (None, {it =S. AnnotE ({it =S. PrimE p ;_} ,_ );_} , _ , e ) ->
204- I. PrimE (I. OtherPrim p, [exp e])
206+ | S. CallE (None, {it =S. AnnotE ({it =S. PrimE p ;_} ,_ );_} , _ , (_ , e )) ->
207+ (match (! e).it with
208+ | S. TupE es ->
209+ I. PrimE (I. OtherPrim p, exps es)
210+ | _ ->
211+ I. PrimE (I. OtherPrim p, [exp ! e]))
205212 (* Optimizing array.size() *)
206- | S. CallE (None , {it= S. DotE (e1, proj, _); _}, _, {it= S. TupE [] ;_})
207- when T. is_array e1.note.S. note_typ && proj.it = " size" ->
213+ | S. CallE (None , {it= S. DotE (e1, proj, _); _}, _, (_, e))
214+ when is_empty_tup ! e &&
215+ T. is_array e1.note.S. note_typ && proj.it = " size" ->
208216 I. PrimE (I. OtherPrim " array_len" , [exp e1])
209- | S. CallE (None , {it= S. DotE (e1, proj, _); _}, _, {it= S. TupE [] ;_})
210- when T. (is_prim Text ) e1.note.S. note_typ && proj.it = " size" ->
217+ | S. CallE (None , {it= S. DotE (e1, proj, _); _}, _, (_, e))
218+ when is_empty_tup ! e &&
219+ T. (is_prim Text ) e1.note.S. note_typ && proj.it = " size" ->
211220 I. PrimE (I. OtherPrim " text_len" , [exp e1])
212- | S. CallE (None , {it= S. DotE (e1, proj, _); _}, _, {it= S. TupE [] ;_})
213- when T. (is_prim Blob ) e1.note.S. note_typ && proj.it = " size" ->
221+ | S. CallE (None , {it= S. DotE (e1, proj,_); _}, _, (_, e))
222+ when is_empty_tup ! e &&
223+ T. (is_prim Blob ) e1.note.S. note_typ && proj.it = " size" ->
214224 I. PrimE (I. OtherPrim " blob_size" , [exp e1])
215225 (* Contextual dot call *)
216- | S. CallE (None, {it =S. DotE (e1 , id , n );_} , inst , e2 ) when Option. is_some ! n ->
226+ | S. CallE (None, {it =S. DotE (e1 , id , n );_} , inst , ( _ , e2 ) ) when Option. is_some ! n ->
217227 let func_exp = Option. get ! n in
218- let args = S. contextual_dot_args e1 e2 func_exp in
228+ let args = S. contextual_dot_args e1 ! e2 func_exp in
219229 I. (PrimE (CallPrim inst.note, [exp func_exp; exp args]))
220230 (* Normal call *)
221- | S. CallE (None, e1 , inst , e2 ) ->
222- I. (PrimE (CallPrim inst.note, [exp e1; exp e2]))
231+ | S. CallE (None, e1 , inst , ( _ , e2 ) ) ->
232+ I. (PrimE (CallPrim inst.note, [exp e1; exp ! e2]))
223233 (* Call with parenthetical *)
224- | S. CallE (Some _ as par_opt , e1 , inst , e2 ) ->
234+ | S. CallE (Some _ as par_opt , e1 , inst , ( _ , e2 ) ) ->
225235 let send e1_typ = T. (is_func e1_typ &&
226236 (let s, _, _, _, _ = as_func e1_typ in
227237 is_shared_sort s || is_fut note.Note. typ)) in
228238 let ds, rs = parenthetical (send e1.note.S. note_typ) par_opt in
229- let v1, v2 = fresh_var " e1" e1.note.S. note_typ, fresh_var " e2" e2 .note.S. note_typ in
239+ let v1, v2 = fresh_var " e1" e1.note.S. note_typ, fresh_var " e2" ( ! e2) .note.S. note_typ in
230240 (blockE
231- (ds @ letD v1 (exp e1) :: letD v2 (exp e2) :: rs)
241+ (ds @ letD v1 (exp e1) :: letD v2 (exp ! e2) :: rs)
232242 I. { at; note; it = PrimE (CallPrim inst.note, [varE v1; varE v2]) }).it
233243 | S. BlockE [] -> (unitE () ).it
234244 | S. BlockE [{it = S. ExpD e; _}] -> (exp e).it
@@ -251,9 +261,9 @@ and exp' at note = function
251261 | S. WhileE (e1 , e2 ) -> (whileE (exp e1) (exp e2)).it
252262 | S. LoopE (e1 , None) -> I. LoopE (exp e1)
253263 | S. LoopE (e1 , Some e2 ) -> (loopWhileE (exp e1) (exp e2)).it
254- | S. ForE (p, {it= S. CallE (None , {it= S. DotE (arr, proj, _); _}, _, e1 ); _}, e2)
264+ | S. ForE (p, {it= S. CallE (None , {it= S. DotE (arr, proj, _); _}, _, (_, e1) ); _}, e2)
255265 when T. is_array arr.note.S. note_typ && (proj.it = " vals" || proj.it = " values" || proj.it = " keys" )
256- -> (transform_for_to_while p arr proj e1 e2).it
266+ -> (transform_for_to_while p arr proj ( ! e1) e2).it
257267 | S. ForE (p , e1 , e2 ) -> (forE (pat p) (exp e1) (exp e2)).it
258268 | S. DebugE e -> if ! Mo_config.Flags. release_mode then (unitE () ).it else (exp e).it
259269 | S. LabelE (l , t , e ) -> I. LabelE (l.it, t.Source. note, exp e)
0 commit comments