# = lisp.rb
#
# == Copyright (C) 2003 Florian Frank
#
#   Ruby License
#
#   This module is free software. You may use, modify, and/or redistribute this
#   software under the same terms as Ruby.
#
#   This program is distributed in the hope that it will be useful, but WITHOUT
#   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
#   FOR A PARTICULAR PURPOSE.
#
# == Author(s)
#
# * Florian Frank
#
# == Developers Notes
#
#   TODO Changed the name of Pair class to DottedPair (good change?)
#        and then added a new method #pair! which converts an array
#        to a DottedPair. This is then used in #car and
#        #cdr to automatically convert arrays passed to 'em.
#        There may be other places that #pair! conversion is needed.

# Author::    Florian Frank
# Copyright:: Copyright (c) 2003 Florian Frank
# License::   Ruby License

# = Lisp Mixin
#
# This module provides Lisp-like functional notation.
# With this module it almost possible to write real
# Lisp code in Ruby.
#
# == Usage
#
# It's hardly believable, but the following IS valid ruby code:
#
#   (def accumulate (fun, x, list)
#     (if (null? list)
#       x
#     else
#       (accumulate fun, (fun.call x, (car list)), (cdr list))
#     end)
#   end)
#
# A real programmer can write LISP in any language ;)

module Lisp

  # DottedPair

  class DottedPair

    include Lisp
    include Enumerable

    def initialize(first = nil, second = nil)
      @first, @second = first, second
    end

    attr_accessor :first, :second

    def DottedPair.[](*array)
      if array.empty?
        nil
      else
        DottedPair.new(array.shift, DottedPair[*array])
      end
    end

    def each(&block)
      if @first
        if @first.is_a? DottedPair
          @first.each(&block)
        else
          block.call(@first)
        end
      end
      if @second
        if @second.is_a? DottedPair
          @second.each(&block)
        else
          block.call(@second)
        end
      end
    end

    def to_s
      '(' + repr + ')'
    end

    def inspect
      '(' + repr + ')'
    end

    def to_a
      a = []
      each { |e| a << e }
      a
    end

    def ==(other)
      if pair?(self) and pair?(other)
        car(self) == car(other) and cdr(self) == cdr(other)
      else
        if pair?(self) then false else self == other end
      end
    end

    protected

    def repr
      case @second
        when DottedPair then @first.to_s + ' ' + @second.repr
        when nil then @first.to_s
        else @first.to_s + ' . ' + @second.to_s
      end
    end

  end # DottedPair

  # Functional API

  def cons(car, cdr)
    DottedPair.new(car, cdr)
  end

  def consonto(cdr, car)
    DottedPair.new(car, cdr)
  end

  def car(pair)
    pair = pair!(pair)
    pair.first
  end

  def cdr(pair)
    pair = pair!(pair)
    pair.second
  end

  def set(var, val, binding)
    eval "var = #{val}", binding
  end

  def set_car!(pair, val)
    pair.first = val
  end

  def set_cdr!(pair, val)
    pair.second = val
  end

  def null?(x)
    x == nil
  end

  def pair?(x)
    x.is_a?(DottedPair)
  end

  def pair!(x)
    return x if pair?(x)
    return DottedPair[*x]
  end

  def atom?(x)
    not pair?(x) || null?(x)
  end

  def equal?(l, m)
    l == m
  end

  def list(*elms)
    if elms.empty?
      nil
    else
      cons(elms.shift, list(*elms))
    end
  end

  def append(l, m)
    if null?(l)
      if null?(m)
        nil
      else
        cons(car(m), append(l, cdr(m)))
      end
    else
      cons(car(l), append(cdr(l), m))
    end
  end

  def length(list)
    if null?(list)
      0
    else
      1 + length(cdr(list))
    end
  end

  def map(fun, list)
    if null?(list)
      nil
    else
      cons(fun.call(car(list)), map(fun, cdr(list)))
    end
  end

  def zip(fun, l, m)
    if null?(l) and null?(m)
      nil
    elsif null?(l) or null?(m)
      raise ArgumentError.new("zip with unequal length lists")
    else
      cons(fun.call(car(l), car(m)), zip(fun, cdr(l), cdr(m)))
    end
  end

  def pairlis(l, m)
    zip(lambda { |x, y| cons(x, y) }, l, m)
  end

  def member?(x, list)
    if null?(list)
      false
    else
      if x == car(list)
        true
      else
        member?(x, cdr(list))
      end
    end
  end

  def filter(pred, list)
    if null?(list)
      nil
    else
      if pred.call(car(list))
        cons(car(list), filter(pred, cdr(list)))
      else
        filter(pred, cdr(list))
      end
    end
  end

  def assoc(x, list)
    f = filter(lambda { |y| x == car(y)}, list)
    if null?(f) then nil else car(f) end
  end

  def exists?(pred, list)
    if null?(list)
      false
    else
      if pred.call(car(list))
        true
      else
        exists?(pred, cdr(list))
      end
    end
  end

  def all?(pred, list)
    if null?(list)
      true
    else
      if pred.call(car(list))
        all?(pred, cdr(list))
      else
        false
      end
    end
  end

  def accumulate(fun, x, list)
    if null?(list)
      x
    else
      accumulate(fun, fun.call(x, car(list)), cdr(list))
    end
  end

  alias foldleft accumulate

  def reduce(fun, x, list)
    if null?(list)
      x
    else
      fun.call(car(list), reduce(fun, x, cdr(list)))
    end
  end

  alias foldright reduce

  def link(lists)
    accumulate(lambda { |x, y| append(x, y) }, nil, lists)
  end

  def explode(string)
    list(*(string.split(//)))
  end

  def implode(list)
    accumulate(lambda { |x, y| x + y }, '', list)
  end

  def sum(list)
    accumulate(lambda { |x, y| x + y }, 0, list)
  end

  def prod(list)
    accumulate(lambda { |x, y| x * y }, 1, list)
  end

  def reverse(lists)
    accumulate(lambda { |x, y| consonto(x, y) }, nil, lists)
  end

  def take(l, n)
    if n > 0 and not null?(l)
      cons(car(l), take(cdr(l), n - 1))
    else
      nil
    end
  end

  def drop(l, n)
    if n > 0 and not null?(l)
        drop(cdr(l), n - 1)
    else
        l
    end
  end

end



#  _____         _
# |_   _|__  ___| |_
#   | |/ _ \/ __| __|
#   | |  __/\__ \ |_
#   |_|\___||___/\__|
#

=begin test

  require 'test/unit'

  # fixture

  class T

    include Lisp

    (def accumulate (fun, x, list)
      (if (null? list)
        x
      else
        (accumulate fun, (fun.call x, (car list)), (cdr list))
      end)
    end)

  end

  # test

  class TC_Lisp < Test::Unit::TestCase

    include Lisp

    def test_accumulate
      t = T.new
      t.accumulate( proc{ |x,y| x+y }, 0, [1,2,3] )
    end

  end

=end
