pragma.enable("easy-return")
pragma.disable("explicit-result-guard")

pragma.enable("accumulator")
pragma.enable("verb-curry")
pragma.enable("anon-lambda")

def map {
  to v(f, coll) {
    return accum [] for v in coll {_.with(f(v))}}
  to kv(f, coll) {
    return accum [] for k => v in coll {_.with(f(k, v))}}
}    

def makeSV(text, temps) {
  return def sv {
    to withTemp(t) { return makeSV(text, temps.with(t)) }
    to out(ts) { ts.addAll(temps); return text }
    to outz() { return text }
  }
}

var i := 0

def implicitSV := makeSV("", [].asSet())
def selfKit {
  to fresh() {
    return makeSV(def t := `e_t${i += 1}`, [].asSet())
  }
  to temp() {
    #if (i == 39) {throw("break") }
    return [makeSV(def t := `e_t${i += 1}`, [t].asSet()),
            fn expr { def tc := [t].asSet().diverge(); makeSV(`$t: (${expr.out(tc)})`, tc.snapshot()) }]
  }
  to param(name) {
    # XXX should have syntax type tags
    return makeSV(`:${name.outz()}`, [].asSet())
  }
  to literal(v) {
    return switch (v) {
      match s :String { makeSV(`'${v.replaceAll("\\", "\\\\").replaceAll("'", "\\'")}'`, [].asSet()) }
      match c :char { selfKit.message(selfKit.message(selfKit.message("erights"), "character", []), "copyValue:", [selfKit.literal(c.asInteger())]) }
      match n :int     { makeSV(`$i`, [].asSet()) }
      match n :float64 { makeSV(`$n`, [].asSet()) }
    }
  }
  to message(selector :String) { return selfKit.message(null, selector, []) }
  to message(selector :String, args) { return selfKit.message(null, selector, args) }
  to message(recipient, selector :String, args) { 
    var st := ""
    def tc := [].asSet().diverge()
    def selParts := selector.split(":") # XXX identifier syntax check
    if (recipient == null) {
      st += `${selParts[0]}`
    } else {
      st += `(${recipient.out(tc)}) ${selParts[0]}`
    }
    for i => next in selParts(1) {
      st += `: (${args[i].out(tc)}) $next`
    }
    st += ""
    return makeSV(st, tc.snapshot()) 
  }
  to object(slots) {
    var st := ""
    def tc := [].asSet().diverge()
    for nameandtype => value in slots {
      # XXX identifier syntax check
      st += `$nameandtype ${value.out(tc)}.$\n`
    }
    return makeSV(`(| $st |)`, tc.snapshot())
  }
  to seq(subs) {
    require(subs.size() > 0)
    var st := []
    def tc := [].asSet().diverge()
    for sub in subs {
      st with= sub.out(tc)
    }
    return makeSV(".\n".rjoin(st), tc.snapshot())
  }
  to metho(args, body) {
    var st := []
    def tc := [].asSet().diverge()
    for arg in args {
      st with= arg.out(tc)
    }
    def bodyText := body.out(tc)
    return makeSV(`(| ${". ".rjoin(st + tc.snapshot().getElements())} | $bodyText )`, [].asSet())
  }
  to block(args, body) {
    var st := []
    def tc := [].asSet().diverge()
    for arg in args {
      st with= arg.out(tc)
    }
    def bodyText := body.out(tc)
    return makeSV(`[| ${". ".rjoin(st + tc.snapshot().getElements())} | $bodyText ]`, [].asSet())
  }
}

def unsv(sv) {
  def tc := [].asSet().diverge()
  def text := sv.out(tc)
  return `| ${". ".rjoin(tc.getElements())} | $text`
}


def compilePat

def objectCommon := selfKit.message(selfKit.message(`erights`), `closure`, [])

def convertVerb(verb, arity) {
  return switch (arity) {
    match ==0 { `em_$verb` }
    match ==1 { `em_$verb:` }
    match _   { `em_$verb:${"With:" * (arity - 1)}` }
  }
}

def compile(expr, out) {
  return expr.welcome(def visitor {
    to visitLiteralExpr(_, v) { return out(selfKit.literal(v)) }
    to visitNounExpr(_, n) { return out(selfKit.message(selfKit.message(`e_noun_$n`), "em_getValue", [])) }
    to visitSlotExpr(_, n) { return out(selfKit.message(`e_noun_${n.getName()}`)) }
    to visitSeqExpr(_, subs) { return selfKit.seq(map.v(fn sub { compile(sub, __identityFunc) }, subs(0, subs.size() - 1)) + [compile(subs.last(), out)]) }
    to visitCallExpr(_, rec, verb, args) {
      def [rtemp, rout] := selfKit.temp()
      def atemps := accum [] for _ in args { _.with(selfKit.temp()) }
      def selector := convertVerb(verb, args.size())
      return selfKit.seq([compile(rec, rout)] +
                         map.kv(fn i,v { compile(v, atemps[i][1]) }, args) +
                         [out(selfKit.message(rtemp, selector, map.v(fn t{t[0]}, atemps)))])
    }
    to visitDefineExpr(_, pat, expr, ej) {
      # XXX compile ej
      def [temp, tout] := selfKit.temp()
      return selfKit.seq([compile(expr, tout),
                          compilePat(pat, temp, null),
                          out(temp)])
    }
    to visitAssignExpr(_, lv, rv) {
      def [temp, tout] := selfKit.temp()
      return selfKit.seq([compile(rv, tout),
                          selfKit.message(selfKit.message(`e_noun_${lv.getName()}`), "em_setValue:", [temp]),
                          out(temp)])
    }
    to visitEscapeExpr(_, pat, body, cp, cb) {
      def exit := selfKit.fresh()
      require(cp == null && cb == null)
      return out(selfKit.message(selfKit.block([selfKit.param(exit)], 
                                   selfKit.seq([compilePat(pat, exit, null),
                                                compile(body, out)])),
                                 "eEscape", []))
    }
    to visitFinallyExpr(_, body, cleanup) {
      return compile(body, out) # XXX fix
    }
    to visitHideExpr(_, body) {
      # A block isn't necessary here; it's just the simplest way to compile this.
      return out(makeSV(`[ ${unsv(compile(body, __identityFunc))} ] value`, [].asSet()))
    }
    to visitMatchBindExpr(_, specimen, pattern) {
      # XXX ejector
      def [temp, tout] := selfKit.temp()
      return selfKit.seq([compile(specimen, tout),
                          compilePat(pattern, temp, Ref.broken("missing ejector stuff")),
                          out(selfKit.message("true"))])
    }
    to visitIfExpr(_, cond, then, els) {
      # XXX coerce to boolean
      def [ctemp, cout] := selfKit.temp()
      return selfKit.seq([
        compile(cond, cout),
        selfKit.message(ctemp, "ifTrue:False:", [
          selfKit.block([], compile(then, __identityFunc)),
          selfKit.block([], compile(els, __identityFunc))]),
      ])
    }
    to visitObjectExpr(_, docComment, name, auditors, script) {
      # XXX auditors
      def used := script.staticScope().namesUsed().domain()
      
      # XXX result guard
      def traits := selfKit.object(["parent* =" => objectCommon, "e_doc =" => selfKit.literal(docComment), "e_qualifiedName =" => selfKit.literal(name)] | accum [].asMap() for m in script.getOptMethods() { 
        _.with(convertVerb(m.getVerb(), m.getPatterns().size()) + " = ", 
          def cv := compile(m.getBody(), __identityFunc)
          def atemps := accum [] for _ in m.getPatterns() { _.with(selfKit.fresh()) }
          selfKit.metho(map.v(selfKit.param, atemps),
                        selfKit.seq(map.kv(fn i,p { compilePat(p, atemps[i], null) }, m.getPatterns()) + [cv])))
      })
      
      def prototype := selfKit.object(["parent* =" => traits] | accum [].asMap() for noun in used { _.with(`e_noun_$noun <-`, selfKit.message(`nil`)) })
      var obj := selfKit.message(prototype, `clone`, [])
      for noun in used {
        obj := selfKit.message(obj, `e_noun_$noun:`, [selfKit.message(`e_noun_$noun`)])
      }
      return out(obj)
    }
    to visitMetaContextExpr(n) {
      return selfKit.message("error:", [selfKit.literal(`$n not implemented`)])
    }
    to visitMetaStateExpr(n) {
      return selfKit.message("error:", [selfKit.literal(`$n not implemented`)])
    }
  })
}

def compileBindingPattern(ne, guardE, slotCompile, slotCompileGuarded) {
  def slotslot := `e_noun_${ne.getName()}`
  if (guardE == null) {
    return selfKit.message(`$slotslot:`, [slotCompile()]).withTemp(slotslot)
  } else {
    def [gtemp, gout] := selfKit.temp()
    return selfKit.seq([compile(guardE, gout),
                        selfKit.message(`$slotslot:`, [slotCompileGuarded(gtemp)]).withTemp(slotslot)])
  }
}

def cMakeFinalSlot := selfKit.message(selfKit.message(`erights`), `makeFinalSlot`, [])
def cMakeVarSlot := selfKit.message(selfKit.message(`erights`), `makeVarSlot`, [])
def cMakeGuardedSlot := selfKit.message(selfKit.message(`erights`), `makeGuardedSlot`, [])

bind compilePat(pat, specimen, optEjSpec) {
  return pat.welcome(def visitor {
    to visitIgnorePattern(_) {
      return selfKit.message(`nil`)
    }
    to visitFinalPattern(_, ne, guardE) {
      return compileBindingPattern(ne, guardE, 
        fn { selfKit.message(cMakeFinalSlot, `em_run:`, [specimen]) },
        fn guard { selfKit.message(cMakeFinalSlot, `em_run:`, [selfKit.message(guard, `em_coerce:With:`, [specimen, guard])]) })
    }
    to visitVarPattern(_, ne, guardE) {
      return compileBindingPattern(ne, guardE,
        fn { selfKit.message(cMakeVarSlot, `em_run:`, [specimen]) },
        fn guard { selfKit.message(cMakeGuardedSlot, `em_run:`, [specimen, guard]) })
    }
    to visitSlotPattern(_, ne, guardE) {
      return compileBindingPattern(ne, guardE, 
        fn { specimen },
        fn guard { selfKit.message(guard, `em_coerce:With:`, [specimen, guard]) })
    }
    to visitListPattern(_, subs) {
      # XXX coerce, length
      return selfKit.seq(accum [] for i => sub in subs { _.with(
        compilePat(sub, selfKit.message(specimen, "at:", [selfKit.literal(i)]), optEjSpec)
      )} + [selfKit.message(`nil`)])
    }
    to visitSuchThatPattern(_, subpatt, test) {
      # XXX coerce test result to boolean
      def [ttemp, tout] := selfKit.temp()
      return selfKit.seq([compilePat(subpatt, specimen, optEjSpec),
                          compile(test, tout),
                          selfKit.message(ttemp, "ifFalse:", [selfKit.block([], selfKit.message("error:", [selfKit.literal("such-that expression was false")]))])])
    }
  })
}

def outerCompile(expr) {
  return `[${unsv(compile(expr, __identityFunc))} ] value`
}

#def [filename] := interp.getArgs()
#def expr := <elang:syntax.makeEParser>.run(<file>[filename].getTwine())
#
#println(outerCompile(expr))