require 'test/unit'
require 'misp'

class MispTest < Test::Unit::TestCase

  def parse(s) Misp.parse(s) end
  def serialize(sexp) sexp.to_s end

  def assert_parse_err(s)
    parse s
  rescue Racc::ParseError => e
    assert true
  else
    flunk "parse error expected from '#{s}'"
  end

  def assert_serializable(s)
    assert_equal s, serialize(parse(s))
  end

  def assert_false(s)
    assert_equal :nil, parse(s).evaluate
  end
  def assert_true(s)
    assert_not_equal :nil, parse(s).evaluate
  end

  def assert_eq(expected, expr)
    assert_equal parse(expected), parse(expr).evaluate
  end

  def test_array_to_sexp
    assert_equal Misp::Pair.new(:a, Misp::Pair.new(:b)), [:a, [:b, nil]].to_sexp
  end
  def test_nil_to_sexp
    assert_equal :nil, nil.to_sexp
  end

  def test_parse_canonical
    assert_equal :a, parse("a")
    assert_equal [:a, :b].to_sexp, parse("(a . b)")
    assert_equal [:a, :b].to_sexp, Misp::SExpr.new("(a . b)")
    assert_equal [[:a, :b], [:c, :d]].to_sexp, parse("((a . b) . (c . d))")
  end
  def test_parse_abbrev
    assert_equal [:a, :nil].to_sexp, parse("(a)")
    assert_equal [:a, [:b, :c]].to_sexp, parse("(a b . c)")
    assert_equal [:a, [:b, :nil]].to_sexp, parse("(a b)")
    assert_equal [[:a, :b], :nil].to_sexp, parse("((a . b))")
    assert_equal [:a, [[:b, :c], :d]].to_sexp, parse("(a (b . c) . d)")
    assert_equal [:a, [[:b, :nil], [:c, :nil]]].to_sexp, parse("(a (b) c)")
    assert_equal \
      parse("(eq . ((hd . ((hd . (env . nil)) . nil)) . (key . nil)))"),
      parse("(eq (hd (hd env)) key)")
  end
  def test_parse_quote
    assert_equal parse("(quote hello)"), parse("'hello")
    assert_equal parse("(quote (quote hello))"), parse("''hello")
    assert_equal parse("(quote (a . b))"), parse("'(a . b)")
    assert_equal parse("(x . (quote . (foo . nil)))"), parse("(x quote foo)")
    assert_equal parse("(x . (quote . (foo . nil)))"), parse("(x . 'foo)")
    assert_equal parse("(a . ((quote . (b . nil)) . ((quote . (c . nil)))))"),
      parse("(a 'b 'c)")
  end
  def test_parse_fn
    assert_equal parse("(fn (x) (pair x x))"), parse("{|x| (pair x x)}")
    assert_equal parse("(fn (x . xs) xs)"), parse("{|x . xs| xs}")
    assert_equal parse("(fn xs xs)"), parse("{|.xs| xs}")
    assert_equal parse("(fn (a b c) a)"), parse("{|a b c| a}")
    assert_equal parse("(fn (a b . c) a)"), parse("{|a b . c| a}")
  end

  def test_parse_errors
    assert_parse_err ")"
    assert_parse_err "("
    assert_parse_err "."
    assert_parse_err "(a . b . c)"
    assert_parse_err "(a . b (c))"
    assert_parse_err "(a . (b) . c)"
    assert_parse_err "(a . (b) c)"
    assert_parse_err "(a . b"
    assert_parse_err "(a ."
    assert_parse_err ". b)"
    assert_parse_err "a . b)"
    assert_parse_err "(a . b))"
    assert_parse_err "(a . )"
    assert_parse_err "( . b)"
    assert_parse_err "a . b"
    assert_parse_err "a b)"
    assert_parse_err "a b"
    assert_parse_err "a (b . c))"
    assert_parse_err "a (b . c)"
    assert_parse_err "(a . b c)" # implied triplet-dot
  end
  def test_parse_error_quote
    assert_parse_err "foo '"
    assert_parse_err "(foo ')"
    assert_parse_err "(foo . ')"
    assert_parse_err "(foo bar ')"
    assert_parse_err "(foo . bar ')"
    assert_parse_err "(foo '. bar)"
  end
  def test_parse_error_fn
    assert_parse_err "|x|y}"
    assert_parse_err "{x|y}"
    assert_parse_err "{||y}"
    assert_parse_err "{|x}"
    assert_parse_err "{|x|}"
    assert_parse_err "{|x|y"
    assert_parse_err "{x|y|}"
    assert_parse_err "(|x|y)"
    assert_parse_err "{(x)y}"
  end

  def test_serialize_basic
    assert_serializable "foo"
    assert_serializable "(foo . bar)"
    assert_serializable "((a . b) . c)"
  end
  def test_serialize_abbrev
    assert_serializable "(a)"
    assert_serializable "(a b)"
    assert_serializable "(a b c)"
    assert_serializable "((a . b) c . d)"
    assert_serializable "((a) c)"
    assert_serializable "(a (b) c)"
    assert_serializable "(eq (hd (hd env)) key)"
  end
  def test_serialize_quote
    assert_serializable "'foo"
    assert_serializable "''foo"
    assert_serializable "(foo quote bar)"  # not (foo . 'bar)
    assert_serializable "'(what (is up))"
    assert_serializable "'(a nested 'quote)"
  end
  def test_serialize_if
    assert_serializable "((if (eq nil 'x) quote pair) (if (eq 'a 'b) 'c 'd) (if (eq 'e 'e) (pair 'g nil) 'h))"
  end
  def test_serialize_fn
    assert_serializable "{|x| (pair x x)}"
    assert_serializable "{|x . xs| xs}"
    assert_serializable "{|.xs| xs}"
  end

  def test_eval_quote
    assert_equal :hello, parse("'hello").evaluate
    assert_eq "'hello", "''hello"
    assert_eq "(a . b)", "'(a . b)"
    assert_eq "(a b c)", "'(a b c)"
    assert_eq "(what (is up))", "'(what (is up))"
    assert_eq "(a nested 'quote)", "'(a nested 'quote)"
  end
  def test_eval_eq
    assert_false "nil"
    assert_true "'anything-else"
    assert_false "(eq 'eq 'happy-go-lucka-day)"
    assert_true "(eq (eq 'eq 'happy-go-lucka-day) nil)"
    assert_false "(eq '(a . pair) '(a . pair))"
    assert_false "(eq 'hello 'world)"
    assert_true "(eq 'hello 'hello)"
    assert_true "(eq 'nil nil)"
    assert_true "(eq nil nil)"
    assert_true "(eq nil (eq 'hello 'world))"
    assert_false "(eq '(pair) '(pair))"
  end
  def test_eval_atom
    assert_false "(atom '(hog wash))"
    assert_true "(atom 'hog-wash)"
    assert_eq "true", "(atom nil)"
    assert_eq "true", "(atom 'true)"
    assert_eq "nil", "(atom '(pair))"
    assert_eq "nil", "(atom '(pair of ((pair) . (pair))))"
  end
  def test_eval_pair_hd_tl
    assert_eq "(of . things)", "(pair 'of 'things)"
    assert_eq "the-head", "(hd '(the-head the-tail))"
    assert_eq "(the-tail)", "(tl '(the-head the-tail))"
    assert_eq "(nil)", "(pair nil nil)"
    assert_eq "(pair)", "(pair 'pair nil)"
    assert_eq "(hello world)", "(pair 'hello (pair 'world nil))"
    assert_eq "((a . b) . (c . d))", "(pair (pair 'a 'b) (pair 'c 'd))"
    assert_eq "head", "(hd '(head . tail))"
    assert_eq "head", "(hd (pair 'head 'tail))"
    assert_eq "a", "(hd (hd (pair (pair 'a 'b) (pair 'c 'd))))"
    assert_eq "tail", "(tl '(head . tail))"
    assert_eq "tail", "(tl (pair 'head 'tail))"
    assert_eq "d", "(tl (tl (pair (pair 'a 'b) (pair 'c 'd))))"
  end
  def test_eval_if
    assert_eq "yes", "(if nil 'nope 'yes)"
    assert_eq "yes", "(if (eq nil nil) 'yes 'nope)"
    assert_eq "(d g)", "((if (eq nil 'x) quote pair) (if (eq 'a 'b) 'c 'd) (if (eq 'e 'e) (pair 'g nil) 'h))"
  end
  def test_eval_fn
    assert_eq "foo", "({|x| x} 'foo)"
    assert_eq "(hi . hi)", "({|x| (pair x x)} 'hi)"
    assert_eq "nil", "({|x y z| z} 'a 'b)"
    assert_eq "(b c)", "({|ls| ({|x . xs| xs} . ls)} '(a b c))"
    assert_eq "(a b c)", "({|.xs| xs} 'a 'b 'c)"
    assert_eq "(a b c)", "({|list|(list 'a 'b 'c)} {.xs| xs})"
  end
end