blob: 12a275004d62b951e451e40723235023b5a101de [file] [log] [blame]
(* Copyright (c) 2017, the Dart project authors. Please see the AUTHORS file
for details. All rights reserved. Use of this source code is governed by a
BSD-style license that can be found in the LICENSE file.
(* Syntax of Henry I, more or less.
Some things are different, for example ReturnStatement has an optional
expression. References are implemented as SML ref types though in a real
implementation they would have to be option refs, provided the tree was built
bottom up, so that they could be initialized to ref NONE.
Integer ids are assigned to variable declarations and classes, so that they
can be compared for identity or so-called pointer equality.
structure Syntax
= struct
type identifier = string
datatype type_
= InterfaceType of {class: class ref}
| FunctionType of {returnType: type_, parameterType: type_}
and expression
= VariableGet of {variable: variable_declaration ref}
| MethodInvocation of
{receiver: expression,
name: identifier,
argument: expression}
| ConstructorInvocation of {class: class ref}
| PropertyGet of {receiver: expression, name: identifier}
and statement
= ExpressionStatement of {expression: expression}
| ReturnStatement of {expression: expression option}
| Block of {statements: statement list}
and member
= Class of class
| Procedure of procedure
withtype variable_declaration = {id: int, type_: type_}
and procedure =
{returnType: type_,
name: identifier,
parameter: variable_declaration,
body: statement}
and class = {id: int, procedures: procedure list}
type library = {members: member list}
(* The higher-order interpreter. *)
structure Semantics
= struct
structure S = Syntax
(* The environment maps variable declaration ids to their values. It is
implemented as a list of pairs.
There is a non-exhaustive pattern match which should not be reached for
well-formed Henry I programs.
type 'a environment = (int * 'a) list
fun apply_env ((i, v) :: env, d: S.variable_declaration ref)
= if i = #id (!d) then v else apply_env (env, d)
(* - A (runtime) class is a pair of the class id and a getter suite.
- A getter suite is a map from getter names (identifiers) to getters.
- A getter is a function from receiver to result values. In Henry I
getters are method tearoffs and so they have no effects (they cannot
throw, for example).
- Object values have only a class (objects have no fields in Henry I).
Null and NoSuchMethod are objects with distinguished classes.
- Functions are method tearoffs. They also have a getter suite because
they can have getters (e.g., "call" or "equals"). They hold a method
which is a function taking the single argument and a error and return
datatype value
= ObjectValue of class
| FunctionValue of class * (value * (value -> unit) * (value -> unit) -> unit)
withtype getter = value -> value
and getter_suite = (S.identifier * getter) list
and class = int * getter_suite
(* Given a name and a value, lookup a getter which may not exist. *)
fun lookup_getter (name, v)
= let fun find_in nil
| find_in ((x, f) :: gs)
= if name = x then SOME f else find_in gs
in case v
of ObjectValue (_, gs)
=> find_in gs
| FunctionValue ((_, gs), _)
=> find_in gs
(* A class table is a map from a class id to its getter suite.
There is a non-exhaustive pattern match which should not be reached for
well-formed Henry I programs.
type class_table = (int * getter_suite) list
fun lookup_class (c: S.class ref, (cid, gs) :: ct)
= if #id (!c) = cid then gs else lookup_class (c, ct)
(* For convenience we just use a global class table because it's annoying to
pass it. It is immutable and doesn't change once initialized before
program execution.
val ct: class_table option ref = ref NONE
fun class_table () = Option.valOf (!ct)
(* Getter suites for builtin in classes. *)
(* The getter that tears off the call method of a FunctionValue is cute. *)
fun function_class (): class = (~1, [("call", fn v => v)])
fun null_class (): class = (~2, nil)
fun no_such_method_class(): class = (~3, nil)
fun apply (v0 as ObjectValue _, v1, ek, k)
= (case lookup_getter ("call", v0)
of NONE => ek (ObjectValue (no_such_method_class ()))
| SOME g => apply (g v0, v1, ek, k))
| apply (FunctionValue (_, f), v, ek, k)
= f (v, ek, k)
fun eval (S.VariableGet {variable = d}, env, ek, k)
= k (apply_env (env, d))
| eval (S.MethodInvocation {receiver = e0, name = x, argument = e1},
env, ek, k)
= eval (e0, env, ek,
fn v0 =>
(case lookup_getter (x, v0)
=> eval (e1, env, ek,
fn _ =>
ek (ObjectValue (no_such_method_class ())))
| SOME g
=> let val f = g v0
in eval (e1, env, ek, fn v1 => apply (f, v1, ek, k))
| eval (S.ConstructorInvocation {class = c}, env, ek, k)
= k (ObjectValue (#id (!c), lookup_class (c, class_table ())))
| eval (S.PropertyGet {receiver = e, name = x}, env, ek, k)
= eval (e, env, ek,
fn v =>
(case lookup_getter (x, v)
=> ek (ObjectValue (no_such_method_class ()))
| SOME g
=> k (g v)))
fun exec (S.ExpressionStatement {expression = e}, env, rk, ek, sk)
= eval (e, env, ek, fn _ => sk ())
| exec (S.ReturnStatement {expression = NONE}, env, rk, ek, sk)
= rk (ObjectValue (null_class ()))
| exec (S.ReturnStatement {expression = SOME e}, env, rk, ek, sk)
= eval (e, env, ek, rk)
| exec (S.Block {statements = ss}, env, rk, ek, sk)
= exec_stmts (ss, env, rk, ek, sk)
and exec_stmts (nil, env, rk, ek, sk)
= sk ()
| exec_stmts (s :: ss, env, rk, ek, sk)
= exec (s, env, rk, ek,
fn () => exec_stmts (ss, env, rk, ek, sk))
(* Loading the class table. A procedure in a class induces a getter which
tears off the procedure.
fun process_procedure ({returnType = t,
name = x,
parameter = p,
body = b}: S.procedure): S.identifier * getter
= (x, fn _ =>
(function_class (),
fn (v, ek, k) =>
exec (b, [(#id p, v)], ek, k,
fn () => k (ObjectValue (null_class ())))))
fun process_class ({id = n, procedures = ps}: S.class): int * getter_suite
= (n, process_procedure ps)
fun run {members = ms}
= let fun process_members nil
= nil
| process_members (S.Class c :: ms)
= process_class c :: process_members ms
| process_members (S.Procedure p :: ms)
= process_members ms
val _ = ct := SOME (process_members ms)
(* There is a non-exhaustive pattern match below which should not
be possible for well-formed Henry I programs.
fun find_main (S.Class c :: ms)
= find_main ms
| find_main (S.Procedure p :: ms)
= if #name p = "main" then p else find_main ms
in exec (#body (find_main ms), nil,
fn v => print "done",
fn e => print "error",
fn () => print "done")