# Copyright 2005 Kevin Reid, under the terms of the MIT X license
# found at http://www.opensource.org/licenses/mit-license.html ................

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

def EventuallyDeepFrozen := DeepFrozen."eventually"()

def makeAstroTag := <import:org.quasiliteral.astro.makeAstroTag>
def AstroTag := makeAstroTag.asType()

def makeTermAuthor(SelflessStamp) {
  def TermStamp implements DeepFrozen { 
    to audit(_, _) { return true }
  }

  def printSeps implements DeepFrozen { to run(tw, args) {
    var sep := ""
    for arg in args { 
      tw.write(sep)
      if (__auditedBy(TermStamp, arg)) {
        tw.print(arg)
      } else {
        tw.quote(arg)
      }
      sep := ", "
    }
  }}
  
  def magicPrintTable := [
    makeAstroTag(null, ".bag.", nullOk) => def "$bagPrinter" implements DeepFrozen { to run(out, term) {
      out.write("{")
      printSeps(out, term.getArgs())
      out.write("}")
    }},
    makeAstroTag(null, ".tuple.", nullOk) => def "$tuplePrinter" implements DeepFrozen { to run(out, term) {
      out.write("[")
      printSeps(out, term.getArgs())
      out.write("]")
    }},
    makeAstroTag(null, ".attr.", nullOk) => def "$attrPrinter" implements DeepFrozen { to run(out, term) {
      def [attrBody] := term.getArgs() # XXX handle "wrong" number of args case
      out.print(attrBody.getTag().getTagName()) # XXX wrong: doesn't print data, for example
      out.write(": ")
      def [attrValue] := attrBody.getArgs()
      out.print(attrValue)
    }},
  ]

  def defaultTermPrint implements DeepFrozen { to run(tw, term) {
    def tag := term.getTag()
    def data := term.getData()
    def args := term.getArgs()
    if (tag.getTagName() != `.${data.__getAllegedType().getFQName().split(".").last().split("$").last()}.`) {
      # XXX ask *something* about whether this tag is the canonical tag (in what context?) for the data so that it may be printed if it isn't
      tw.print(tag.getTagName())
    }
    if (data != null) { 
      # XXX perhaps we should ask the tag to print the data
      tw.quote(data)
    }
    
    if (args.size() > 0) {
      tw.write("(")
      printSeps(tw, args)
      tw.write(")")
    }
  }}
  
  def makeTerm
  
  def _StandardTerm
  def StandardTerm extends _StandardTerm implements EventuallyDeepFrozen {
    method __optSealedDispatch(brand) :any {
      if (brand == EventuallyDeepFrozen.getPeekBrand()) {
        EventuallyDeepFrozen.getPeekSealer().seal(meta.getState())
      }
    }
  
    to __printOn(tw :TextWriter) {
      tw.print("Term")
    }
    
    to get(Tag, TData, Arg) {
      def Term extends __makeGuard(Term) implements EventuallyDeepFrozen {
        method __optSealedDispatch(brand) :any {
          if (brand == EventuallyDeepFrozen.getPeekBrand()) {
            EventuallyDeepFrozen.getPeekSealer().seal(meta.getState())
          }
        }
        
        to __printOn(tw :TextWriter) {
          tw.print("Term")
          if (!__equalizer.sameYet(Term, _StandardTerm)) {
            tw.quote([Tag, TData, Arg])
          }
        }
        
        to coerce(specimen, optEjector) {
          def generalTerm := escape accept {
            # XXX should reuse standard-coerce from the Lisp side
            if (__auditedBy(TermStamp, specimen)) {
              accept(specimen)
            } else {
              def coerced := specimen.__conformTo(Term)
              if (__auditedBy(TermStamp, coerced)) {
                accept(coerced)
              } else {
                # xxx exception type?
                throw.eject(optEjector, `not a $Term: ${E.toQuote(specimen)}`)
              }
            }
          }
          
          # XXX arrange ...somehow... to not reconstruct if the tree already fits
          return makeTerm(Tag.coerce(specimen.getTag(), optEjector),
                          TData.coerce(specimen.getData(), optEjector),
                          specimen.getOptSpan(),
                          List[Arg].coerce(specimen.getArgs(), optEjector))
        }
      }
      return Term
    }
  }
  bind _StandardTerm := StandardTerm[AstroTag, any[nullOk, int, float64, char, Twine], _StandardTerm]
     
  bind makeTerm := def "$makeTerm" implements EventuallyDeepFrozen {
    method __optSealedDispatch(brand) :any {
      if (brand == EventuallyDeepFrozen.getPeekBrand()) {
        EventuallyDeepFrozen.getPeekSealer().seal(meta.getState())
      }
    }
    
    /** Return the guard for standard Terms. */
    to asType() {
      return StandardTerm
    }
    
    to run(tag :AstroTag, 
           data :(tag.getDataGuard()),
           optSpan :nullOk, # XXX SourceSpan
           args :List) { # NOTE: unrestricted - XXX must offer default-compatible restrictive guard
      def term implements SelflessStamp, TermStamp { # , PassByCopyStamp
        to __optUncall() {
          # indirect self-reference is to simplify DeepFrozen checking
          return [<import:org.quasiliteral.term.makeTerm>, "run", [tag, data, optSpan, args]]
        }
        
        to getTag()     { return tag }
        to getData()    { return data }
        to getOptSpan() { return optSpan }
        to getArgs()    { return args }
        
        to getTerms() { return [term] }
        
        to __printOn(tw :TextWriter) {
          # XXX this should probably be in some TermUnparser object
          
          tw.write(tw.isQuoting().pick("term`", ""))
          
          magicPrintTable.fetch(tag, thunk { defaultTermPrint })(tw, term)
          
          
          tw.write(tw.isQuoting().pick("`", ""))
        }
      }
      return term
    }
  }
  return makeTerm
}