Programming in Haskell Chapter 8: Monadic Parser cf) http://tmaeda.s45.xrea.com/td/20100228.html

monadic_parser.rb

require 'rubygems'
require 'active_support'

def return_(v)
  lambda{|input| [[v, input]]}
end

def failure
  lambda{|input| []}
end

def item
  lambda{|input|
    if input.empty?
      []
    else
      [[input[0..0], input[1..-1]]]
    end
  }
end

def parse(parser, input)
  parser.call(input)
end

class Proc
  def &(f)
    lambda{|input|
      lhs = parse(self, input)
      raise unless lhs.is_a?(Array)
      if lhs.empty?
        []
      else
        parse(f.call(lhs[0][0]), lhs[0][1])
      end
    }
  end

  def |(f)
    lambda{|input|
      lhs = parse(self, input)
      raise unless lhs.is_a?(Array)
      if lhs.empty?
        parse(f, input)
      else
        lhs
      end
    }
  end
end

def first_third
  item & lambda{|x|
    item & lambda{
      item & lambda{|y|
        return_([x,y])
      }
    }
  }
end

def sat(predicate)
  item & lambda{|x|
    if predicate.call(x)
      return_(x)
    else
      failure
    end
  }
end

def isDigit
  lambda{|chr| /^\d$/ =~ chr}
end

def digit
  sat isDigit
end

def isLower
  lambda{|chr| /^[[:lower:]]$/ =~ chr}
end

def lower
  sat isLower
end

def isUpper
  lambda{|chr| /^[[:upper:]]$/ =~ chr}
end

def upper
  sat isUpper
end

def isAlpha
  lambda{|chr| /^[[:alpha:]]$/ =~ chr}
end

def letter
  sat isAlpha
end

def isAlphaNum
  lambda{|chr| /^[[:alnum:]]$/ =~ chr}
end

def alphanum
  sat isAlphaNum
end

def char(condition_chr)
  sat lambda{|chr| chr == condition_chr}
end

def string(condition_str)
  if condition_str.empty?
    return_([])
  else
    char(condition_str[0..0]) & lambda{
      string(condition_str[1..-1]) & lambda{
        return_(condition_str)
      }
    }
  end
end

def many(p)
  many1(p) | return_([])
end

def many1(p)
  p & lambda{|v|
    many(p) & lambda{|vs|
      return_([v] + vs)
    }
  }
end

def ident
  lower & lambda{|x|
    many(alphanum) & lambda{|xs|
      return_([x] + xs)
    }
  }
end

def nat
  many1(digit) & lambda{|xs|
    return_(xs.join.to_i)
  }
end

def isSpace
  lambda{|chr| /^[[:space:]]$/ =~ chr}
end

def space
  many(sat(isSpace)) & lambda{
    return_([])
  }
end

def token(p)
  space & lambda{|sp0|
    p & lambda{|v|
      space & lambda{|sp|
        return_(v)
      }
    }
  }
end

def identifier
  token ident
end

def natural
  token nat
end

def symbol(str)
  token(string(str))
end

def natural_list
  symbol("[") & lambda{
    natural & lambda{|n|
      many(symbol(",") & lambda{
             natural
           }) & lambda{|ns|
        symbol("]") & lambda{
          return_([n] + ns)
        }
      }
    }
  }
end

def expr
  term & lambda{|t|
    (symbol("+") & lambda{
      expr & lambda{|e|
        return_(t + e)
      }
    }) | return_(t)
  }
end

def term
  factor & lambda{|f|
    (symbol("*") & lambda{
      term & lambda{|t|
        return_(f*t)
      }
    }) | return_(f)
  }
end

def factor
  symbol("(") & lambda{
    expr & lambda{|e|
      symbol(")") & lambda{
        return_(e)
      }
    }
  } | natural
end

def eval_(xs)
  result = parse expr, xs
  if result.empty?
    puts "invalid input"
  elsif result[0][1].empty?
    result[0][0]
  elsif !result[0][1].blank?
    puts "unused input #{result[0][1]}"
  else
    puts "unexpected"
  end
end