プログラミング言語「ほむほむ」(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