class SimpleFactorInterp extends StdTokenParsers with ImplicitConversions with Opecode{
type Tokens = Lexer
val lexical = new Tokens
lexical.reserved ++= List("t", "f", "(", ")", "[", "]", ":", ";", "--")
lexical.delimiters ++= List("\n", " ", "\t")
import lexical.{NumericLit, StringLit, Keyword, Identifier}
def program = rep(lWord) ^^ { case nodes => NodeProgram(nodes) }
def lWord = ":" ~ lSymbol ~ "(" ~ rep(lSymbol) ~ "--" ~ rep(lSymbol) ~ ")" ~ rep(lExpr) ~ ";" ^^
{ case ":" ~ name ~ "(" ~ sin ~ "--" ~ sout ~ ")" ~ body ~ ";" =>
NodeNamed(NamedWord(name.value, sin, sout, body+NodeOpe(OP_RTN, List[Node]()))) }
def lExpr:Parser[Node] = (lString | lNumber | lBool | lInvokeWord | lQuotation)
def lString = accept("string", { case StringLit(n) => NodeOpe(OP_PUSH, List(NodeStr(n))) })
def lNumber = accept("number", { case NumericLit(n) => NodeOpe(OP_PUSH, List(NodeInt(n.toInt))) })
def lBool = accept("boolean",{ case Keyword("t") => NodeOpe(OP_PUSH, List(NodeBool(true)))
case Keyword("f") => NodeOpe(OP_PUSH, List(NodeBool(false))) })
def lInvokeWord = accept("symbol", { case Identifier(n) => NodeOpe(OP_CALL, List(NodeSymbol(n))) })
def lQuotation = "[" ~> rep(lExpr) <~ "]" ^^ { case expr => NodeQuotation(expr+NodeOpe(OP_RTN, List[Node]())) }
def lSymbol = accept("symbol", { case Identifier(n) => NodeSymbol(n) })
protected val stack = new Stack[Node]
protected var namedTable = new NamedTable
def parse(input: String) =
phrase(program)(new lexical.Scanner(input)) match {
case Success(programNode, _) => initTopLevel(programNode.toplevel)
case x => error(x.toString)
}
def initTopLevel(toplevelNodes:List[Node]) = {
def sl(v:String) = v.split(" ").map(NodeSymbol).toList
def nword[T](n:String, sin:String, sout:String, m:()=>T) =
(n, NamedNativeWord(n, sl(sin), sl(sout), m))
namedTable ++= List(
nword("drop", "x", "", ()=>{ pop }),
nword("dup", "x", "x x", ()=>{ val v = pop; npush(v,v) }),
nword("rotate", "x y z", "y z x", ()=> npop(3) match {
case List(x, y, z) => npush(y, z, x)
}),
nword("swap", "x y", "y x", ()=> npop(2) match {
case List(x, y) => npush(y, x)
}),
nword("+", "x y", "z", ()=>{ iArI2(_+_) }),
nword("-", "x y", "z", ()=>{ iArI2(_-_) }),
nword("*", "x y", "z", ()=>{ iArI2(_*_) }),
nword("/", "x y", "z", ()=>{ iArI2(_/_) }),
nword(">", "x y", "?", ()=>{ ilB2(_>_) }),
nword("<", "x y", "?", ()=>{ ilB2(_<_) }),
nword("==", "x y", "?", ()=>{ ilB2(_==_) }),
nword(">=", "x y", "?", ()=>{ ilB2(_>=_) }),
nword("<=", "x y", "?", ()=>{ ilB2(_<=_) }),
nword("not", "?", "?", ()=> pop match {
case NodeBool(v) => push(NodeBool(!v))
}),
nword("and", "? ?", "?", ()=> (pop, pop) match {
case (NodeBool(true), NodeBool(true)) => push(NodeBool(true))
case (NodeBool(_), NodeBool(_)) => push(NodeBool(false))
}),
nword("or", "? ?", "?", ()=> (pop, pop) match {
case (NodeBool(false), NodeBool(false)) => push(NodeBool(false))
case (NodeBool(_), NodeBool(_)) => push(NodeBool(true))
}),
nword(".", "obj", "", ()=>{ println(pop.value) }),
nword("call", "quot", "", ()=> pop match {
case NodeSymbol(qname) => callWord(qname)
}),
nword("if", "? quot quot", "", ()=> (pop, pop, pop) match {
case (_, NodeSymbol(qname), NodeBool(true)) => callWord(qname)
case (NodeSymbol(qname), _, NodeBool(false)) => callWord(qname)
}),
nword("string>number", "str", "x", ()=> pop match {
case NodeStr(str) => push(NodeInt(str.toInt))
}),
nword(">string", "obj", "str", ()=> { push(NodeStr(pop.value.toString)) })
)
toplevelNodes.foreach {
case NodeNamed(n@NamedWord(name, _, _, _)) => namedTable(name) = n
case _ => ()
}
}
def evaluate(input:String, args:Array[String]) = {
parse(input)
args.map(NodeStr).foreach(push _)
callWord("main")
}
def callWord(wordName:String):unit =
namedTable(wordName.ensuring(namedTable.contains _, "word '"+wordName+"' is not defined.")) match {
case NamedNativeWord(_, sin, sout, body) => try {
body()
} catch {
case e => wordError(wordName, sin, sout)
throw e
}
case NamedWord(_, sin, sout, body) =>
body foreach {
case NodeOpe(OP_PUSH, List(v, _*)) => push(v)
case NodeOpe(OP_CALL, List(NodeSymbol(name), _*)) =>
try {
callWord(name)
}catch {
case e => wordError(wordName, sin, sout)
throw e
}
case NodeOpe(OP_RTN, _) => ()
}
}
def npop(n:int):List[Node] = (1 to n).map(x=>pop).reverse.toList
def npush(ns:Node*) = ns.reverse.foreach(push(_))
def iArI2(f:(int,int)=>int) = (pop, pop) match {
case (NodeInt(v1), NodeInt(v2)) => push(NodeInt(f(v2,v1)))
}
def ilB2(f:(int,int)=>boolean) = (pop, pop) match {
case (NodeInt(v1), NodeInt(v2)) => push(NodeBool(f(v2,v1)))
}
def wordError(name:String, sin:List[NodeSymbol], sout:List[NodeSymbol]) = {
printf("word '%s' ( %s -- %s ).\n", name, sin.map(_.value).mkString(" "),
sout.map(_.value).mkString(" "))
}
def push(a:Node) = stack.push(a)
def pop = stack.pop
}
