277 lines
11 KiB
Swift
277 lines
11 KiB
Swift
public final class Interpreter {
|
|
public let globalEnv: Environment
|
|
let gensym: Gensym
|
|
public var output: (String) -> Void
|
|
|
|
public init() {
|
|
self.globalEnv = Environment()
|
|
self.gensym = Gensym()
|
|
self.output = { Swift.print($0, terminator: "") }
|
|
installBuiltins(into: globalEnv, interp: self)
|
|
loadPrelude()
|
|
}
|
|
|
|
public func evalTop(_ expr: Value) throws -> Value {
|
|
try run(.evaluating(expr, globalEnv, .done))
|
|
}
|
|
|
|
@discardableResult
|
|
public func evalString(_ source: String) throws -> Value {
|
|
let forms = try Reader(source).readProgram()
|
|
var last: Value = .unspecified
|
|
for form in forms {
|
|
last = try evalTop(form)
|
|
}
|
|
return last
|
|
}
|
|
|
|
func applyProcedure(_ proc: Value, _ args: [Value]) throws -> Value {
|
|
try run(.applying(proc, args, .done))
|
|
}
|
|
|
|
private func loadPrelude() {
|
|
do {
|
|
try evalString(preludeSource)
|
|
} catch {
|
|
fatalError("prelude failed to load: \(error)")
|
|
}
|
|
}
|
|
|
|
private func run(_ initial: MachineState) throws -> Value {
|
|
var state = initial
|
|
while true {
|
|
switch state {
|
|
case .returning(let value, let kont):
|
|
if case .done = kont { return value }
|
|
state = try applyKont(value, kont)
|
|
case .evaluating(let expr, let env, let kont):
|
|
state = try step(expr, env, kont)
|
|
case .applying(let proc, let args, let kont):
|
|
state = try apply(proc, args, kont)
|
|
}
|
|
}
|
|
}
|
|
|
|
private func applyKont(_ value: Value, _ kont: Kont) throws -> MachineState {
|
|
switch kont {
|
|
case .done:
|
|
return .returning(value, .done)
|
|
case .ifK(let then, let els, let env, let next):
|
|
if isTruthy(value) { return .evaluating(then, env, next) }
|
|
if let e = els { return .evaluating(e, env, next) }
|
|
return .returning(.unspecified, next)
|
|
case .defineK(let name, let env, let next):
|
|
if case .closure(let lam) = value, lam.name == "lambda" {
|
|
lam.name = baseName(name)
|
|
}
|
|
env.define(name, value)
|
|
return .returning(.unspecified, next)
|
|
case .setK(let name, let env, let next):
|
|
if !env.set(name, value) {
|
|
throw schemeError("set!: unbound variable: \(baseName(name))")
|
|
}
|
|
return .returning(.unspecified, next)
|
|
case .argsK(let pending, let accumulated, let env, let next):
|
|
var acc = accumulated
|
|
acc.append(value)
|
|
if case .pair(let p) = pending {
|
|
return .evaluating(p.car, env, .argsK(pending: p.cdr, accumulated: acc, env: env, next))
|
|
}
|
|
let proc = acc[0]
|
|
let args = Array(acc[1...])
|
|
return .applying(proc, args, next)
|
|
case .seqK(let remaining, let env, let next):
|
|
return seqState(remaining, env, next)
|
|
}
|
|
}
|
|
|
|
private func step(_ expr: Value, _ env: Environment, _ kont: Kont) throws -> MachineState {
|
|
switch expr {
|
|
case .symbol(let name):
|
|
guard let value = env.get(name) else {
|
|
throw schemeError("unbound variable: \(baseName(name))")
|
|
}
|
|
if case .syntax = value {
|
|
throw schemeError("syntactic keyword used as variable: \(baseName(name))")
|
|
}
|
|
return .returning(value, kont)
|
|
case .null:
|
|
throw schemeError("cannot evaluate empty list ()")
|
|
case .pair(let p):
|
|
if case .symbol(let s) = p.car {
|
|
let base = baseName(s)
|
|
if let head = env.get(s) {
|
|
if case .syntax(let rules) = head {
|
|
let expanded = try rules.expand(expr, gensym)
|
|
return .evaluating(expanded, env, kont)
|
|
}
|
|
} else if let special = try specialForm(base, expr, env, kont) {
|
|
return special
|
|
}
|
|
}
|
|
return .evaluating(p.car, env, .argsK(pending: p.cdr, accumulated: [], env: env, kont))
|
|
default:
|
|
return .returning(expr, kont)
|
|
}
|
|
}
|
|
|
|
private func specialForm(_ base: String, _ expr: Value, _ env: Environment, _ kont: Kont) throws -> MachineState? {
|
|
switch base {
|
|
case "quote":
|
|
return .returning(try cadrOf(expr), kont)
|
|
case "quasiquote":
|
|
return .evaluating(expandQuasi(try cadrOf(expr), 1), env, kont)
|
|
case "if":
|
|
let parts = try listToArray(expr)
|
|
guard parts.count >= 3 else { throw schemeError("malformed if") }
|
|
let els = parts.count > 3 ? parts[3] : nil
|
|
return .evaluating(parts[1], env, .ifK(then: parts[2], els: els, env: env, kont))
|
|
case "define":
|
|
return try evalDefine(expr, env, kont)
|
|
case "set!":
|
|
let parts = try listToArray(expr)
|
|
guard parts.count == 3, case .symbol(let name) = parts[1] else {
|
|
throw schemeError("malformed set!")
|
|
}
|
|
return .evaluating(parts[2], env, .setK(name: name, env: env, kont))
|
|
case "lambda":
|
|
let parts = try listToArray(expr)
|
|
guard parts.count >= 2 else { throw schemeError("malformed lambda") }
|
|
let closure = try makeClosure(parts[1], Array(parts[2...]), env, "lambda")
|
|
return .returning(closure, kont)
|
|
case "begin":
|
|
let parts = try listToArray(expr)
|
|
return seqState(Array(parts[1...]), env, kont)
|
|
case "let":
|
|
return .evaluating(try desugarLet(expr, gensym), env, kont)
|
|
case "let*":
|
|
return .evaluating(try desugarLetStar(expr), env, kont)
|
|
case "letrec", "letrec*":
|
|
return .evaluating(try desugarLetrec(expr), env, kont)
|
|
case "cond":
|
|
return .evaluating(try desugarCond(expr, gensym), env, kont)
|
|
case "case":
|
|
return .evaluating(try desugarCase(expr, gensym), env, kont)
|
|
case "and":
|
|
return .evaluating(try desugarAnd(expr), env, kont)
|
|
case "or":
|
|
return .evaluating(try desugarOr(expr, gensym), env, kont)
|
|
case "define-syntax":
|
|
let parts = try listToArray(expr)
|
|
guard parts.count == 3, case .symbol(let name) = parts[1] else {
|
|
throw schemeError("malformed define-syntax")
|
|
}
|
|
let rules = try SyntaxRules.parse(parts[2])
|
|
env.define(name, .syntax(rules))
|
|
return .returning(.unspecified, kont)
|
|
case "let-syntax", "letrec-syntax":
|
|
let parts = try listToArray(expr)
|
|
let bindings = try listToArray(parts[1])
|
|
let child = Environment(parent: env)
|
|
for b in bindings {
|
|
let bp = try listToArray(b)
|
|
guard case .symbol(let name) = bp[0] else { throw schemeError("bad let-syntax binding") }
|
|
child.define(name, .syntax(try SyntaxRules.parse(bp[1])))
|
|
}
|
|
return seqState(Array(parts[2...]), child, kont)
|
|
default:
|
|
return nil
|
|
}
|
|
}
|
|
|
|
private func evalDefine(_ expr: Value, _ env: Environment, _ kont: Kont) throws -> MachineState {
|
|
let parts = try listToArray(expr)
|
|
guard parts.count >= 2 else { throw schemeError("malformed define") }
|
|
switch parts[1] {
|
|
case .symbol(let name):
|
|
let valueExpr = parts.count > 2 ? parts[2] : .unspecified
|
|
return .evaluating(valueExpr, env, .defineK(name: name, env: env, kont))
|
|
case .pair(let header):
|
|
guard case .symbol(let name) = header.car else { throw schemeError("bad define header") }
|
|
let lambdaExpr = arrayToList([sym("lambda"), header.cdr] + Array(parts[2...]))
|
|
return .evaluating(lambdaExpr, env, .defineK(name: name, env: env, kont))
|
|
default:
|
|
throw schemeError("malformed define")
|
|
}
|
|
}
|
|
|
|
private func apply(_ proc: Value, _ args: [Value], _ kont: Kont) throws -> MachineState {
|
|
switch proc {
|
|
case .continuation(let saved):
|
|
return .returning(args.first ?? .unspecified, saved)
|
|
case .builtin(let builtin):
|
|
switch builtin.special {
|
|
case .callCC:
|
|
guard args.count == 1 else {
|
|
throw schemeError("call/cc expects 1 argument")
|
|
}
|
|
let continuation = Value.continuation(kont)
|
|
return .applying(args[0], [continuation], kont)
|
|
case .apply:
|
|
guard args.count >= 2 else {
|
|
throw schemeError("apply expects at least 2 arguments")
|
|
}
|
|
let target = args[0]
|
|
let middle = Array(args[1..<(args.count - 1)])
|
|
let tail = try listToArray(args[args.count - 1])
|
|
return .applying(target, middle + tail, kont)
|
|
case .none:
|
|
let value = try builtin.fn(args)
|
|
return .returning(value, kont)
|
|
}
|
|
case .closure(let lam):
|
|
let newEnv = try bindArguments(lam, args)
|
|
return seqState(lam.body, newEnv, kont)
|
|
default:
|
|
throw schemeError("not a procedure", [proc])
|
|
}
|
|
}
|
|
|
|
private func bindArguments(_ lam: Lambda, _ args: [Value]) throws -> Environment {
|
|
let newEnv = Environment(parent: lam.env)
|
|
if lam.rest == nil {
|
|
guard args.count == lam.params.count else {
|
|
throw schemeError("\(lam.name): expected \(lam.params.count) arguments, got \(args.count)")
|
|
}
|
|
} else {
|
|
guard args.count >= lam.params.count else {
|
|
throw schemeError("\(lam.name): expected at least \(lam.params.count) arguments, got \(args.count)")
|
|
}
|
|
}
|
|
for (i, p) in lam.params.enumerated() {
|
|
newEnv.define(p, args[i])
|
|
}
|
|
if let rest = lam.rest {
|
|
newEnv.define(rest, arrayToList(Array(args[lam.params.count...])))
|
|
}
|
|
return newEnv
|
|
}
|
|
|
|
private func seqState(_ exprs: [Value], _ env: Environment, _ kont: Kont) -> MachineState {
|
|
if exprs.isEmpty { return .returning(.unspecified, kont) }
|
|
if exprs.count == 1 { return .evaluating(exprs[0], env, kont) }
|
|
return .evaluating(exprs[0], env, .seqK(remaining: Array(exprs[1...]), env: env, kont))
|
|
}
|
|
}
|
|
|
|
func makeClosure(_ formals: Value, _ body: [Value], _ env: Environment, _ name: String) throws -> Value {
|
|
if case .symbol(let rest) = formals {
|
|
return .closure(Lambda(params: [], rest: rest, body: body, env: env, name: name))
|
|
}
|
|
let (elems, tail) = listToArrayWithTail(formals)
|
|
var params: [String] = []
|
|
for e in elems {
|
|
guard case .symbol(let p) = e else { throw schemeError("bad lambda formal") }
|
|
params.append(p)
|
|
}
|
|
var rest: String? = nil
|
|
if case .symbol(let r) = tail {
|
|
rest = r
|
|
} else if case .null = tail {
|
|
rest = nil
|
|
} else {
|
|
throw schemeError("bad lambda formals")
|
|
}
|
|
return .closure(Lambda(params: params, rest: rest, body: body, env: env, name: name))
|
|
}
|