# http://www.jadetower.org/muses/archives/000431.html

require 'strscan'
require 'pp'

module Misp

  module SExpr
    def self.new(str)
      Misp.parse(str)
    end
    def quote_expr?
      kind_of?(Pair) &&
        hd == :quote &&
        tl.kind_of?(Pair) && tl.tl == :nil
    end
    def function_expr?
      kind_of?(Pair) &&
        hd == :fn &&
        tl.kind_of?(Pair) &&
        tl.tl.kind_of?(Pair)
    end
    def evaluate
      case self
      when :nil, :atom, :eq, :hd, :if, :pair, :quote, :tl
        self
      when Pair
        case hd
        when Pair
          (Pair.new << hd.evaluate << tl).evaluate
        when :atom
          if tl.hd.evaluate.kind_of? Symbol then :true else :nil end
        when :eq
          if tl.hd.evaluate.equal? tl.tl.hd.evaluate then :true else :nil end
        when :hd
          tl.hd.evaluate.hd
        when :if
          if tl.hd.evaluate != :nil
            tl.tl.hd.evaluate
          else
            tl.tl.tl.hd.evaluate
          end
        when :pair
          Pair.new << tl.hd.evaluate << tl.tl.hd.evaluate
        when :quote
          tl.hd
        when :tl
          tl.hd.evaluate.tl
        end
      end
    end
  end

  class ::Symbol
    include SExpr
  end

  class Pair < Array
    include SExpr
    def hd() self[0] end
    def tl() self[1] end
    def <<(val)
      raise ParseError, "found expr, expecting ')'" if size >= 2
      super
    end
    def to_s
      raise RuntimeError, "Pair has #{size} elements" if size != 2
      if tl == :nil
        # Nil Hiding
        "(#{ hd })"
      elsif quote_expr?
        # Quote
        "'#{ tl.hd }"
      elsif function_expr?
        "{|#{ tl.hd }| #{ tl.tl.hd }}"
      elsif tl.kind_of?(Pair) && !tl.quote_expr? && !tl.function_expr?
        # Tail Folding
        "(#{ hd } #{ tl.to_s[1...-1] })"
      else
        "(#{ hd } . #{ tl })"
      end
    end
  end

  class ParseError < RuntimeError; end

  class ParserState
    attr_accessor :sexp, :depth, :implied_parens, :prev
    def initialize
      @sexp = Pair.new
      @depth = 0
      @implied_parens = []
    end
    def open_pair(implied_depth_mod)
      self << Pair.new
      implied_parens << depth + implied_depth_mod if implied_depth_mod
      self.depth += 1
    end
    def close_pair(implicit)
      if not implicit
        raise ParseError, "found ')', expecting expr" if size == 0
        self << :nil if size < 2  # abbreviation: (a) == (a . nil)
        self.depth -= 1
      end
      if implied_parens.last == depth
        implied_parens.pop
        close_pair nil
      end
    end
    def open_tail(type)
      if prev == ?a || prev == ?)
        if size == 1
          # abbreviation: (a b . c) == (a . (b . c))
          error! type, "end" if depth == 0
          open_pair 0
        else
          error! type, ")"
        end
      end
    end
    def delete_top
      self.depth -= 1
      ins.pop
    end
    def <<(expr)
      ins << expr
    end
    def size
      ins.size
    end
    def error!(found, expecting)
      f = found.size == 1 ? "'#{found}'" : found
      e = expecting.size == 1 ? "'#{expecting}'" : expecting
      raise ParseError, "found #{f}, expecting #{e}"
    end
    private
      def ins # current insertion point
        (0...depth).inject(sexp) {|result, i| result.last }
      end
  end

  class << self

    def parse(str)

      state = ParserState.new

      scan(str).each do |type, token|
        case type
        when ?.
          if state.size > 1
            state.error! ".", ")" 
          elsif state.prev == ?|
            state.delete_top
          elsif state.size == 0 || state.prev == ?.
            state.error! ".", "expr"
          elsif state.depth == 0
            state.error! ".", "end"
          end
        when ?)
          if state.depth == 0
            state.error! ")", "end"
          elsif state.size < 2 && state.prev == ?.
            state.error! ")", "expr"
          end
          state.close_pair nil
        when ?(
          # abbreviation: (a (b) . c) == (a . ((b) . c))
          state.open_tail "("
          state.open_pair nil
        when ?a
          # abbreviation: (a b . c) == (a . (b . c))
          state.open_tail "sym"
          state << token
        when ?'
          # abbreviation: (a 'b) == (a . ((quote . (b . nil)) . nil))
          state.open_tail '"\'"'
          # abbreviation: 'hello == (quote . (hello . nil))
          state.open_pair 1
          state << :quote
          state.open_pair 1
        when ?{
          state.open_tail "{"
          state.open_pair nil
          state << :fn
          state.open_pair nil
        when ?}
          state.close_pair nil
          state.close_pair nil
        when ?|
          if state.prev == ?{
            state.open_pair nil
          else
            state.close_pair nil
            state.open_pair 0
          end
        else
          raise ParseError, "unknown token type '#{type}'"
        end

        # pp [str, state]
        state.close_pair 0 unless type == ?'

        state.prev = type
      end

      state.error! "end", ")" if state.depth > 0
        
      state.sexp.first
    end

    def serialize(sexp)
      if sexp == nil || sexp.kind_of?(SExpr)
        sexp.to_s
      else
        raise ArgumentError, "invalid s-expr, expecting nil, Symbol or Array"
      end
    end

    private

      def scan(str)
        ret = []
        scanner = StringScanner.new(str)
        until scanner.eos?
          if s = scanner.scan(/[^.()'{}|\s]+/)
            ret << [?a, s.intern]
          elsif !scanner.scan(/\s+/)
            ret << scanner.get_byte[0]
          end
        end
        ret
      end

  end
end