Recursive descent parsing in Cool

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)

parse.cl

-- 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();
      }

  };
};