feat(eval): add special form desugaring and quasiquote
This commit is contained in:
dualfroz committed
1 parent
853d729e62
commit
af0a0aca5b
1 file changed
+173
@@ -0,0 +1,173 @@
|
||||
func sym(_ name: String) -> Value { .symbol(name) }
|
||||
func listV(_ items: [Value]) -> Value { arrayToList(items) }
|
||||
func quoteExpr(_ v: Value) -> Value { listV([sym("quote"), v]) }
|
||||
|
||||
func cadrOf(_ form: Value) throws -> Value {
|
||||
let parts = try listToArray(form)
|
||||
guard parts.count >= 2 else { throw schemeError("malformed form", [form]) }
|
||||
return parts[1]
|
||||
}
|
||||
|
||||
func desugarLet(_ form: Value, _ gensym: Gensym) throws -> Value {
|
||||
let elems = try listToArray(form)
|
||||
guard elems.count >= 3 else { throw schemeError("malformed let") }
|
||||
if case .symbol(let name) = elems[1] {
|
||||
let bindings = try listToArray(elems[2])
|
||||
let body = Array(elems[3...])
|
||||
var vars: [Value] = []
|
||||
var inits: [Value] = []
|
||||
for b in bindings {
|
||||
let bp = try listToArray(b)
|
||||
vars.append(bp[0])
|
||||
inits.append(bp.count > 1 ? bp[1] : .unspecified)
|
||||
}
|
||||
let lambdaExpr = listV([sym("lambda"), listV(vars)] + body)
|
||||
let letrecBindings = listV([listV([sym(name), lambdaExpr])])
|
||||
let call = listV([sym(name)] + inits)
|
||||
return listV([sym("letrec"), letrecBindings, call])
|
||||
}
|
||||
let bindings = try listToArray(elems[1])
|
||||
let body = Array(elems[2...])
|
||||
var vars: [Value] = []
|
||||
var inits: [Value] = []
|
||||
for b in bindings {
|
||||
let bp = try listToArray(b)
|
||||
vars.append(bp[0])
|
||||
inits.append(bp.count > 1 ? bp[1] : .unspecified)
|
||||
}
|
||||
let lambdaExpr = listV([sym("lambda"), listV(vars)] + body)
|
||||
return listV([lambdaExpr] + inits)
|
||||
}
|
||||
|
||||
func desugarLetStar(_ form: Value) throws -> Value {
|
||||
let elems = try listToArray(form)
|
||||
let bindings = try listToArray(elems[1])
|
||||
let body = Array(elems[2...])
|
||||
if bindings.isEmpty {
|
||||
return listV([listV([sym("lambda"), .null] + body)])
|
||||
}
|
||||
let first = bindings[0]
|
||||
let rest = Array(bindings[1...])
|
||||
let inner = listV([sym("let*"), listV(rest)] + body)
|
||||
return listV([sym("let"), listV([first]), inner])
|
||||
}
|
||||
|
||||
func desugarLetrec(_ form: Value) throws -> Value {
|
||||
let elems = try listToArray(form)
|
||||
let bindings = try listToArray(elems[1])
|
||||
let body = Array(elems[2...])
|
||||
var vars: [Value] = []
|
||||
var setExprs: [Value] = []
|
||||
for b in bindings {
|
||||
let bp = try listToArray(b)
|
||||
vars.append(bp[0])
|
||||
setExprs.append(listV([sym("set!"), bp[0], bp.count > 1 ? bp[1] : .unspecified]))
|
||||
}
|
||||
let lambdaBody = setExprs + body
|
||||
let lambdaExpr = listV([sym("lambda"), listV(vars)] + lambdaBody)
|
||||
let args = vars.map { _ in Value.unspecified }
|
||||
return listV([lambdaExpr] + args)
|
||||
}
|
||||
|
||||
func desugarCond(_ form: Value, _ gensym: Gensym) throws -> Value {
|
||||
let clauses = Array(try listToArray(form)[1...])
|
||||
var result: Value = .unspecified
|
||||
for clause in clauses.reversed() {
|
||||
let parts = try listToArray(clause)
|
||||
guard let test = parts.first else { throw schemeError("empty cond clause") }
|
||||
if case .symbol(let s) = test, baseName(s) == "else" {
|
||||
result = listV([sym("begin")] + Array(parts[1...]))
|
||||
} else if parts.count >= 3, case .symbol(let arrow) = parts[1], baseName(arrow) == "=>" {
|
||||
let temp = freshTemp(gensym)
|
||||
result = listV([
|
||||
sym("let"), listV([listV([sym(temp), test])]),
|
||||
listV([sym("if"), sym(temp), listV([parts[2], sym(temp)]), result]),
|
||||
])
|
||||
} else if parts.count == 1 {
|
||||
let temp = freshTemp(gensym)
|
||||
result = listV([
|
||||
sym("let"), listV([listV([sym(temp), test])]),
|
||||
listV([sym("if"), sym(temp), sym(temp), result]),
|
||||
])
|
||||
} else {
|
||||
let thenExpr = listV([sym("begin")] + Array(parts[1...]))
|
||||
result = listV([sym("if"), test, thenExpr, result])
|
||||
}
|
||||
}
|
||||
return result
|
||||
}
|
||||
|
||||
func desugarCase(_ form: Value, _ gensym: Gensym) throws -> Value {
|
||||
let parts = try listToArray(form)
|
||||
let key = parts[1]
|
||||
let clauses = Array(parts[2...])
|
||||
let temp = freshTemp(gensym)
|
||||
var condClauses: [Value] = []
|
||||
for clause in clauses {
|
||||
let cparts = try listToArray(clause)
|
||||
if case .symbol(let s) = cparts[0], baseName(s) == "else" {
|
||||
condClauses.append(listV([sym("else")] + Array(cparts[1...])))
|
||||
} else {
|
||||
let test = listV([sym("memv"), sym(temp), quoteExpr(cparts[0])])
|
||||
condClauses.append(listV([test] + Array(cparts[1...])))
|
||||
}
|
||||
}
|
||||
let condForm = listV([sym("cond")] + condClauses)
|
||||
return listV([sym("let"), listV([listV([sym(temp), key])]), condForm])
|
||||
}
|
||||
|
||||
func desugarAnd(_ form: Value) throws -> Value {
|
||||
let parts = Array(try listToArray(form)[1...])
|
||||
func andOf(_ xs: [Value]) -> Value {
|
||||
if xs.isEmpty { return .bool(true) }
|
||||
if xs.count == 1 { return xs[0] }
|
||||
return listV([sym("if"), xs[0], andOf(Array(xs[1...])), .bool(false)])
|
||||
}
|
||||
return andOf(parts)
|
||||
}
|
||||
|
||||
func desugarOr(_ form: Value, _ gensym: Gensym) throws -> Value {
|
||||
let parts = Array(try listToArray(form)[1...])
|
||||
func orOf(_ xs: [Value]) -> Value {
|
||||
if xs.isEmpty { return .bool(false) }
|
||||
if xs.count == 1 { return xs[0] }
|
||||
let temp = freshTemp(gensym)
|
||||
return listV([
|
||||
sym("let"), listV([listV([sym(temp), xs[0]])]),
|
||||
listV([sym("if"), sym(temp), sym(temp), orOf(Array(xs[1...]))]),
|
||||
])
|
||||
}
|
||||
return orOf(parts)
|
||||
}
|
||||
|
||||
func freshTemp(_ gensym: Gensym) -> String {
|
||||
"t" + String(hygieneMark) + "d" + String(gensym.next())
|
||||
}
|
||||
|
||||
func expandQuasi(_ template: Value, _ depth: Int) -> Value {
|
||||
switch template {
|
||||
case .pair(let p):
|
||||
if case .symbol(let s) = p.car, baseName(s) == "unquote" {
|
||||
if depth == 1 {
|
||||
if case .pair(let inner) = p.cdr { return inner.car }
|
||||
return .unspecified
|
||||
}
|
||||
return listV([sym("cons"), quoteExpr(sym("unquote")), expandQuasi(p.cdr, depth - 1)])
|
||||
}
|
||||
if case .symbol(let s) = p.car, baseName(s) == "quasiquote" {
|
||||
return listV([sym("cons"), quoteExpr(sym("quasiquote")), expandQuasi(p.cdr, depth + 1)])
|
||||
}
|
||||
if case .pair(let carp) = p.car, case .symbol(let s) = carp.car, baseName(s) == "unquote-splicing", depth == 1 {
|
||||
let spliced: Value
|
||||
if case .pair(let inner) = carp.cdr { spliced = inner.car } else { spliced = .null }
|
||||
return listV([sym("append"), spliced, expandQuasi(p.cdr, depth)])
|
||||
}
|
||||
return listV([sym("cons"), expandQuasi(p.car, depth), expandQuasi(p.cdr, depth)])
|
||||
case .null:
|
||||
return quoteExpr(.null)
|
||||
case .symbol:
|
||||
return quoteExpr(template)
|
||||
default:
|
||||
return template
|
||||
}
|
||||
}
|
||||
Reference in new issue
Block a user