Skip to content

Instantly share code, notes, and snippets.

@zr-tex8r
Forked from yuroyoro/Home2Lang.scala
Created December 17, 2011 22:43
Show Gist options
  • Save zr-tex8r/1491665 to your computer and use it in GitHub Desktop.
Save zr-tex8r/1491665 to your computer and use it in GitHub Desktop.
プログラミング言語「ほむほむ」(Grass 同型版)
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)
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment