From 853d729e62da93bfe283445ff4feecf457361a7e Mon Sep 17 00:00:00 2001 From: DualFroz Date: Mon, 24 Aug 2026 16:20:00 +0200 Subject: [PATCH] feat(eval): add cek evaluator with special forms --- Sources/KiteCore/Interpreter.swift | 276 +++++++++++++++++++++++++++++ 1 file changed, 276 insertions(+) create mode 100644 Sources/KiteCore/Interpreter.swift diff --git a/Sources/KiteCore/Interpreter.swift b/Sources/KiteCore/Interpreter.swift new file mode 100644 index 0000000..dd466b8 --- /dev/null +++ b/Sources/KiteCore/Interpreter.swift @@ -0,0 +1,276 @@ +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)) +}