class ThemeParser

rule

  program : topexpr             { result = val[0] }

  # experimental
  topexpr : whereexpr
          | LET identifier '=' lambdaexpr IN topexpr
                 # Desugar let:  let x = y in z  ==>  (x->z)(y)
                 { result = Call.new(Lambda.new(nil, val[1], val[5]), val[3]) }

  whereexpr : lambdaexpr
            | whereexpr WHERE identifier '=' lambdaexpr
                 # Desugar where:  z where x = y  ==>  (x->z)(y)
                 { result = Call.new(Lambda.new(nil, val[2], val[0]), val[4]) }

  lambdaexpr : lambdaexpr1
             | lambdaexpr1 '|' lambdaexpr     # Right recursion for semantics.
                 { result = Chain.new(val[0], val[2]) }
             | caseexpr

  lambdaexpr1 : opexpr ARROW lambdaexpr1      # Right recursion for semantics.
                 { result = Lambda.new(nil, val[0], val[2]) }
              | opexpr ARROW caseexpr
                 { result = Lambda.new(nil, val[0], val[2]) }
              | identifier1 '@' opexpr ARROW lambdaexpr1
                 { result = Lambda.new(val[0], val[2], val[4]) }
              | identifier1 '@' opexpr ARROW caseexpr
                 { result = Lambda.new(val[0], val[2], val[4]) }

  caseexpr : opexpr
           | CASE opexpr OF parenexpr
                 # Desguar case:  case a of b  ==>  (b)(a)
                 { result = Call.new(val[3], val[1]) }

  opexpr : callexpr
         | opexpr operator callexpr
                 { result = Call.new(Call.new(val[1], val[0]), val[2]) }

  operator : OP                 { result = Variable.new(val[0]) }
           | OPATOM             { result = Variable.new(val[0]) }
           | '`' IDENTIFIER '`' { result = Variable.new(val[1]) }

  callexpr : primexpr
           | callexpr primexpr  { result = Call.new(val[0], val[1]) }

  primexpr : ATOM               { result = Atom.new(val[0]) }
           | ATOM '[' args ']'  { result = Tuple.new(Atom.new(val[0]), val[2]) }
           | identifier
           | parenexpr

  parenexpr : '(' topexpr ')'   { result = val[1] }

  identifier : IDENTIFIER       { result = Variable.new(val[0]) }
             | '(' OP ')'       { result = Variable.new(val[1]) }

  identifier1 : IDENTIFIER      { result = Variable.new(val[0]) }

  args :                        { result = [] }
       | args1 ',' topexpr      { result = val[0] << val[2] }
       | topexpr                { result = [val[0]] }

  args1 : args1 ',' topexpr     { val[0] << val[2] }
       | topexpr                { result = [val[0]] }

---- header

require 'pp'
require 'strscan'

require 'theme'

module Theme
  class LexError < RuntimeError
  end
  class ParseError < RuntimeError
  end
  class RunError < RuntimeError
  end
end

---- inner

  def parse(str)
    @tokens  = tokenize str
    @yydebug = true  if $DEBUG
    do_parse
  end

  def next_token
    @tokens.shift
  end

  def on_error(t, val, vstack)
    raise Theme::ParseError, sprintf("parse error on value %s (%s)",
                              val.inspect, token_to_str(t) || '?')
  end

  def tokenize(str)
  scanner = StringScanner.new str
  tokens = []

    until scanner.eos?
      if scanner.scan(/#.*$/)
        # skip
      elsif scanner.scan(/\s/)
        # skip
      elsif scanner.scan(/where/)
        tokens << [:WHERE, scanner.matched]
      elsif scanner.scan(/let/)
        tokens << [:LET, scanner.matched]
      elsif scanner.scan(/in/)
        tokens << [:IN, scanner.matched]
      elsif scanner.scan(/of/)
        tokens << [:OF, scanner.matched]
      elsif scanner.scan(/case/)
        tokens << [:CASE, scanner.matched]
      elsif scanner.scan(/->/)
        tokens << [:ARROW, scanner.matched]
      elsif scanner.scan(/[!$%&*+.\/<>?\\^~-]+|[!$%&*+.\/<>?@\\^~|=-]{2,}/)
        tokens << [:OP, scanner.matched]
      elsif scanner.scan(/[()\[\],=|`@]/m)
        tokens << [scanner.matched, scanner.matched]
      elsif scanner.scan(/[A-Z]\w*/)
        tokens << [:ATOM, scanner.matched]
      elsif scanner.scan(/:[!$%&*+.\/<>?@\\^~|=-]+:/)
        tokens << [:OPATOM, scanner.matched]
      elsif scanner.scan(/[_a-z]\w*/)
        tokens << [:IDENTIFIER, scanner.matched]
      else
        raise Theme::LexError, "unknown token: #{scanner.rest[0..20]}"
      end
    end

    tokens
  end