ludic/selfhost/backend/emit_deps.ludic

# emit_deps.ludic — the module graph as the compiler saw it, for `ludic deps`. With LUDIC_DEPS=<file>
# every reference vis_check is asked about is an edge from the module it is written in to the module
# of what it names, and every assignment to a global of another module is a write; the file lists
# the modules (their declared `uses`, and whether they are a package's), the edges with a count, and
# the writes, one a line:
#   module <name> <package 0|1> <uses: -|,a,b,> <layer: -|name>
#   edge <from> <to> <count> <first name>
#   write <owner> <global> <from> <file>:<line>
#   alias <owner> <global> <from> <file>:<line> <local>    (a write through a local, below)
#   width <n> <name> <file>:<line> <pkg>                   (the states it takes)
#   reach <n> <name> <file>:<line> <pkg>                   (the states it can come to, fn values too)
#   wreach <n> <name> <file>:<line> <pkg>                  (of those, the ones it can come to change: `mut`)
var g_dp_on: int = -1
var g_dp_key: []pointer = new []pointer        # "from to"
var g_dp_cnt: []int = new []int
var g_dp_name: []pointer = new []pointer
var g_dp_writes: []pointer = new []pointer

function deps_on() -> bool {
  if g_dp_on < 0 {
    g_dp_on = 0
    if getenv("LUDIC_DEPS") != null { g_dp_on = 1 }
  }
  return g_dp_on == 1
}
function deps_edge(d: Node, what: pointer) -> void {
  if not deps_on() or d.file == null or g_err_file == null { return }
  let from = module_of(g_err_file)
  let to = module_for_uses(d.file)
  if (from == "") or (to == "") or (from == to) { return }
  let key = `{from} {to}`
  var i = 0
  while i < len(g_dp_key) {
    if (g_dp_key[i] == key) {
      g_dp_cnt[i] = g_dp_cnt[i] + 1
      return
    }
    i += 1
  }
  push(g_dp_key, key)
  push(g_dp_cnt, 1)
  push(g_dp_name, vis_plain(what))
}
# an assignment into global `g` (directly, or through an index or a field of it)
function deps_write(g: Node, name: pointer) -> void {
  if not deps_on() or g == null or g.file == null or g_err_file == null { return }
  let from = module_of(g_err_file)
  let owner = module_for_uses(g.file)
  if (from == "") or (owner == "") or (from == owner) { return }
  push(g_dp_writes, `write {owner} {name} {from} {g_err_file}:{itoa(g_err_line)}`)
}
# the global an assignment target is rooted in (`a[i].f = ...` writes a), or null for a local
function deps_target_root(t: Node) -> Node {
  var n = t
  while n != null and (n.kind == E_INDEX or n.kind == E_MEMBER) { n = n.a }
  if n == null or n.kind != E_ID { return null }
  if loc_find(n.s) >= 0 { return null }
  return find_global(n.s)
}
function deps_line(f: pointer, s: pointer) -> void {
  file_write(f, s, len(s))
  file_write(f, "\n", 1)
}
function deps_flush() -> void {
  if not deps_on() { return }
  let f = file_open(getenv("LUDIC_DEPS"), "wb")
  if f == null { return }
  let seen = new []pointer
  var i = 0
  while i < len(g_mod_name) {
    let m = g_mod_name[i]
    var dup = false
    var j = 0
    while j < len(seen) {
      if (seen[j] == m) { dup = true }
      j += 1
    }
    if not dup and not (m == "") {
      push(seen, m)
      var pkg = 0
      if not (pkg_of_file(g_mod_file[i]) == "") { pkg = 1 }
      var uses: pointer = "-"
      let k = mod_find_uses(m)
      if k >= 0 { uses = g_mu_list[k] }
      var layer = mod_layer(m)
      if (layer == "") { layer = "-" }
      deps_line(f, `module {m} {itoa(pkg)} {uses} {layer}`)
    }
    i += 1
  }
  # a package with no module line of its own is named for its directory (module_for_uses)
  i = 0
  while i < len(g_pk_name) {
    let m = g_pk_name[i]
    var dup = false
    var j = 0
    while j < len(seen) {
      if (seen[j] == m) { dup = true }
      j += 1
    }
    if not dup and not (m == "") {
      push(seen, m)
      deps_line(f, `module {m} 1 - -`)
    }
    i += 1
  }
  i = 0
  while i < len(g_dp_key) {
    deps_line(f, `edge {g_dp_key[i]} {itoa(g_dp_cnt[i])} {g_dp_name[i]}`)
    i += 1
  }
  i = 0
  while i < len(g_dp_writes) {
    deps_line(f, g_dp_writes[i])
    i += 1
  }
  i = 0
  while i < len(g_dp_aliases) {
    deps_line(f, g_dp_aliases[i])
    i += 1
  }
  deps_widths(f)
  deps_reach(f)
  file_close(f)
}

# 0.R2: how many states each function and entry point takes - `width <n> <name> <file>:<line> <pkg>`,
# the program's own code only (not the runtime's)
function deps_widths(f: pointer) -> void {
  var i = 0
  while i < len(prog) {
    let d = prog[i]
    if d.file != null and not is_runtime_file(d.file) {
      var n = 0
      var name = d.s
      if d.kind == N_FN {
        var k = 0
        while k < len(d.kids) {
          if d.kids[k].kind == N_PARAM and is_state_ty(d.kids[k].ty) { n += 1 }
          k += 1
        }
      }
      if (d.kind == N_MAIN or d.kind == N_SYS) and d.a != null {
        if d.kind == N_MAIN { name = "entry" }
        n = deps_body_states(d.a)
      }
      var pkg = 0
      if not (pkg_of_file(d.file) == "") { pkg = 1 }
      if n > 0 { deps_line(f, `width {itoa(n)} {name} {d.file}:{itoa(d.line)} {itoa(pkg)}`) }
    }
    i += 1
  }
}
function deps_body_states(b: Node) -> int {
  var n = 0
  var k = 0
  while k < len(b.kids) and b.kids[k].tps != null and (b.kids[k].tps == "state") {
    n += 1
    k += 1
  }
  return n
}
# A local that holds another module's global record (or a piece of one) - `let t = thing_cur`,
# `let s = slots[i]` - writes into that module's state when it is written through: `t.used = 1`.
# That is caught here for a local bound straight from the global (or from such a local) in the
# function being lowered, and listed as `alias <owner> <global> <from> <file>:<line> <local>`. A
# reference that arrives any other way - returned by a function, read out of a field of another
# record - is not followed: that needs knowing where every reference can point, which this is not.
var g_dp_al_local: []pointer = new []pointer
var g_dp_al_owner: []pointer = new []pointer
var g_dp_al_global: []pointer = new []pointer
var g_dp_aliases: []pointer = new []pointer
function deps_alias_reset() -> void {
  if not deps_on() { return }
  g_dp_al_local = new []pointer
  g_dp_al_owner = new []pointer
  g_dp_al_global = new []pointer
}
function deps_alias_find(local: pointer) -> int {
  var i = len(g_dp_al_local) - 1
  while i >= 0 {
    if (g_dp_al_local[i] == local) { return i }
    i -= 1
  }
  return -1
}
function deps_alias_drop(local: pointer) -> void {
  let k = deps_alias_find(local)
  if k >= 0 { g_dp_al_local[k] = "" }
}
# the E_ID an index / field chain starts at
function deps_chain_root(t: Node) -> Node {
  var n = t
  while n != null and (n.kind == E_INDEX or n.kind == E_MEMBER) { n = n.a }
  if n == null or n.kind != E_ID { return null }
  return n
}
# 0.S: a chain rooted in a state parameter (`b_st.b_count`): the state's module and the field, when
# the state is another module's - else null
var g_dp_st_field: pointer = null
function deps_state_owner(t: Node) -> pointer {
  let r = deps_chain_root(t)
  if r == null { return null }
  let li = loc_find(r.s)
  if li < 0 or not is_state_ty(loc_ty[li]) { return null }
  let g = find_global(state_global(loc_ty[li]))
  if g == null or g.file == null { return null }
  let owner = module_for_uses(g.file)
  let from = module_of(g_err_file)
  if (from == "") or (owner == "") or (from == owner) { return null }
  var n = t
  g_dp_st_field = null
  while n != null and n != r {
    if n.kind == E_MEMBER and n.a == r { g_dp_st_field = n.s }
    n = n.a
  }
  if g_dp_st_field == null { g_dp_st_field = loc_ty[li] }
  return owner
}
# an assignment into another module's state, through the parameter that holds it
function deps_state_write(t: Node) -> bool {
  if not deps_on() or g_err_file == null { return false }
  let owner = deps_state_owner(t)
  if owner == null { return false }
  push(g_dp_writes, `write {owner} {g_dp_st_field} {module_of(g_err_file)} {g_err_file}:{itoa(g_err_line)}`)
  return true
}
# `let local = <expr>`: an alias when the expression is another module's global, or an alias
function deps_alias_let(local: pointer, e: Node) -> void {
  if not deps_on() or g_err_file == null { return }
  deps_alias_drop(local)
  if e == null { return }
  let r = deps_chain_root(e)
  if r == null { return }
  if loc_find(r.s) >= 0 {
    let so = deps_state_owner(e)                 # a field of another module's state
    if so != null {
      push(g_dp_al_local, local)
      push(g_dp_al_owner, so)
      push(g_dp_al_global, g_dp_st_field)
      return
    }
    let k = deps_alias_find(r.s)
    if k < 0 { return }
    push(g_dp_al_local, local)
    push(g_dp_al_owner, g_dp_al_owner[k])
    push(g_dp_al_global, g_dp_al_global[k])
    return
  }
  let g = find_global(r.s)
  if g == null or g.file == null { return }
  let owner = module_for_uses(g.file)
  let from = module_of(g_err_file)
  if (from == "") or (owner == "") or (from == owner) { return }
  push(g_dp_al_local, local)
  push(g_dp_al_owner, owner)
  push(g_dp_al_global, r.s)
}
# an assignment through a local's field or element: a write into the state the local aliases
function deps_alias_write(t: Node) -> void {
  if not deps_on() or g_err_file == null { return }
  let r = deps_chain_root(t)
  if r == null or loc_find(r.s) < 0 { return }
  let k = deps_alias_find(r.s)
  if k < 0 { return }
  push(g_dp_aliases, `alias {g_dp_al_owner[k]} {g_dp_al_global[k]} {module_of(g_err_file)} {g_err_file}:{itoa(g_err_line)} {r.s}`)
}
# 0.R4: the states a function REACHES - its own, and every state of every function it can come to:
# by a call, by `fn f` written in it, or by reading a global whose value holds `fn f` (a step list,
# a registry of fn values). A function value's states are supplied where it is called, so a step list
# or a reducer that walks one takes none itself and still reaches all of them.
# `reach <n> <name> <file>:<line> <pkg>`, for each of the program's functions that reaches any.
var g_dr_name: []pointer = new []pointer        # the declarations a name can reach: functions, globals
var g_dr_node: []Node = new []Node
var g_dr_refs: [][]int = new [][]int            # what each one names
var g_dr_bits: [][]int = new [][]int            # the states it reaches, 60 to a word
var g_dr_wbits: [][]int = new [][]int           # ... and of them the ones it takes `mut` somewhere down
var g_dr_find_k: []pointer = new []pointer
var g_dr_rl_name: []pointer = new []pointer     # a local holding one entry of a registry ...
var g_dr_rl_reg: []pointer = new []pointer      # ... and which registry
var g_dr_find_v: []Node = new []Node
function dr_state_ix(t: pointer) -> int {
  var i = 0
  while i < len(g_state_names) {
    if (g_state_names[i] == t) { return i }
    i += 1
  }
  return -1
}
function dr_set(bits: []int, s: int) -> void { bits[s / 60] = bits[s / 60] | (1 << (s % 60)) }
function dr_words() -> int { return len(g_state_names) / 60 + 1 }
function dr_index(name: pointer) -> int {
  let n = ck_tab_get(g_dr_find_k, g_dr_find_v, name)
  if n == null { return -1 }
  return n.ival
}
function dr_walk(n: Node, refs: []int) -> void {
  if n == null { return }
  if dr_port_member(n, refs) { return }
  if n.kind == S_LET and n.s != null and n.a != null and n.a.kind == E_INDEX and n.a.a != null and n.a.a.kind == E_ID and n.a.a.s != null and reg_find(n.a.a.s) >= 0 {
    push(g_dr_rl_name, n.s)
    push(g_dr_rl_reg, n.a.a.s)
    dr_walk(n.a.b, refs)
    return
  }
  if dr_reg_field(n, refs) { return }
  if (n.kind == E_ID or n.kind == E_FNREF) and n.s != null {
    let k = dr_index(n.s)
    if k >= 0 { push(refs, k) }
    # a registry entry held in a local and handed on whole reaches the whole registry
    let rl = dr_reg_local(n.s)
    if k < 0 and rl != null and dr_index(rl) >= 0 { push(refs, dr_index(rl)) }
  }
  dr_walk(n.a, refs)
  dr_walk(n.b, refs)
  dr_walk(n.c, refs)
  if n.kids != null {
    var i = 0
    while i < len(n.kids) {
      dr_walk(n.kids[i], refs)
      i += 1
    }
  }
}
# `Port.member` reaches what that member is bound to (or its default), not every member of the port:
# a port asked for its save is not asked for its load
function dr_port_member(n: Node, refs: []int) -> bool {
  if n.kind != E_MEMBER or n.a == null or n.a.kind != E_ID or n.a.s == null or n.s == null { return false }
  let k = dr_index(n.a.s)
  if k < 0 { return false }
  let v = g_dr_node[k]
  if not is_port_var(v) { return false }
  if v.a != null and v.a.kind == E_NEW and v.a.a != null {
    let rec = v.a.a
    var i = 0
    while i < len(rec.kids) {
      if (rec.kids[i].s == n.s) {
        dr_walk(rec.kids[i].a, refs)
        return true
      }
      i += 1
    }
  }
  let c = g_pt_comp[port_find(v.s)]
  var j = 0
  while j < len(c.kids) {
    if (c.kids[j].s == n.s) { dr_walk(c.kids[j].a, refs) }
    j += 1
  }
  return true
}
# `Registry[i].field` reaches what that field holds in each entry, not every fn of every field: a
# kind asked whether it is personal is not asked to be used
function dr_reg_local(name: pointer) -> pointer {
  var i = len(g_dr_rl_name) - 1
  while i >= 0 {
    if (g_dr_rl_name[i] == name) { return g_dr_rl_reg[i] }
    i -= 1
  }
  return null
}
function dr_reg_field(n: Node, refs: []int) -> bool {
  if n.kind != E_MEMBER or n.s == null or n.a == null { return false }
  var reg: pointer = null
  if n.a.kind == E_INDEX and n.a.a != null and n.a.a.kind == E_ID and n.a.a.s != null and reg_find(n.a.a.s) >= 0 {
    reg = n.a.a.s
    dr_walk(n.a.b, refs)
  }
  if reg == null and n.a.kind == E_ID and n.a.s != null { reg = dr_reg_local(n.a.s) }
  if reg == null { return false }
  let k = dr_index(reg)
  if k < 0 { return false }
  let v = g_dr_node[k]
  if v.kind != N_VAR or v.a == null or v.a.kind != E_LIST { return false }
  var i = 0
  while i < len(v.a.kids) {
    let e = v.a.kids[i]
    if e.kind == E_NEW and e.a != null {
      var j = 0
      while j < len(e.a.kids) {
        if (e.a.kids[j].s == n.s) { dr_walk(e.a.kids[j].a, refs) }
        j += 1
      }
    }
    i += 1
  }
  return true
}
function dr_own(d: Node, bits: []int, only_mut: bool) -> void {
  if d.kind == N_FN {
    var k = 0
    while k < len(d.kids) {
      if d.kids[k].kind == N_PARAM and (not only_mut or d.kids[k].uns == 1) {
        let s = dr_state_ix(d.kids[k].ty)
        if s >= 0 { dr_set(bits, s) }
      }
      k += 1
    }
  }
}
function dr_count(bits: []int) -> int {
  var n = 0
  var i = 0
  while i < len(bits) {
    var w = bits[i]
    while w != 0 {
      n += w & 1
      w = w >> 1
    }
    i += 1
  }
  return n
}
# `mine` takes in `theirs`; true when it grew
function dr_join(mine: []int, theirs: []int, nw: int) -> bool {
  var grew = false
  var w = 0
  while w < nw {
    let u = mine[w] | theirs[w]
    if u != mine[w] {
      mine[w] = u
      grew = true
    }
    w += 1
  }
  return grew
}
function deps_reach(f: pointer) -> void {
  ck_tab_init(g_dr_find_k, g_dr_find_v)
  var i = 0
  while i < len(prog) {
    let d = prog[i]
    if d.s != null and (d.kind == N_FN or d.kind == N_VAR or d.kind == N_CONST) and ck_tab_get(g_dr_find_k, g_dr_find_v, d.s) == null {
      let h = new Node
      h.ival = len(g_dr_node)
      ck_tab_put(g_dr_find_k, g_dr_find_v, d.s, h)
      push(g_dr_name, d.s)
      push(g_dr_node, d)
    }
    i += 1
  }
  let nw = dr_words()
  var j = 0
  while j < len(g_dr_node) {
    let refs = new []int
    g_dr_rl_name = new []pointer
    g_dr_rl_reg = new []pointer
    dr_walk(g_dr_node[j], refs)
    push(g_dr_refs, refs)
    let bits = new []int
    var w = 0
    while w < nw {
      push(bits, 0)
      w += 1
    }
    dr_own(g_dr_node[j], bits, false)
    push(g_dr_bits, bits)
    let wb = new []int
    var w3 = 0
    while w3 < nw {
      push(wb, 0)
      w3 += 1
    }
    dr_own(g_dr_node[j], wb, true)
    push(g_dr_wbits, wb)
    j += 1
  }
  var changed = true
  while changed {                                # to a fixed point: what a callee reaches, the caller does
    changed = false
    j = 0
    while j < len(g_dr_node) {
      let refs = g_dr_refs[j]
      var r = 0
      while r < len(refs) {
        if dr_join(g_dr_bits[j], g_dr_bits[refs[r]], nw) { changed = true }
        if dr_join(g_dr_wbits[j], g_dr_wbits[refs[r]], nw) { changed = true }
        r += 1
      }
      j += 1
    }
  }
  j = 0
  while j < len(g_dr_node) {
    let d = g_dr_node[j]
    if d.kind == N_FN and d.file != null and not is_runtime_file(d.file) {
      let n = dr_count(g_dr_bits[j])
      var pkg = 0
      if not (pkg_of_file(d.file) == "") { pkg = 1 }
      if n > 0 { deps_line(f, `reach {itoa(n)} {d.s} {d.file}:{itoa(d.line)} {itoa(pkg)}`) }
      let wn = dr_count(g_dr_wbits[j])
      if wn > 0 { deps_line(f, `wreach {itoa(wn)} {d.s} {d.file}:{itoa(d.line)} {itoa(pkg)}`) }
    }
    j += 1
  }
}