プログラミング言語「ほむほむ」（Grass 同型版）

Homuhomu.scala

import java.io.File
import scala.io.Source
import scala.util.matching.Regex
import scala.util.parsing.combinator._
import scala.util.parsing.input.{Position, NoPosition}

sealed abstract class Insn extends ( CED => CED ){
  val pos:Position
}
case class App( m:Int, n:Int, pos:Position ) extends Insn{
  override def apply( ced:CED ) = ced.e( m - 1 )( ced.e( n - 1 ), ced )
  override def toString = "App(%s,%s)".format(m, n)
}

case class Abs( m:Int, body:List[App] ,pos:Position ) extends Insn{
  override def apply( ced:CED ) =
    if( m == 1) CED( ced.c, Fn( body, ced.e ) :: ced.e, ced.d )
    else        CED( ced.c, Fn( Abs( m - 1, body, pos ) :: Nil, ced.e ) :: ced.e, ced.d )

  override def toString = "Abs(%s)".format(m)
}

case class CED( c:List[Insn], e:List[Value], d:List[CE] )
case class CE( c:List[Insn], e:List[Value] )

class GrassRuntime( val insn:List[Insn], val source:String){

  val e0 = Out :: Succ :: CharFn('w') :: In :: Nil
  val d0 = CE(Nil, Nil) :: CE( App(1, 1, NoPosition) :: Nil, Nil) :: Nil

  def run:Unit = {
    var c = eval( CED( insn, e0, d0 ) )
    while( c != None ){
      val Some(m) = c
      c = eval( m )
    }
  }

  def eval( ced:CED ) = ced.c match {
    case Nil => ced.d match {
      case Nil => None
      case x::xs  => Some( CED( x.c, ced.e.head:: x.e , xs ))
    }
    case code :: remains => Some( code( CED( remains, ced.e, ced.d )) )
  }
}

abstract class Value extends ( (Value, CED) => CED )

case class Fn(code : List[Insn], env : List[Value]) extends Value {
  override def apply( v:Value, ced:CED ) = CED( code , v :: env, CE( ced.c, ced.e ) :: ced.d )
  override def toString = "Fn"
}

case class CharFn(char : Char) extends Value {
  val ChurchTrue  = Fn( Abs( 1, App( 3, 2, NoPosition ) :: Nil, NoPosition ) :: Nil, Fn( Nil, Nil ) :: Nil )
  val ChurchFalse = Fn( Abs( 1, Nil,  NoPosition) :: Nil,  Nil)

  override def apply( v:Value, ced:CED ) = v match {
    // 明らかにリストの前に付加でないとおかしい
    case CharFn( c ) => CED( ced.c, ( if( char == c ) ChurchTrue else ChurchFalse ) :: ced.e, ced.d )
    case _ => throw new Exception("eval error value is not CharFn")
  }
  override def toString = "CharFn(%s, %s)".format( char , char.toInt)
}

object Succ extends Value {
  override def apply( v:Value, ced:CED ) = v match {
    case CharFn( c ) =>
      val char = ( (c + 1) % 256 ).toChar
      CED( ced.c, CharFn( char ) :: ced.e, ced.d )
    case _ => throw new Exception("eval error value is not CharFn")
  }
  override def toString = "Succ"
}

object Out extends Value {
  override def apply( v:Value, ced:CED ) = v match {
    case CharFn( c ) =>
      // 何故か Scala 1.9.1 だとこれでないと失敗する
      Console.print(c)
      CED( ced.c, v :: ced.e, ced.d )
    case _ => throw new Exception("eval error value is not CharFn")
  }
  override def toString = "Out"
}
object In extends Value {
  val cin = Source.stdin
  override def apply( v:Value, ced:CED ) ={
    // readChar は 1 文字ずつ読むのではない
    val c = if (cin.hasNext) CharFn( cin.next ) else v
    CED( ced.c, c :: ced.e, ced.d )
  }
  override def toString = "In"
}

object Home2LangParser extends RegexParsers{
  import scala.util.parsing.input.CharSequenceReader._
  override def skipWhitespace = false

  val wToken = "ほむ".r
  val sep = """[ \t]""".r
  val fToken = rep1( sep ) ~> rep1(wToken) <~ rep1( sep ) ^^ { x => "W" * x.length }
  val vToken = """\n""".r

  def p(s:String):Parser[String] = s

  def wrap[A](p: Parser[A]) = Parser{r => Success(r.pos,  r)} ~ p

  def w :Parser[String] = rep( comment ) ~> wToken <~ rep( comment )
  def f :Parser[String] = rep( comment ) ~> fToken <~ rep( comment )
  def v :Parser[String] = rep( comment ) ~> vToken <~ rep( comment )
  val any :Parser[String] = elem("", _ != EofCh) ^^ { _.toString }

  def token   :Parser[String] = wToken ||| fToken ||| vToken
  def comment :Parser[String] = not( token ) <~ any ^^ ( (Unit) => "" )

  def app :Parser[App] = wrap(  f  ~ rep1( w ) ) ^^
    { case ~( p, x ~ y ) => App( x.size, y.size, p ) }

  def abs :Parser[Abs] = wrap( rep1( w ) ~ rep( app ) ~ rep(v) ) ^^
    { case ~( p, ws ~ body ~ vs ) => Abs( ws.size, body, p ) }

  // Abs と App の並びの規則を Grass に一致させる
  def progel :Parser[List[Insn]] = rep1( abs ) | (rep1( app ) <~ rep( v ))
  def progtl :Parser[List[Insn]] = rep( progel ) ^^
    { case pr => pr.flatten }
  def prog :Parser[List[Insn]] = rep( v ) ~> abs ~ progtl ^^
    { case a ~ pr => a :: pr }

  def parse( s:String ):Option[GrassRuntime] = parseAll( prog , s ) match {
    case Success( insn, _ )  =>  Some( new GrassRuntime( insn, s ) )
    case Failure( msg, _ ) => { println( msg ); None }
    case Error( msg, _ )   => { println( msg ); None }
  }
  def run( s:String ) = parse( s ) foreach{ _.run }

  def test( s:String ) = parse( s ) foreach{ r => dump( r.insn, 0 ) }

  def dump( x:List[Insn] , n:Int ):Unit = {
    val sp = (for( i <- 0 to n ) yield{ "  " } ).mkString
    x.foreach{ o => o match {
      case Abs( i,b,_ ) => {
        println( sp + "Abs( " + i + ")")
        dump( b , n + 1 )
      }
      case App( i,j,_) => println( sp + "App( " + i + ", " + j + " )")
    }}
  }
}

object Homuhomu {
  def main(args:Array[String]):Unit = {

    if (args.length == 0) {
      println("Usage: homuhomu [-d] <source_file>")
      return
    }

    val (debug, srcFile) =
      if (args(0) == "-d" && args.length > 1)
        (true, args(1))
      else
        (false, args(0))

    val prog = Source.fromFile(new File(srcFile)).mkString
    if (debug) {
      println("AST:")
      Home2LangParser.test(prog)
    } else
      Home2LangParser.run(prog)
  }
}