# 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 mapStream :DeepFrozen := <import:org.cubik.cle.io.mapStream>
def makeTermLexer :DeepFrozen := <import:org.quasiliteral.term.makeTermLexer>

def makeTermParser implements DeepFrozen, ExitViaHere {
  to run(builder) {

    # XXX move outside once it is DeepFrozen
    def lalr1__quasiParser := <import:org.cubik.cle.parser.makeLALR1Parser>.getLalr1__quasiParser()
  
    def b := builder
    def leafDataAction(data) { return b.leafData(data, null) } # XXX SourceSpan
    
    def termLexer := makeTermLexer(builder.doesQuasis())
    
    def lparser := lalr1`
      "TermL" := start.
      start := termRep                      => ${b.start}.
      
      termRep := term                       => $__identityFunc.
      termRep := term ${"*"}                => ${def _(t,_) { return \
                                                  b.some(t,'*')}}.
      termRep := term ${"+"}                => ${def _(t,_) { return \
                                                  b.some(t,'+')}}.
      termRep := term ${"?"}                => ${def _(t,_) { return \
                                                  b.some(t,'?')}}.
      
      term := functor                       => ${b.term}.
      term := functor lpar argList rpar     => ${def _(f,_,a,_) { return \
                                                  b.term(f,a)}}.
      term := functor lbr argList rbr       => ${def _(f,_,a,_) { return \
                                                  b.term(f,b.bag(a))}}.
      term := lbr argList rbr               => ${def _(_,a,_) { return \
                                                  b.bag(a)}}.
      term := ${"["} argList ${"]"}         => ${def _(_,a,_) { return \
                                                  b.tuple(a)}}.
      term := functor ${":"} termRep        => ${def _(f,_,a) { return \
                                                  b.attr(f,a)}}.

      argList :=                            => ${b.empty}.
      argList := termRep                    => $__identityFunc.
      argList := termRep ${","} argList     => ${def _(l,_,r) { return \
                                                  b.seq(l,r)}}.

      functor := tag                        => $__identityFunc.
      functor := literal                    => $__identityFunc.
      functor := functorHole                => $__identityFunc.
      functor := tag functorHole            => ${b.taggedHole}.

      functorHole := ${"Quasi$"}            => ${b.valueHole}.
      functorHole := ${"Quasi@"}            => ${b.patternHole}.

      tag := ${"Tag"}                       => ${b.tag}.

      literal := ${"Integer"}               => $leafDataAction.
      literal := ${"Float64"}               => $leafDataAction.
      literal := ${"Char"}                  => $leafDataAction.
      literal := ${"String"}                => $leafDataAction.
      
      lbr := ${"{"}.
      rbr := ${"}"}.
      lpar := ${"("}.
      rpar := ${")"}.
    `
    # lbr and rbr are necessary only due to a current limitation in lalr1__quasiParser.
    
    def termParser {
      /** Parse the given stream of term-language text to a quasi-term tree. */
      to parseText(textStream) {
        return termParser.parse(termLexer(textStream))
      }
      
      /** Parse the given stream of term-language tokens to a quasi-term tree. */
      to parse(lexStream) {
        return lparser.parse(mapStream(any, lexStream, def tf(t) {
          return switch (t) {
            match [x] { [x, null] }
            match [x,y] { [x, y] }
            match [x] + y { [x, y] }
          }
        }))
      }
    }
    return termParser
  }
}