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

pragma.syntax("0.9")

def EventuallyDeepFrozen :(<import:org.erights.e.elib.slot.Same>)[DeepFrozen."eventually"()] := DeepFrozen."eventually"()

def makeAstroTag := <import:org.quasiliteral.astro.makeAstroTag>
def AstroTag := makeAstroTag.asType()
def SourceSpan := <elib:base.makeSourceSpan>.asType()

def makeTermAuthor(TransparentStamp) {
  def TermStamp :DeepFrozen := {def TermStamp implements DeepFrozen { 
    to audit(_) { return true }
  }}

  def printSeps :DeepFrozen := {def printSeps(tw, args) implements DeepFrozen {
    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(out, term)  implements DeepFrozen {
      out.write("{")
      printSeps(out, term.getArgs())
      out.write("}")
    },
    makeAstroTag(null, ".tuple.", nullOk) => def tuplePrinter(out, term)  implements DeepFrozen {
      out.write("[")
      printSeps(out, term.getArgs())
      out.write("]")
    },
    makeAstroTag(null, ".attr.", nullOk) => def attrPrinter(out, term) implements DeepFrozen {
      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(tw, term) implements DeepFrozen {
    def tag := term.getTag()
    def data := term.getData()
    def args := term.getArgs()
    
    def dataTypeName := data.__getAllegedType().getFQName().split(".").last().split("$").last()
    
    if (tag.getTagName() != `.$dataTypeName.` && 
          tag.getTagName() != `.${dataTypeName(0,1).toUpperCase() + dataTypeName(1)}.`) {
      # 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 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 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[SourceSpan],
           args :List) { # NOTE: unrestricted - XXX must offer default-compatible restrictive guard
      def term implements Selfless, TransparentStamp, TermStamp {
        to __optUncall() {
          return [makeTerm, "run", [tag, data, optSpan, args]]
        }
        
        to getTag()     { return tag }
        to getData()    { return data }
        to getOptSpan() { return optSpan }
        to getArgs()    { return args }

        /** E-on-Java compatibility */
        to getOptData() { return data }
        
        to withoutArgs() {
          return makeTerm(tag, data, optSpan, [])
        }
        
        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, fn { defaultTermPrint })(tw, term)
          
          
          tw.write(tw.isQuoting().pick("`", ""))
        }
      }
      return term
    }
  }
  return makeTerm
}