Ruby で遅延評価

le_mogumogu.rb

module Kernel
  def Thunk(&bl)
    a = Thunk.new
    a.value = bl
    a
  end
  
  def Lambda(&bl)
    Lambda.new(bl)
  end
  
  def Lambda2
    Lambda {|a|
      Lambda {|b| Thunk{yield(a, b)}}
    }
  end
end

class Thunk
  # valueは即値かCons
  def initialize(value = nil)
    @value = ->{value}
  end
  attr_accessor :value
  
  # self : xs （xsを評価したものはCons）
  def >>(xs)
    apply!(CONS, self, xs)
  end
  
  def *(ob)
    apply!(self, ob)
  end
  
  def +(ob)
    apply!(self, ob)
  end
  
  def inspect
    "#<Thunk:#{evaluate(self)}>"
  end
  alias :to_s :inspect
end

class Lambda
  def initialize(fn = nil)
    @fn = fn
  end
  attr_accessor :fn
  
  def *(ob)
    apply!(self, ob)
  end
  
  def +(ob)
    apply!(self, ob)
  end
  
  def inspect
     "#<Lambda:@fn=#{@fn}>"
  end
  alias :to_s :inspect
end

#fnはLambda
class App
  def initialize(fn, arg)
    @fn = fn
    @arg = arg
  end
  attr_reader :fn, :arg
   
  def inspect
     "#<App:@arg=#{@arg}>" 
  end
  alias :to_s :inspect
end

# Thunkを評価
=begin
def evaluate(val)
  while val.instance_of?(Thunk)
    val = val.value.()
    if val.instance_of?(App)
      val = peel_lambda(evaluate(val.fn)).(val.arg)
    end
  end
  val
end
=end

def evaluate(val)
  while val.instance_of?(Thunk)
    v = val.dup
    class << v
      def evaluated()     @val end
      def evaluated=(val) @val = val end
    end
    val = v.evaluated ? val.value : val.value.()
    val = peel_lambda(evaluate(val.fn)).(val.arg) if val.instance_of?(App)
    v.evaluated = true
    v.value = val
  end
  val
end

# Lambdaの中身の ->{} を見る
def peel_lambda(lam)
  unless lam.instance_of?(Lambda)
    raise "type error: apply a non-lambda to a value"
  end
  lam.fn
end

# fnはLambda
def apply(fn)
  ->(arg) {
    Thunk.new(App.new(fn, arg))
  }
end

# 返り値はThunk
def apply!(f, *args)
  return f if args.empty?
  apply!(apply(f).(args.first), *args.drop(1))
end 

def _(fn, *args) apply!(fn, *args) end

# リスト
class Cons
  @@visible = true
  def initialize(car, cdr)
    @car = car
    @cdr = cdr
  end
  attr_reader :car, :cdr
  
  def inspect
    @@visible ? "#<Cons:#{to_array(self)}>" : "#<Cons>"
  end
  alias :to_s :inspect
  
  def self.visible(ob)
    @@visible = ob
  end
end

Null = Thunk.new(nil)
CONS = Lambda {|x| Lambda {|xs| Thunk.new(Cons.new(x, xs))}}
Return = Lambda {|x| Thunk.new(x)}
Then = Lambda2 {|fn1, fn2| evaluate(fn1); evaluate(fn2)}

class Unit end
UNIT = Thunk.new(Unit.new)

Print = Lambda {|x|
  val = evaluate(x)
  if val.instance_of?(Cons)
    result = []
    while val.instance_of?(Cons)
      result << evaluate(val.car)
      val = evaluate(val.cdr) 
    end
    Thunk.new(p result)
  elsif val == nil
    Thunk.new(puts "Null")
  else
    Thunk.new(puts val)
  end
  apply(Return).(UNIT)
}

=begin
Then = Lambda {|fn1|
  Lambda {|fn2|
    Thunk{evaluate(fn1); evaluate(fn2)}
  }
}
=end

# map _ [] = []
# map f (x:xs) = f x : map f xs
=begin
Map = Lambda {|f|
  Lambda {|list|
    Thunk{
      xxs = evaluate(list)
      if xxs.instance_of?(Cons)
        x  = xxs.car
        xs = xxs.cdr
        apply(apply(CONS).(apply(f).(x)))
          .(apply(apply(Map).(f)).(xs))
      else
        Null
      end
    }
  }
}
=end

Map = Lambda2 {|f, list|
  xxs = evaluate(list)
  if xxs.instance_of?(Cons)
    x  = xxs.car
    xs = xxs.cdr
    apply(f).(x) >> apply!(Map, f, xs)
  else
    Null
  end
}

zero = Thunk.new(0)
one  = Thunk.new(1)

def operator(meth)
  Lambda {|x|
    Lambda {|y|   
      Thunk.new(evaluate(x).__send__(meth, evaluate(y)))        
    }    
  }
end

=begin
Add = Lambda {|x|
  Lambda {|y|   
    Thunk.new(evaluate(x) + evaluate(y))        
  }    
}
=end

Add = operator(:+)
Sub = operator(:-)
Equal = operator(:==)

Take = Lambda2 {|n, list|
  xxs = evaluate(list)
  if xxs.instance_of?(Cons)
    nval = evaluate(n)
    if nval <= 0
      Null
    else
      xxs.car >> apply!(Take, apply!(Sub, n, one), xxs.cdr)
    end
  else
    Null
  end
}

MapM = Lambda2 {|f, list|
  xxs = evaluate(list)
  if xxs.instance_of?(Cons)
    apply!(Then, apply(f).(xxs.car), apply!(MapM, f, xxs.cdr))
  else
    apply(Return).(UNIT)
  end
}

=begin
Inf = Thunk{
  apply(apply(CONS).(zero))
    .(apply(apply(Map).(apply(Add).(one))).(Inf))
}
=end

# zipWith f (a:as) (b:bs) = f a b : zipWith f as bs
# zipWith _ _ _ = []
ZipWith = Lambda {|f|
  Lambda2 {|listx, listy|
    xxs = evaluate(listx)
    if xxs.instance_of?(Cons)
      yys = evaluate(listy)
      if yys.instance_of?(Cons)
        apply!(f, xxs.car, yys.car) >> apply!(ZipWith, f, xxs.cdr, yys.cdr)
      end
    else
      Null
    end
  }
}

def to_array(list)
  val = evaluate(list)
  result = []
  while val.instance_of?(Cons)
    result << evaluate(val.car)
    val = evaluate(val.cdr) 
  end
  result
end

require_relative "le_mogumogu_lib"

# https://itchyny.hatenablog.com/entry/20130209/1360417348
# このサイトの JavaScript を　Ruby に移植したもの

le_mogumogu_lib.rb

module Kernel
  def Lambda!(n)
    gen = ->(i, co) {
      return "Thunk.new(yield(#{Array.new(n) {|j| "a#{j + 1}"}.join(", ")}))" if i.zero?
      "Lambda {|a#{co}| #{gen.(i - 1, co + 1)}}"
    }
    eval(gen.(n, 1))
  end
  
  def Lambda1
    Lambda {|x| Thunk.new(yield(x))}
  end
end

class Object
  def thunk() Thunk.new(self) end
  def ev()    evaluate(self) end
  
  def tell
    puts inspect
    self
  end
end

def make_func(sym, arg_num = 0)
  gen = ->(n, co, args_st = "") {
    return "Thunk.new(evaluate(a1).#{sym}(#{args_st[0..-17]}))" if n.zero?
    "Lambda {|a#{co}| #{gen.(n - 1, co + 1, args_st + "evaluate(a#{co + 1}), ")}}"
  }
  eval(gen.(arg_num + 1, 1))
end

def range(first, last = false, exclude_end = false)
  if last
    last -= 1 if exclude_end
    result = Null
    (last - first + 1).times do |i|
      result = (last - i).thunk >> result
    end
    result
  else
    inf = Thunk{ first.thunk >> Map + Add * 1.thunk + inf }
  end
end

Select = Lambda2 {|f, list|
  xxs = evaluate(list)
  if xxs.instance_of?(Cons)
    x, xs = xxs.car, xxs.cdr
    next_xs = Select * f * xs
    evaluate(f * x) ? x >> next_xs : next_xs
  else
    Null
  end
}

Mul = operator(:*)
Div = operator(:/)

Itself = Lambda1(&:itself)

def make_list(ary)
  return Null if ary.size == 0
  ary.first.thunk >> make_list(ary.drop(1))
end

def handle_list
  Lambda1 {|list|
    xs = evaluate(list)
    if xs.instance_of?(Cons)
      yield(xs)
    else
      raise "Not list."
    end
  }
end

Car = handle_list(&:car)
Cdr = handle_list(&:cdr)

Last = handle_list {|xxs|
  x, xs = xxs.car, xxs.cdr
  if evaluate(xs).instance_of?(Cons)
    Last * xs
  else
    x
  end
}

Init = handle_list {|list|
  make_list(to_array(list)[0..-2])
}

=begin
Concat = Lambda2 {|list1, list2|
  xxs, yys = evaluate(list1), evaluate(list2)
  if !xxs.instance_of?(Cons) 
    yys
  elsif !yys.instance_of?(Cons)
    xxs
  else
    x, xs = Last * list1, Init * list1
    result = x >> list2
    while evaluate(xs).instance_of?(Cons)
      x, xs = Last * xs, Init * xs
      result = x >> result
    end
    result
  end
}
=end

Enlist = Lambda1 {|x| x >> Null}
Length = Lambda1 {|list| to_array(list).length}

Tail = Last
Filter = Select

# 畳み込み
Inspect = Lambda!(3) {|f, acc, list|
  if list.ev.instance_of?(Cons)
    x, xs = Car * list, Cdr * list
    Inspect + f  + f * acc * x + xs
  else
    acc
  end
}
Reduce = Inspect
Foldl = Inspect

Foldr  = Lambda!(3) {|f, acc, list|
  if list.ev.instance_of?(Cons)
    x, xs = Last * list, Init * list
    Foldr + f  + f * acc * x + xs
  else
    acc
  end
}

unshift = Lambda2 {|acc, x| x >> acc}

Reverse = Inspect * unshift * Null
Concat = Lambda2 {|list1, list2| Foldr * unshift * list2 * list1}

Zip = Lambda2 {|list1, list2|
  if list1.ev.instance_of?(Cons)
    x, xs = Car * list1, Cdr * list1
    if list2.ev.instance_of?(Cons)
      y, ys = Car * list2, Cdr * list2
      (x >> (y >> Null)) >> Zip * xs * ys
    else
      (x >> (Null >> Null)) >> Zip * xs * ys
    end
  else
    Null
  end
}

Drop = Lambda2 {|n, list|
  if list.ev.instance_of?(Cons)
    n.ev.nonzero? ? Drop * (Sub * n * 1.thunk) * (Cdr * list) : list
  else
    Null
  end
}

le_mogumogu_sample01.rb

require_relative 'le_mogumogu'

twenty = Thunk.new(20)
evaluate(apply!(Print, apply!(Take, twenty, range(0))))

le_mogumogu_sample02.rb

require_relative 'le_mogumogu'

zero = Thunk.new(0)
one  = Thunk.new(1)
ten  = Thunk.new(10)

# fib = 0 : 1 : zipWith (+) fib (tail fib)
fib = Thunk {
  zero >> (one >> apply!(ZipWith, Add, fib, apply(Tail).(fib)))
}

evaluate(apply!(Print, apply!(Take, ten, fib)))
#=>[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]


#あるいはこれでも
fib = Thunk {
  zero >> (one >> ZipWith + Add + fib + Tail * fib)
}
evaluate Print + Take * ten * fib


### フィボナッチ数列

le_mogumogu_sample03.rb

require_relative 'le_mogumogu'

one = 1.thunk

tak = Lambda!(3) {|x, y, z|
  if x.ev <= y.ev
    y
  else
    tak + tak * (Sub * x * one) * y * z +
          tak * (Sub * y * one) * z * x +
          tak * (Sub * z * one) * x * y
  end
}
evaluate Print + tak * 12.thunk * 6.thunk * 0.thunk    #=>12

__END__

#たらい回し関数の実行結果
$ time ruby le_mogumogu_sample3.rb
12

real  0m0.125s
user  0m0.080s
sys   0m0.008s

le_mogumogu_sample04.rb

require_relative 'le_mogumogu'

zero = 0.thunk
one  = 1.thunk

# フィボナッチ数列その２
fib = Lambda {|n|
  if n.ev == 0
    zero
  elsif n.ev == 1
    one
  else
    Add * (fib + Sub * n * one) * (fib + Sub * n * 2.thunk)
  end
}
evaluate Print + fib * 20.thunk    #=>6765


# フィボナッチ数列その３
fib_iter = Lambda!(3) {|a, b, count|
  if count.ev.zero?
    b
  else
    fib_iter + (Add * a * b) + a + (Sub * count * one)
  end
}
fib = Lambda1 {|n| fib_iter * one * zero * n}

evaluate Print + fib * 20.thunk    #=>6765

le_mogumogu_sample05.rb

require_relative 'le_mogumogu'

mul = operator(:*)
double = apply!(mul, 2.thunk)
all_double = apply!(Map, double)
ten_list = apply!(Take, 10.thunk, range(0))

# その1
evaluate _ Print, _(all_double, ten_list)

# その2
doit = all_double * ten_list
evaluate Print + doit

# その3
evaluate Print + Map * (mul * 2.thunk) * (Take * 10.thunk * range(0))

#=>[0, 2, 4, 6, 8, 10, 12, 14, 16, 18]
# カリー化、部分適用、関数合成

le_mogumogu_sample06.rb

require_relative 'le_mogumogu'

shuffled = make_list([*1..5].shuffle)
evaluate Print + shuffled

is_large = operator(:>)
is_not_large = operator(:<=)

# クイックソート（きわめて遅いです）
quick_sort = Lambda1 {|list|
  xxs = evaluate(list)
  if xxs.instance_of?(Cons)
    x, xs = Car * xxs, Cdr * xxs
    left  = quick_sort + Select * (is_large * x) * xs
    right = quick_sort + Select * (is_not_large * x) * xs
    Concat + left + Concat * (Enlist * x) * right 
  else
    list
  end
}
evaluate Print + quick_sort * shuffled

# クイックソート（別実装）
quick_sort = Lambda1 {|list|
  left, right = Null, Null
  if evaluate(Length * list) > 1
    x = Car * list
    f = Lambda {|a|
      if a.ev < x.ev
        left = a >> left
      else
        right = a >> right
      end
    }
    evaluate MapM + f + Cdr * list
    left  = quick_sort * left
    right = quick_sort * right
    Concat + left + Concat * (Enlist * x) * right
  else
    list
  end
}
evaluate Print + quick_sort * shuffled

le_mogumogu_sample07.rb

require_relative 'le_mogumogu'

sum = Inspect * Add * 0.thunk
evaluate Print +  sum * range(2, 6)
#=>20

evaluate Print +  Concat * range(1, 4) * range(9, 12)
#=>[1, 2, 3, 4, 9, 10, 11, 12]

le_mogumogu_sample08.rb

require_relative 'le_mogumogu'

is_fizz = Lambda1 {|n| (n.ev % 3).zero?}
is_buzz = Lambda1 {|n| (n.ev % 5).zero?}

f = Lambda1 {|n|
  if (is_fizz * n).ev and (is_buzz * n).ev
    "FizzBuzz"
  elsif (is_fizz * n).ev
    "Fizz"
  elsif (is_buzz * n).ev
    "Buzz"
  else
    n
  end
}

fizzbuzz = Map * f * range(1)
evaluate Print + Take * 20.thunk * fizzbuzz

le_mogumogu_sample09.rb

require_relative 'le_mogumogu'

#### 無限遅延ストリーム

## 前の要素から次の要素への変換をfで与える
iterate = Lambda2 {|f, x| x >> iterate + f + f * x}

add11 = Add * 11.thunk
five = 5.thunk
stepping = iterate + add11 + 7.thunk

evaluate Print + Take * five * stepping
#=>[7, 18, 29, 40, 51]


## 特定のステップで生成される無限リストのそれぞれの要素をfで変換する
tabulate = Lambda2 {|f, x| f * x >> tabulate + f + Add * 2.thunk * x}
square = Lambda1 {|y| Mul * y * y}
squares = tabulate + square + 1.thunk

evaluate Print + Take * five * squares
#=>[1, 9, 25, 49, 81]

# Mapとiterateを使ったこれと同じ結果
stepping = iterate + (Add * 2.thunk) + 1.thunk
evaluate Print + Take * five * (Map * square * stepping)
#=>[1, 9, 25, 49, 81]


## 遅延ストリームによるフィボナッチ数列
fib = Lambda2 {|a, b| a >> fib + b + Add * a * b}
fibs = fib * 0.thunk * 1.thunk

evaluate Print + Take * 10.thunk * fibs
#=>[0, 1, 1, 2, 3, 5, 8, 13, 21, 34]


## 階差数列
itr = Lambda2 {|a, b| b >> itr + (Add * a * 2.thunk) + (Add * a * b)}
seq = itr + 1.thunk + 1.thunk

evaluate Print + Take * 10.thunk * seq
#=>[1, 2, 5, 10, 17, 26, 37, 50, 65, 82]
# 参考: http://melborne.github.io/2012/07/12/object-repeat-take-care-of-sequence/

le_mogumogu_sample10.rb

require_relative 'le_mogumogu'

find2 = Lambda2 {|f, list|
  if list.ev.instance_of?(Cons)
    x, xs = Car * list, Cdr * list
    if xs.ev.instance_of?(Cons)
      y = Car * xs
      (f * x * y).ev ? y : find2 * f * xs
    else
      Null
    end
  else
    Null
  end
}

sqrt = Lambda1 {|n|
  eps = 0.0001
  itr = Lambda1 {|x| x >> itr * ((x.ev + n.ev / x.ev) / 2.0).thunk}
  seq = itr + 1.0.thunk
  f = Lambda2 {|a, b| (a.ev - b.ev).abs < eps}
  find2 * f * seq
}

evaluate Print + sqrt * 5.0.thunk    #=>2.236067977499978

# ニュートン法による 5 の平方根の計算
# 参考: http://melborne.github.io/2012/07/12/object-repeat-take-care-of-sequence/