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)
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_find_k: []pointer = new []pointer
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 (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) }
  }
  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
    }
  }
}
function dr_own(d: Node, bits: []int) -> void {
  if d.kind == N_FN {
    var k = 0
    while k < len(d.kids) {
      if d.kids[k].kind == N_PARAM {
        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
}
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
    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)
    push(g_dr_bits, bits)
    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 mine = g_dr_bits[j]
      let refs = g_dr_refs[j]
      var r = 0
      while r < len(refs) {
        let theirs = g_dr_bits[refs[r]]
        var w2 = 0
        while w2 < nw {
          let u = mine[w2] | theirs[w2]
          if u != mine[w2] {
            mine[w2] = u
            changed = true
          }
          w2 += 1
        }
        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)}`) }
    }
    j += 1
  }
}