patterns.rv

import { ... } from "./core.rv"
import { ... } from "./bootstrap.rv"
import { record, upsertkey, merge } from "./record.rv"

export {
  Any, NotNil, Params, Pattern
  match, matchTrait, castTrait, isa?
}

castTrait = tag"/castTrait"

fn matchTrait($Tag, t: pack($Tag, _)) { Some(t) }
fn matchTrait($Closure, x: pack($Closure, _)) { Some(x) }
fn matchTrait($Func, x: pack($Func, _)) { Some(x) }

Any = tag"/Any"

fn matchTrait($Any, x) { Some(x) }

NotNil = tag"/NotNil"

fn matchTrait($NotNil, x) {
  if !nil?(x) { Some(notnil(x)) }
}

bundle Params(T, Ts)

@extend
fn show(pack($Params, T, Ts...)) {
  show(T)
  show(Ts)
}

bundle Pattern {
  Hole()
  Literal(x)
  Trait(T)
  Pack(xs...)
  Bind(name, pat)
  Constructor(name, args...)
  And(p, q)
}

fn constructorPattern($pack, args...) {
  Pack(args...)
}

fn _match(val, pack($Hole), deep) {
  return [val, record()]
}

fn _match(val, pack($Literal, pat), deep) {
  (val == pat) || return
  return [pat, record()]
}

fn _match(val, pack($Trait, T), deep) {
  m = if deep { castTrait(T, val) } else { matchTrait(T, val) }
  nil?(m) && return
  return [part(notnil(m), 1), record()]
}

fn _match(val, pack($Bind, name, p), deep) {
  m = _match(val, p, deep)
  nil?(m) && return
  m = notnil(m)
  val = part(m, 1)
  bs = part(m, 2)
  upsertkey(&bs, name, val)
  return [val, bs]
}

fn _match(xs, p: Pack, deep) {
  eq(nparts(xs), nparts(p) - 1) || return
  m = _match(tag(xs), part(p, 1), deep)
  nil?(m) && return
  m = notnil(m)
  tag = part(m, 1)
  xs = tagcast(xs, tag)
  result = [pack(tag), part(m, 2)]
  i = 1
  while i < nparts(p) {
    if !nil?(result) {
      m = _match(part(xs, i), part(p, i + 1), deep)
      if nil?(m) {
        result = nil
      } else {
        m = notnil(m)
        r = notnil(result)
        bs = merge(part(r, 2), part(m, 2))
        if nil?(bs) {
          result = nil
        } else {
          result = [packcat(part(r, 1), [part(m, 1)]), notnil(bs)]
        }
      }
    } else {
      # if the above is certain to fail, make sure the whole match is
      result = nil
    }
    i = i + 1
  }
  return result
}

fn _match(val, pack($Constructor, name, args...), deep) {
  _match(val, constructorPattern(name, args...), deep)
}

fn match(val, pat) {
  result = _match(val, pat, false)
  nil?(result) && return
  return part(notnil(result), 2)
}

fn isa?(val, T) {
  !nil?(matchTrait(T, val))
}