Skip to content

Instantly share code, notes, and snippets.

@siraben
Last active September 25, 2022 18:32
Show Gist options
  • Save siraben/9c90e8408265a39f61111f9b50bb4191 to your computer and use it in GitHub Desktop.
Save siraben/9c90e8408265a39f61111f9b50bb4191 to your computer and use it in GitHub Desktop.
Recursive descent parsing in Cool
((\f. (\x. (f \v. ((x x) v)) \x. (f \v. ((x x) v))) \r. \n. i(n,o,m(n,(r d(n))))) x)
-- Recursive descent parsing in Cool
class Scanner inherits IO {
s : String <- ""; s() : String { s };
nextLine() : String { { s <- in_string(); s; } };
isLetter(s : String) : Bool {
if s.length() = 1 then if "a" <= s then s <= "z" else false fi else false fi
};
isDigit(s : String) : Bool {
if s.length() = 1 then if "0" <= s then s <= "9" else false fi else false fi
};
nextChar() : String {
if s.length() = 0 then { nextLine(); if s.length() = 0 then {abort();"x";} else nextChar() fi; }
else let c : String <- s.substr(0,1) in { s <- s.substr(1,s.length()-1); c; }
fi
};
-- look at the next character without consuming it
peekChar() : String {
if s.length() = 0 then { nextLine(); if s.length() = 0 then {abort();"x";} else nextChar() fi; }
else s.substr(0,1)
fi
};
isSpace(s : String) : Bool {
if s = "\n" then true else
if s = " " then true else
if s = "\t" then true else
false fi fi fi
};
skipSpaces() : Object {
if 0 < s.length() then
while isSpace(peekChar()) loop nextChar() pool
else
self
fi
};
-- match character and continue or fail
match_aux(c : String) : Object {
let p : String <- peekChar() in
if p = c then nextChar() else { out_string("Expected ".concat(c).concat(" but got ").concat(p).concat("\n")); abort(); } fi
};
matchc(c : String) : Object { let p : Object <- match_aux(c) in {skipSpaces();p;} };
fail(m : String) : Object {
{ out_string("Scanner: aborting with message ".concat(s).concat("\n")); abort(); }
};
};
class Expr inherits IO {
e : ExprD; e() : ExprD { e };
print_aux(e : ExprD) : IO {
case e of
e : Var => out_string(e.v());
e : Add => {
print_aux(e.l());
out_string("+");
print_aux(e.r());
};
e : Mul => {
out_string("m(");
print_aux(e.l());
out_string(",");
print_aux(e.r());
out_string(")");
};
e : Sub1 => {
out_string("d(");
print_aux(e.arg());
out_string(")");
};
e : App => {
out_string("(");
print_aux(e.lapp());
out_string(" ");
print_aux(e.rapp());
out_string(")");
};
e : Abs => {
out_string("\\".substr(0,1));
out_string(e.lbound());
out_string(". ");
print_aux(e.lbody());
};
e : Ifz => {
out_string("i(");
print_aux(e.p());
out_string(",");
print_aux(e.c());
out_string(",");
print_aux(e.a());
out_string(")");
};
esac
};
print() : IO { print_aux(e) };
expr(x : ExprD) : Expr { { e <- x; self; } };
};
class ExprD {
v() : String { { abort(); v(); } };
lbound() : String { { abort(); lbound(); } };
lbody() : ExprD { { abort(); lbody(); } };
lapp() : ExprD { { abort(); lapp(); } };
rapp() : ExprD { { abort(); rapp(); } };
-- for general binary operators
l() : ExprD { { abort(); l(); } };
r() : ExprD { { abort(); r(); } };
-- for if
p() : ExprD { { abort(); p(); } };
c() : ExprD { { abort(); c(); } };
a() : ExprD { { abort(); a(); } };
-- for unary operators
arg() : ExprD { { abort(); arg(); } };
};
class Var inherits ExprD {
v : String; v() : String { v };
var(x : String) : Var { { v <- x; self; } };
};
class Abs inherits ExprD {
lbound : String; lbound() : String { lbound };
lbody : ExprD; lbody() : ExprD { lbody };
abs(x : String, b : ExprD) : Abs { { lbound <- x; lbody <- b; self; } };
};
class App inherits ExprD {
lapp : ExprD; lapp() : ExprD { lapp };
rapp : ExprD; rapp() : ExprD { rapp };
app(l : ExprD, r : ExprD) : App { { lapp <- l; rapp <- r; self; } };
};
class Add inherits ExprD {
l : ExprD; l() : ExprD { l };
r : ExprD; r() : ExprD { r };
add(x : ExprD, y : ExprD) : Add { { l <- x; r <- y; self; } };
};
class Mul inherits ExprD {
l : ExprD; l() : ExprD { l };
r : ExprD; r() : ExprD { r };
mul(x : ExprD, y : ExprD) : Mul { { l <- x; r <- y; self; } };
};
-- if (n+1) a b => a
-- if 0 a b => b
class Ifz inherits ExprD {
p : ExprD; p() : ExprD { p };
c : ExprD; c() : ExprD { c };
a : ExprD; a() : ExprD { a };
ifz(x : ExprD, y : ExprD, z : ExprD) : Ifz {
{
p <- x;
c <- y;
a <- z;
self;
}
};
};
class Sub1 inherits ExprD {
arg : ExprD; arg() : ExprD { arg };
sub1(e : ExprD) : Sub1 { { arg <- e; self; } };
};
(*
grammar for expr
expr ::= var -- variable
| \x. expr -- abstraction
| (expr expr) -- application
| a(expr, expr) -- addition
| d(expr) -- decrement
| m(expr, expr) -- multiplication
| i(expr, expr, expr) -- if
*)
class ExprParser inherits IO {
s : Scanner <- new Scanner;
getExpr() : ExprD { { s.nextLine(); expr(); } };
var() : Var {
let v : String <- s.peekChar() in if s.isLetter(v) then {s.matchc(v); new Var.var(v); }
else case s.fail("failed to read variable") of s : Var => s; esac fi
};
abs() : Abs {
let
v : String,
e : ExprD
in
{
s.matchc("\\".substr(0,1));
v <- var().v();
s.matchc(".");
e <- expr();
new Abs.abs(v,e);
}
};
app() : App {
let
l : ExprD,
r : ExprD
in
{
s.matchc("(");
l <- expr();
r <- expr();
s.matchc(")");
new App.app(l,r);
}
};
expr() : ExprD {
let
p : String <- s.peekChar()
in
if p = "\\".substr(0,1) then abs() else
if p = "(" then app()
else if p = "d" then
let l : ExprD in
{
s.matchc("d"); s.matchc("("); l <- expr(); s.matchc(")");
new Sub1.sub1(l);
}
else if p = "a" then
let l : ExprD, r : ExprD in
{
s.matchc("a"); s.matchc("("); l <- expr(); s.matchc(","); r <- expr(); s.matchc(")");
new Add.add(l,r);
}
else if p = "m" then
let l : ExprD, r : ExprD in
{
s.matchc("m"); s.matchc("("); l <- expr(); s.matchc(","); r <- expr(); s.matchc(")");
new Mul.mul(l,r);
}
else if p = "i" then
let p : ExprD, c : ExprD, a : ExprD in
{
s.matchc("i"); s.matchc("("); p <- expr(); s.matchc(","); c <- expr(); s.matchc(","); a <- expr(); s.matchc(")");
new Ifz.ifz(p,c,a);
}
else var()
fi fi fi fi fi fi
};
};
class Eval inherits IO {
eval(e : ExprD, env : EnvD) : ValD {
case e of
e : Var => new Env.env(env).lookup(e.v()).v(); -- lookup in env
e : Abs => new Clos.clos(env,e.lbound(),e.lbody());
e : App =>
let r : ValD <- eval(e.rapp(),env) in
case eval(e.lapp(),env) of
v : Clos => eval(v.expr(), new ExtEnv.extenv(v.var(),r,v.env()));
esac;
e : Add =>
case eval(e.l(),env) of
e1 : IntV =>
case eval(e.r(),env) of
e2 : IntV => new IntV.int(e1.v() + e2.v());
esac;
esac;
e : Mul =>
case eval(e.l(),env) of
e1 : IntV =>
case eval(e.r(),env) of
e2 : IntV => new IntV.int(e1.v() * e2.v());
esac;
esac;
e : Ifz =>
case eval(e.p(),env) of
v : IntV => eval(if v.v() = 0 then e.c() else e.a() fi,env);
esac;
e : Sub1 =>
case eval(e.arg(),env) of
v : IntV => new IntV.int(v.v()-1);
esac;
esac
};
};
-- Value types
(*
data Val = Clos Env String Expr
| Int i
*)
class ValD {
var() : String { { abort(); var(); } };
v() : Int { { abort(); v(); } };
env() : EnvD { { abort(); env(); } };
expr() : ExprD { { abort(); expr(); } };
};
class IntV inherits ValD {
v : Int; v() : Int { v };
int(x : Int) : IntV { { v <- x; self; } };
};
class Clos inherits ValD {
var : String; var() : String { var };
env : EnvD; env() : EnvD { env };
expr : ExprD; expr() : ExprD { expr };
clos(a : EnvD, b : String, c : ExprD) : Clos { { env <- a; var <- b; expr <- c; self; } };
};
class Val inherits IO {
v : ValD; v() : ValD { v };
print() : IO {
case v of
v : IntV => out_int(v.v());
v : Clos => out_string("<LAM>");
esac
};
val(x : ValD) : Val { { v <- x; self; } };
};
(*
data Env = EmptyEnv
| ExtEnv String Val Env
*)
class EnvD {
k() : String { { abort(); k(); } };
v() : ValD { { abort(); v(); } };
t() : EnvD { { abort(); t(); } };
};
class EmptyEnv inherits EnvD {};
class ExtEnv inherits EnvD {
k : String; k() : String { k };
v : ValD; v() : ValD { v };
t : EnvD; t() : EnvD { t };
extenv(a : String, b : ValD, r : EnvD) : EnvD { { k <- a; v <- b; t <- r; self; } };
};
-- Optional values
(*
data Optional = None | Some ValD
*)
class OptionalD {
v() : ValD { { abort(); v(); }};
};
class None inherits OptionalD {};
class Some inherits OptionalD {
v : ValD; v() : ValD { v };
some(x : ValD) : OptionalD { { v <- x; self; } };
};
class Env inherits IO {
m : EnvD <- new EmptyEnv;
lookup_aux(m : EnvD, s : String) : OptionalD {
case m of
m : EmptyEnv => {out_string("unbound var ".concat(s).concat("\n")); new None;};
m : ExtEnv => if m.k() = s then new Some.some(m.v()) else lookup_aux(m.t(),s) fi;
esac
};
lookup(s : String) : OptionalD { lookup_aux(m,s) };
add(k : String, v : ValD) : Env {
{ m <- new ExtEnv.extenv(k,v,m); self; }
};
env(x : EnvD) : Env { { m <- x; self; } };
v() : EnvD { m };
};
-- factorial program
(*
$ cat factorial.txt
((\f. (\x. (f \v. ((x x) v)) \x. (f \v. ((x x) v))) \r. \n. i(n,o,m(n,(r d(n))))) x)
$ cool-osx parse.cl < factorial.txt
((\f. (\x. (f \v. ((x x) v)) \x. (f \v. ((x x) v))) \r. \n. i(n,o,m(n,(r d(n))))) x)
3628800
*)
class Main inherits IO {
and(x : Bool, y : Bool) : Bool {
if x then y else false fi
};
main() : Object {
let
e : Expr <- new Expr.expr(new ExprParser.getExpr()),
s : EnvD <- new Env.add("x",new IntV.int(10))
.add("o", new IntV.int(1))
.v()
in
{
e.print();
out_string("\n");
new Val.val(new Eval.eval(e.e(),s)).print();
}
};
};
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment