Fil-C on Nix

Filnix wiki

the formal campaign

rocq/backend/Promote.v

# Promotion of memory slots to temporaries

As promote.pl's promote_module/2, on terms. A slot is one offset and width, acc(Off, W), of an alloc whose address does not escape (Escape.v). An alloc is promoted, all its slots at once, when its size is a constant, its slots lie inside it and do not overlap, and its float slots are stored before they are read. Each load of a slot then becomes a copy or an extension of the slot's value, each store goes, and phis named pr.N join the values where paths meet (pruned SSA, Cytron et al.).

An l access that another access overlaps is first split into two w accesses, when the alloc then promotes.

A function that is not in strict SSA form, or that calls setjmp, is left as it is. What promote.pl does besides is left out, as in Copy.v: the context records and their sites. promote_module gives None where promote_module/2 fails or throws. The gate (tests/promote.sh) holds the result to the term nanofilpromote − terms prints.

From Stdlib Require Import String ZArith List Bool
From Nanofil Require Import Term Maps Semantics Cfg
From Backend Require Import Text Order Pizlonate Liveness TermCfg Escape
Import ListNotations
Open Scope string_scope
Open Scope Z_scope
Open Scope list_scope

String equality, written as Prolog's ==.

31Notation a == b ≔ String.eqba b (at level 70)

Terms

The instruction let(D, K, Op, Args).

36Definition let_termd k o : term args : listterm : term ≔
TApp"let" d; k; o; TListargs

The instruction store(W, V, A).

40Definition store_termw v a : term : term ≔
TApp"store" w; v; a

The value const(N).

43Definition const_termn : Z : term ≔
TApp"const" TIntn

The width, value and address when the term i is store(W, V, A).

47Definition store_partsi : term : optionterm × term × term ≔
match i with
TAppf w; v; a
⇒
f == "store"
→
Somew, v, a
else
None
_
⇒
None

The destination, class, type and address name when the term i is let(D, K, load(T), [tmp(X)]).

55Definition load_partsi : term : optionterm × term × term × term ≔
match let_partsi with
Somed, k, TAppg t, a
⇒
g == "load"
→
match tmp_namea with
x
⇒
Somed, k, t, x
_
⇒
None
else
None
_
⇒
None

Whether x is in the ordset xs.

65Definition nmemx : name xs : names : bool ≔

A slot of an alloc as a name, the term A − Off.

68Definition slot_vara : term off : Z : term ≔
TApp"-" a; TIntoff

Which allocs

As stored_accs(F, Addrs, Stored): for each alloc, the accesses of the stores to its addresses.

74Definition stored_accsaddrs : addresses bs : listtblock : nmaplistacc ≔
fold_left
λ m i  ⇒
match store_partsi with
Somew, _, a
⇒
fold_leftλm r ⇒ nm_addfstr sndr, w :: accs_atm fstr m address_ofaddrs a m
None
⇒
m
flat_maptb_insts bs

As acc_inside(Acc, Outer): the bytes of the access a are bytes of the access outer.

86Definition acc_insidea outer : acc : bool ≔
match width_bytessnda, width_bytessndouter with
Someb, Somesb
⇒
fstouter ≤? fsta && fsta + b ≤? fstouter + sb
_, _
⇒
false

As punned_slots(Accs, Stored, Slots): the slots of an alloc with the accesses accs, those that are inside no other. Each access inside another must be a punned read: of width b or h, never stored, and the first slot it is inside of width h or w. None when one is not.

97Definition punned_slotsaccs stored : listacc : optionlistacc ≔
let inner a ≔ existsbλo ⇒ negbacc_eqbo a && acc_insidea o accs in
let parts ≔ partitioninner accs in
let slots ≔ sndparts in
let punned a ≔
is_atom"b" snda || is_atom"h" snda && negbexistsbacc_eqba stored
&&
match findacc_insidea slots with
Somes
⇒
is_atom"h" snds || is_atom"w" snds
None
⇒
false
in
forallbpunned fstparts
→
Someslots
else
None

As slots_disjoint/1: each of the slots, sorted, ends before the next begins.

112Fixpoint slots_disjointslots : listacc : bool ≔
match slots with
a :: b :: _ as rest
⇒
match width_bytessnda with
Somen
⇒
fsta + n ≤? fstb && slots_disjointrest
None
⇒
false
_
⇒
true

As slots_ok(Mode, Size, Slots): an alloc of size bytes can go for its slots. In filc mode its size is one an alloc cannot trap on, at most 2^48 - 1. Each slot lies inside the alloc, a p slot is 8-aligned in filc mode, so no access could trap, and the slots do not overlap. No slot has the width x.

127Definition slots_okfilc : bool size : Z slots : listacc : bool ≔
negbfilc || 0 ≤? size && size ≤? 281474976710655
&&
forallb
λ a  ⇒
match width_bytessnda with
Somen
⇒
0 ≤? fsta && fsta + n ≤? size
&&
is_atom"p" snda
→
negbfilc || fsta mod 8 =? 0
else
negbis_atom"x" snda
None
⇒
false
slots
&&

A promoted alloc: its temporary and its slots.

140Definition root: Type ≔
term × listacc%type

Whether w is a float width, s or d.

143Definition float_widthw : term : bool ≔
is_atom"s" w || is_atom"d" w

As stored_transfer(Addrs, A-Os, I, S0, S): the offsets among os of the alloc a that are stored after the instruction i, given those stored before, s. The alloc itself stores none.

148Definition stored_transferaddrs : addresses a : term os : names i : term s : names : names ≔
match let_partsi with
Somed, _, o, _
⇒
is_alloco && existsbterm_eqba tmp_named
→
[ ]
else
s
None
⇒
match store_partsi with
Some_, _, x
⇒
match address_ofaddrs x with
r, off
⇒
term_eqbr a && nmemTIntoff os
→
else
s
_
⇒
s
None
⇒
s

As float_slots_stored(Cfg, ByLabel, Addrs, A-Slots): every load of a float slot of the alloc a comes after a store to it, on every path from the alloc. The stored offsets at each block's end are the greatest solution of a forward analysis over the reachable blocks: a block starts with what all its predecessors with a set so far end with, the entry with nothing.

170Definition float_slots_storedg : cfg by_label : nmaptblock addrs : addresses r : root : bool ≔
let a ≔ fstr in
let os ≔
flat_map
λ s  ⇒
→
TIntfsts
else
[ ]
sndr
in
match os with
[ ]
⇒
true
_
⇒
let insts l ≔
match nm_findl by_label with
Someb
⇒
None
⇒
[ ]
in
let block_in out : nmapnames l : name : names ≔
else
match flat_mapλp ⇒ match nm_findp out with Somes ⇒ s | None ⇒ [ ] end match nm_findl cfg_predsg with Someps ⇒ ps | None ⇒ [ ] end with
s0 :: rest
⇒
[ ]
⇒
[ ]
in
let step out : nmapnames : nmapnames × bool ≔
fold_left
λ st l  ⇒
let new ≔ fold_leftλs i ⇒ stored_transferaddrs a os i s instsl block_infstst l in
match nm_findl fstst with
Someold
⇒
names_eqbold new
→
st
else
nm_addl new fstst, true
None
⇒
nm_addl new fstst, true
out, false
in
let res ≔ live_rounds40 step nm_empty in
negbsndres
&&
forallb
λ l  ⇒
snd
fold_left
λ st i  ⇒
let ok ≔
match load_partsi with
Some_, _, _, x
⇒
match nm_findx addrs with
Somert, off
⇒
term_eqbrt a && nmemTIntoff os
→
nmemTIntoff fstst
else
true
None
⇒
true
None
⇒
true
in
stored_transferaddrs a os i fstst, sndst && ok
instsl
block_infstres l, true

What promotable/4 finds of a function: the allocs to promote, with the classes, address temporaries and definition counts they come from.

220Record analysis: Type ≔ mkAnalysis
an_roots
 : listroot
the allocs to promote
an_classes
 : listterm × term × optionlistacc
each alloc's size and class
an_addrsthe address temporaries
an_counts
 : nmapnat
how often each temporary is defined

As promotable(Mode, F, Roots, An), for a function with an alloc that does not call setjmp: the allocs of constant size whose slots are fit (punned_slots, slots_ok) and whose float slots are stored before they are read.

231Definition promotablefilc : bool params : listterm bs : listtblock : optionanalysis ≔
let* addrs ≔ address_tempsbs in
let counts ≔ def_countsparams bs in
let classes ≔ alloc_classesaddrs counts params bs in
let stored ≔ stored_accsaddrs bs in
let roots0 ≔
flat_map
λ c  ⇒
match c with
a, size, Someaccs
⇒
match const_intsize, punned_slotsaccs accs_atstored a with
Somen, Someslots
⇒
slots_okfilc n slots
→
a, slots
else
[ ]
_, _
⇒
[ ]
_
⇒
[ ]
classes
in
let* roots ≔
existsbλr ⇒ existsbλs ⇒ float_widthsnds sndr roots0
→
let* g ≔ term_cfgbs in
let by_label ≔ nm_of_listmapλb ⇒ tb_labelb, b bs in
Somefilterfloat_slots_storedg by_label addrs roots0
else
Someroots0
in
SomemkAnalysisroots classes addrs counts

Splitting words

As split_offsets(Accs, Offs): the ordset of the offsets of the l accesses among accs that another access overlaps.

259Definition split_offsetsaccs : listacc : listZ ≔
let overlap a b : acc ≔
match width_bytessnda, width_bytessndb with
Somen1, Somen2
⇒
fsta <? fstb + n2 && fstb <? fsta + n1
_, _
⇒
false
in
sortZ.compare
flat_map
λ x  ⇒
is_atom"l" sndx && existsbλo ⇒ negbacc_eqbo x && overlapx o accs
→
fstx
else
[ ]
accs

As split_accs(Offs, Accs0, Accs): the accesses accs with each l access at an offset of offs as its two words.

273Definition split_accsoffs : listZ accs : listacc : listacc ≔
flat_map
λ x  ⇒
is_atom"l" sndx && existsbZ.eqbfstx offs
→
fstx, TAtom"w"; fstx + 4, TAtom"w"
else
x
accs

As split_roots(Mode, F, Roots, Classes, Addrs, Splits): the allocs to split, each with the offsets of the l accesses to split. They are the allocs of constant size with an l access that are no roots but would have fit slots once split. An alloc with a store of an l that is neither a temporary nor a constant is not split.

285Definition split_rootsfilc : bool bs : listtblock an : analysis : listterm × listZ ≔
let addrs ≔ an_addrsan in
let cands ≔
flat_map
λ c  ⇒
match c with
a, size, Someaccs
⇒
match const_intsize with
Somen
⇒
negbexistsbλr ⇒ term_eqbfstr a an_rootsan && existsbλx ⇒ is_atom"l" sndx accs
→
a, n, accs
else
[ ]
None
⇒
[ ]
_
⇒
[ ]
in
match cands with
[ ]
⇒
[ ]
_
⇒
let stored ≔ stored_accsaddrs bs in
let bad ≔
flat_map
λ i  ⇒
match store_partsi with
Somew, v, a
⇒
let simple ≔
match v with
TAppf _
⇒
f == "tmp" || f == "const"
_
⇒
false
in
is_atom"l" w && negbsimple
→
mapfst address_ofaddrs a
else
[ ]
None
⇒
[ ]
flat_maptb_insts bs
in
flat_map
λ c  ⇒
let 'a, size, accs ≔ c in
existsbterm_eqba bad
→
[ ]
else
match split_offsetsaccs with
[ ]
⇒
[ ]
offs
⇒
match punned_slotssplit_accsoffs accs split_accsoffs accs_atstored a with
Someslots
⇒
slots_okfilc size slots
→
a, offs
else
[ ]
None
⇒
[ ]
cands

As fresh_temps/4 for one name: the name sw.I for the least I from n on that counts has no definition of, and I + 1. Each name passed over is another key of counts, so a fuel of their number is enough.

335Fixpoint fresh_splitfuel : nat counts : nmapnat n : Z : term × Z ≔
let q ≔ TAtomString.append"sw." decimaln in
match fuel with
O
⇒
q, n + 1
Sfuel′
⇒
nm_memq counts
→
fresh_splitfuel′ counts n + 1
else
q, n + 1

As split_inst/5: the instruction i, with a store or a load of an l at a split address as two of a w, the low word at the address and the high word 4 bytes on; n counts the fresh names. The address 4 bytes on has the class k, p in filc mode and else l.

347Definition split_instsplits : listterm × listZ addrs : addresses counts : nmapnat fuel : nat k : term i : term n : Z : listterm × Z ≔
let split_address a : term : bool ≔
match address_ofaddrs a with
r, o
⇒
match findλs ⇒ term_eqbfsts r splits with
Somes
⇒
existsbZ.eqbo snds
None
⇒
false
_
⇒
false
in
let l ≔ TAtom"l" in
let w ≔ TAtom"w" in
match store_partsi with
Somesw, v, a
⇒
is_atom"l" sw && split_addressa
→
let h ≔ fresh_splitfuel counts n in
let x4 ≔ fresh_splitfuel counts sndh in
let_termtmpfsth l TAtom"shr" v; const_term32; store_termw v a; let_termtmpfstx4 k TAtom"add" a; const_term4; store_termw tmpfsth tmpfstx4, sndx4
else
i, n
None
⇒
match load_partsi with
Somed, kl, t, x
⇒
is_atom"l" kl && is_atom"l" t && split_addresstmpx
→
let lo ≔ fresh_splitfuel counts n in
let x4 ≔ fresh_splitfuel counts sndlo in
let hi ≔ fresh_splitfuel counts sndx4 in
let hs ≔ fresh_splitfuel counts sndhi in
let load_uw ≔ TApp"load" TAtom"uw" in
let_termtmpfstlo l load_uw tmpx; let_termtmpfstx4 k TAtom"add" tmpx; const_term4; let_termtmpfsthi l load_uw tmpfstx4; let_termtmpfsths l TAtom"shl" tmpfsthi; const_term32; let_termd l TAtom"or" tmpfsths; tmpfstlo, sndhs
else
i, n
None
⇒
i, n

As split_words/8: the blocks bs with the l accesses of splits as words, and whether any was split.

391Definition split_wordsfilc : bool splits : listterm × listZ addrs : addresses counts : nmapnat fuel : nat bs : listtblock : listtblock × bool ≔
let k ≔
filc
→
"p"
else
"l"
in
let r ≔
fold_left
λ st b  ⇒
let r ≔
fold_left
λ s i  ⇒
let o ≔ split_instsplits addrs counts fuel k i snds in
rev_appendfsto fsts, sndo
[ ], sndst
in
mkTBlocktb_labelb tb_phisb rev'fstr tb_jumpb :: fstst, sndr
bs
[ ], 0
in
rev'fstr, negbsndr =? 0

The rewrite

As the AddrShifts of promote_roots/11: the slot an address at the offset off of the alloc a names, and the byte of the slot it starts at. That is the first of slots with the byte at off, or a slot at off itself.

411Definition address_slota : term off : Z slots : listacc : term × Z ≔
match findλs ⇒ match width_bytessnds with Somen ⇒ fsts ≤? off && off <? fsts + n | None ⇒ false end slots with
Somes
⇒
slot_vara fsts, off − fsts
None
⇒
slot_vara off, 0

The slots the instruction i sets: those of a root it allocates, or the one it stores to.

422Definition inst_setsslot_of : nmapterm × Z alloc_vars : nmaplistterm i : term : listterm ≔
match let_partsi with
Somed, _, o, _
⇒
→
flat_map
λ a  ⇒
match nm_finda alloc_vars with
Somevs
⇒
vs
None
⇒
[ ]
else
[ ]
None
⇒
match store_partsi with
Some_, _, a
⇒
flat_map
λ x  ⇒
match nm_findx slot_of with
Somes
⇒
fsts
None
⇒
[ ]
None
⇒
[ ]

As slot_gen_kill/4: the slots the instructions read before they set them, and those they set.

441Definition slot_gen_killslot_of : nmapterm × Z alloc_vars : nmaplistterm insts : listterm : names × names ≔
fold_left
λ gk i  ⇒
match load_partsi with
Some_, _, _, x
⇒
match nm_findx slot_of with
Somev, _
⇒
nmemv sndgk
→
gk
else
nunionfstgk v, sndgk
None
⇒
gk
None
⇒
fstgk, nunionsndgk nsortinst_setsslot_of alloc_vars i
insts
[ ], [ ]

As iterated_frontier/6: the labels where the slot var needs a phi, an ordset: those of the dominance frontiers of the labels of work, and of the labels so found, where var is live. Each turn takes a label off work, and a label is put on it once, so a fuel of the labels of work and of the graph is enough.

459Fixpoint iterated_frontierfuel : nat df live_in : nmapnames var : term work : listname placed : names : optionnames ≔
match work with
[ ]
⇒
Someplaced
l :: ls
⇒
match fuel with
O
⇒
None
Sfuel′
⇒
let* frontier ≔ nm_findl df in
let st ≔
fold_left
λ st y  ⇒
negbnmemy fstst && nmemvar names_atlive_in y
→
nunionfstst y, y :: sndst
else
st
frontier
placed, ls
in
iterated_frontierfuel′ df live_in var sndst fstst

As unused_temp/4: the name pr.I for the least I above n that counts has no definition of, and I.

479Fixpoint fresh_phifuel : nat counts : nmapnat n : Z : term × Z ≔
let q ≔ TAtomString.append"pr." decimaln + 1 in
match fuel with
O
⇒
q, n + 1
Sfuel′
⇒
nm_memq counts
→
fresh_phifuel′ counts n + 1
else
q, n + 1

As load_op(T, K, Op): the op that makes of a slot's value what a load of the type t gives at the class k.

488Definition load_opt k : term : optionterm ≔
match t with
⇒
a == "l" || a == "p" || a == "s" || a == "d"
→
SomeTAtom"copy"
a == "sw" || a == "uw"
→
is_atom"w" k
→
SomeTAtom"copy"
is_atom"l" k
→
SomeTApp"ext" t
else
None
a == "sh" || a == "uh" || a == "sb" || a == "ub"
→
SomeTApp"ext" t
else
None
_
⇒
None

As slot_class(Width, K): the class of the phi of a slot of the width w.

504Definition slot_classw : term : optionterm ≔
match w with
⇒
a == "l" || a == "p" || a == "s" || a == "d"
→
Somew
a == "w" || a == "h" || a == "b"
→
SomeTAtom"w"
else
None
_
⇒
None

As inst_renamed/4: what the instruction i becomes, and the slots' values after it, given those before, cur.

  • The alloc of a root goes; its slots are 0.
  • An instruction that defines an address of a root goes.
  • A load of a slot is the load_op on the slot's value, or, for a punned read at a byte past the slot's first, on the value shifted right by 8 bits a byte, in the temporary pun.D.
  • A store to a slot goes; the slot has its value.

None where promote.pl fails: for a slot with no value, a load with no op, or a punned read into something that is no named temporary.

526Definition inst_renamedslot_of : nmapterm × Z alloc_vars : nmaplistterm cur : nmapterm i : term : optionnmapterm × listterm ≔
let keep ≔ Somecur, i in
match let_partsi with
Somed, k, o, _
⇒
let avs ≔
→
match tmp_named with
a
⇒
nm_finda alloc_vars
_
⇒
None
else
None
in
match avs with
Somevs
⇒
Somefold_leftλc v ⇒ nm_addv const_term0 c vs cur, [ ]
None
⇒
existsbλx ⇒ nm_memx slot_of tmp_named
→
Somecur, [ ]
else
match load_partsi with
Some_, _, t, x
⇒
match nm_findx slot_of with
Somevar, shift
⇒
let* v ≔ nm_findvar cur in
let* op ≔ load_opt k in
shift =? 0
→
Somecur, let_termd k op v
else
let* p ≔
match tmp_named with
⇒
SomeTAtomString.append"pun." n
⇒
SomeTAtomString.append"pun." decimaln
_
⇒
None
in
Somecur, let_termtmpp TAtom"w" TAtom"shr" v; const_term8 × shift; let_termd k op tmpp
None
⇒
keep
None
⇒
keep
None
⇒
match store_partsi with
Some_, v, a
⇒
match tmp_namea with
x
⇒
match nm_findx slot_of with
Somevar, _
⇒
Somenm_addvar v cur, [ ]
None
⇒
keep
_
⇒
keep
None
⇒
keep

A renamed block, with the phi arguments it gives its successors: under each Succ − Slot, the term Pred − Value.

575Definition renamed: Type ≔
tblock × listterm × term%type

The slots with a phi at the label l, each with the phi's temporary.

579Definition phis_atphi_at : nmaplistterm × term l : name : listterm × term ≔
match nm_findl phi_at with
Somevts
⇒
vts
None
⇒
[ ]

As block_renamed/5: the block at the label l renamed from the slots' values cur at its start, and their values at its end. Its slot phis' temporaries are its slots' first values.

585Definition block_renamedslot_of : nmapterm × Z alloc_vars : nmaplistterm phi_at : nmaplistterm × term by_label : nmaptblock succs : nmaplistname l : name cur : nmapterm : optionnmapterm × renamed ≔
let* b ≔ nm_findl by_label in
let cur1 ≔ fold_leftλc vt ⇒ nm_addfstvt tmpsndvt c phis_atphi_at l cur in
let* r ≔
fold_left
λ acc i  ⇒
let* st ≔ acc in
let* o ≔ inst_renamedslot_of alloc_vars fstst i in
Somefsto, rev_appendsndo sndst
Somecur1, [ ]
in
let* ss ≔ nm_findl succs in
let args ≔
flat_map
λ s  ⇒
flat_map
λ vt  ⇒
match nm_findfstvt fstr with
Somev
⇒
TApp"-" s; fstvt, TApp"-" l; v
None
⇒
[ ]
phis_atphi_at s
ss
in
Somefstr, mkTBlockl tb_phisb rev'sndr tb_jumpb, args

As subtree_renamed//3: the blocks of the dominator tree at the label l renamed, each from the values at its parent's end, put before those of done. The tree is no deeper than the graph has labels, the fuel.

610Fixpoint subtree_renamedfuel : nat block : name → nmapterm → optionnmapterm × renamed kids : nmaplistname l : name cur : nmapterm done : listrenamed : optionlistrenamed ≔
match fuel with
O
⇒
None
Sfuel′
⇒
let* r ≔ blockl cur in
let* ks ≔ nm_findl kids in
fold_left
λ acc k  ⇒
let* d ≔ acc in
subtree_renamedfuel′ block kids k fstr d
ks
Somesndr :: done

As promote_roots/11: the blocks bs with the slots of roots as temporaries. The graph g, with the immediate dominators idom, is that of bs, which are in strict SSA form; addrs and counts are their address temporaries and definition counts, and fuel is at least the number of defined temporaries.

A slot's phis are on the iterated dominance frontier of the entry and the reachable blocks that set the slot, where the slot is live. The blocks are renamed down the dominator tree from the entry, where every slot is 0, and each unreachable block from all 0.

635Definition promote_rootsroots : listroot addrs : addresses counts : nmapnat fuel : nat bs : listtblock g : cfg idom : nmapname : optionlisttblock ≔
let roots_map ≔ nm_of_listroots in
let slot_of : nmapterm × Z ≔
flat_map
λ i  ⇒
match let_partsi with
Somed, _, _, _
⇒
flat_map
λ x  ⇒
match nm_findx addrs with
Somea, off
⇒
match nm_finda roots_map with
Someslots
⇒
x, address_slota off slots
None
⇒
[ ]
None
⇒
[ ]
None
⇒
[ ]
flat_maptb_insts bs
in
let root_vars r : root ≔ mapλs ⇒ slot_varfstr fsts sndr in
let widths ≔ nm_of_listflat_mapλr ⇒ mapλs ⇒ slot_varfstr fsts, snds sndr roots in
let vars ≔ flat_maproot_vars roots in
let alloc_vars ≔ nm_of_listmapλr ⇒ fstr, root_varsr roots in
let gk ≔ nm_of_listmapλb ⇒ tb_labelb, slot_gen_killslot_of alloc_vars tb_instsb bs in
let reach ≔ reachedg in
let order ≔ rev'cfg_rpog ++ filterλl ⇒ negbnm_meml reach maptb_label bs in
let live ≔ live_rounds40 live_roundorder cfg_succsg gk nm_empty nm_empty in
sndlive
→
None
else
let live_in ≔ fstlive in
let* df ≔ cfg_frontiersg idom in
let stores : nmapnames ≔
fold_left
λ m b  ⇒
→
fold_leftλm v ⇒ nm_addv tb_labelb :: names_atm v m nsortflat_mapinst_setsslot_of alloc_vars tb_instsb m
else
m
bs
in
let labels ≔ lengthcfg_rpog in
let* phi_labels ≔
λ v  ⇒
let work ≔ nsortcfg_entryg :: names_atstores v in
option_mapλls ⇒ v, ls iterated_frontierSlengthwork + labels df live_in v work [ ]
vars
in
let phi_at : nmaplistterm × term ≔
fst
fold_left
λ st lv  ⇒
let t ≔ fresh_phifuel counts sndst in
nm_addfstlv sndlv, fstt :: phis_atfstst fstlv fstst, sndt
flat_mapλp ⇒ mapλl ⇒ l, fstp sndp phi_labels
in
let zero ≔ fold_leftλc v ⇒ nm_addv const_term0 c vars nm_empty in
let by_label ≔ nm_of_listmapλb ⇒ tb_labelb, b bs in
let* kids ≔ dom_childreng idom in
let block ≔ block_renamedslot_of alloc_vars phi_at by_label cfg_succsg in
let* reached_blocks ≔ subtree_renamedSlabels block kids cfg_entryg zero [ ] in
let* all ≔
fold_left
λ acc b  ⇒
let* done ≔ acc in
→
Somedone
else
let* r ≔ blocktb_labelb zero in
Somesndr :: done
bs
Somereached_blocks
in
let new_blocks ≔ nm_of_listmapλr ⇒ tb_labelfstr, fstr all in
let args_at : nmaplistterm ≔ fold_leftλm r ⇒ fold_leftλm a ⇒ nm_addfsta snda :: names_atm fsta m sndr m all nm_empty in
λ b  ⇒
let l ≔ tb_labelb in
let* nb ≔ nm_findl new_blocks in
let slot_phis ≔
flat_map
λ vt  ⇒
match nm_findfstvt widths with
Somew
⇒
match slot_classw, nm_findTApp"-" l; fstvt args_at with
Somek, Someargs
⇒
TApp"phi" tmpsndvt; k; TListnsortargs
_, _
⇒
[ ]
None
⇒
[ ]
phis_atphi_at l
in
SomemkTBlockl tb_phisnb ++ slot_phis tb_instsnb tb_jumpnb
bs

Functions and modules

As promote_context/5, without the records: the blocks bs of a function with the given params, in filc mode or not, its promotable allocs gone. The words of the allocs of split_roots are split first, if the function is in strict SSA form and every such alloc then promotes.

732Definition promote_blocksfilc : bool params : listterm bs : listtblock : optionlisttblock ≔
→
Somebs
negb
existsb
λ i  ⇒
match let_partsi with
Some_, _, o, _
⇒
None
⇒
false
flat_maptb_insts bs
→
Somebs
else
let names ≔ Slengthall_defsparams bs in
let strict an : analysis bs : listtblock : optioncfg × nmapname ≔
match term_cfgbs with
Someg
⇒
match cfg_idomsg with
Someidom
⇒
strict_ssaan_countsan params bs g idom
→
Someg, idom
else
None
None
⇒
None
None
⇒
None
in
let* an0 ≔ promotablefilc params bs in
let* split ≔
match split_rootsfilc bs an0 with
[ ]
⇒
SomeNone
splits
⇒
match strictan0 bs with
Some_
⇒
let r ≔ split_wordsfilc splits an_addrsan0 an_countsan0 names bs in
let* an1 ≔ promotablefilc params fstr in
sndr && forallbλs ⇒ existsbλr ⇒ term_eqbfstr fsts an_rootsan1 splits
→
SomeSomefstr, an1
else
SomeNone
None
⇒
SomeNone
in
let bs0 ≔
match split with
Somes
⇒
fsts
None
⇒
bs
in
let an ≔
match split with
Somes
⇒
snds
None
⇒
an0
in
match an_rootsan with
[ ]
⇒
Somebs0
roots
⇒
match strictan bs0 with
Someg, idom
⇒
promote_rootsroots an_addrsan an_countsan Slengthall_defsparams bs0 bs0 g idom
None
⇒
Somebs0

As promote_module/2, without the context items.

779Definition promote_modulem : term : optionterm ≔