| @@ -0,0 +1,878 @@ |
| 1 | import Foundation |
| 2 | |
| 3 | /// A small Emacs Lisp evaluator over `Sexp` values: the special forms and functions diary |
| 4 | /// sexps and table formulas use, with dynamic binding. A function or form it doesn't have |
| 5 | /// throws `Unsupported`; errors Emacs would signal throw `Signal`. |
| 6 | public final class Elisp { |
| 7 | public struct Unsupported: Error, Equatable, CustomStringConvertible { |
| 8 | public let what: String |
| 9 | public var description: String { what } |
| 10 | } |
| 11 | |
| 12 | public struct Signal: Error, Equatable, CustomStringConvertible { |
| 13 | public let message: String |
| 14 | public var description: String { message } |
| 15 | } |
| 16 | |
| 17 | public typealias Builtin = (Elisp, [Sexp]) throws -> Sexp |
| 18 | |
| 19 | private var scopes: [[String: Sexp]] = [[:]] |
| 20 | private var functions: [String: Builtin] = [:] |
| 21 | private var steps = 0 |
| 22 | static let stepLimit = 1_000_000 |
| 23 | |
| 24 | public init() { |
| 25 | Self.core(self) |
| 26 | } |
| 27 | |
| 28 | /// Defines or replaces a function. |
| 29 | public func define(_ name: String, _ function: @escaping Builtin) { functions[name] = function } |
| 30 | |
| 31 | /// Sets a global variable. |
| 32 | public func set(_ name: String, _ value: Sexp) { scopes[0][name] = value } |
| 33 | |
| 34 | public func value(_ name: String) throws -> Sexp { |
| 35 | for scope in scopes.reversed() { if let v = scope[name] { return v } } |
| 36 | throw Signal(message: "Symbol’s value as variable is void: \(name)") |
| 37 | } |
| 38 | |
| 39 | /// Evaluates `body` with `bindings` added. |
| 40 | public func binding<T>(_ bindings: [String: Sexp], _ body: () throws -> T) rethrows -> T { |
| 41 | scopes.append(bindings) |
| 42 | defer { scopes.removeLast() } |
| 43 | return try body() |
| 44 | } |
| 45 | |
| 46 | private func assign(_ name: String, _ v: Sexp) { |
| 47 | for i in scopes.indices.reversed() where scopes[i][name] != nil { |
| 48 | scopes[i][name] = v |
| 49 | return |
| 50 | } |
| 51 | scopes[0][name] = v |
| 52 | } |
| 53 | |
| 54 | // MARK: - Values |
| 55 | |
| 56 | public static let t = Sexp.symbol("t") |
| 57 | |
| 58 | public static func isNil(_ v: Sexp) -> Bool { v == .nil || v == .list([]) } |
| 59 | public static func bool(_ b: Bool) -> Sexp { b ? t : .nil } |
| 60 | static func list(_ items: [Sexp]) -> Sexp { items.isEmpty ? .nil : .list(items) } |
| 61 | |
| 62 | static func cons(_ a: Sexp, _ b: Sexp) -> Sexp { |
| 63 | switch b { |
| 64 | case .list(let items): .list([a] + items) |
| 65 | case .dotted(let items, let last): .dotted([a] + items, last) |
| 66 | case _ where isNil(b): .list([a]) |
| 67 | default: .dotted([a], b) |
| 68 | } |
| 69 | } |
| 70 | |
| 71 | static func car(_ v: Sexp) throws -> Sexp { |
| 72 | switch v { |
| 73 | case .list(let items): items.first ?? .nil |
| 74 | case .dotted(let items, _): items[0] |
| 75 | case _ where isNil(v): .nil |
| 76 | default: throw Signal(message: "Wrong type argument: listp, \(v.description)") |
| 77 | } |
| 78 | } |
| 79 | |
| 80 | static func cdr(_ v: Sexp) throws -> Sexp { |
| 81 | switch v { |
| 82 | case .list(let items): list(Array(items.dropFirst())) |
| 83 | case .dotted(let items, let last): items.count == 1 ? last : .dotted(Array(items.dropFirst()), last) |
| 84 | case _ where isNil(v): .nil |
| 85 | default: throw Signal(message: "Wrong type argument: listp, \(v.description)") |
| 86 | } |
| 87 | } |
| 88 | |
| 89 | /// A proper list's elements. |
| 90 | static func elements(_ v: Sexp) throws -> [Sexp] { |
| 91 | if case .list(let items) = v { return items } |
| 92 | if isNil(v) { return [] } |
| 93 | throw Signal(message: "Wrong type argument: listp, \(v.description)") |
| 94 | } |
| 95 | |
| 96 | enum Number { |
| 97 | case int(Int), float(Double) |
| 98 | var double: Double { |
| 99 | switch self { |
| 100 | case .int(let i): Double(i) |
| 101 | case .float(let d): d |
| 102 | } |
| 103 | } |
| 104 | } |
| 105 | |
| 106 | static func number(_ v: Sexp) throws -> Number { |
| 107 | switch v { |
| 108 | case .integer(let i): return .int(i) |
| 109 | case .float(let d): return .float(d) |
| 110 | case .character(let c): return .int(c) |
| 111 | default: throw Signal(message: "Wrong type argument: number-or-marker-p, \(v.description)") |
| 112 | } |
| 113 | } |
| 114 | |
| 115 | static func int(_ v: Sexp) throws -> Int { |
| 116 | switch v { |
| 117 | case .integer(let i): return i |
| 118 | case .character(let c): return c |
| 119 | default: throw Signal(message: "Wrong type argument: integerp, \(v.description)") |
| 120 | } |
| 121 | } |
| 122 | |
| 123 | static func string(_ v: Sexp) throws -> String { |
| 124 | guard case .string(let s) = v else { throw Signal(message: "Wrong type argument: stringp, \(v.description)") } |
| 125 | return s |
| 126 | } |
| 127 | |
| 128 | static func sexp(_ n: Number) -> Sexp { |
| 129 | switch n { |
| 130 | case .int(let i): .integer(i) |
| 131 | case .float(let d): .float(d) |
| 132 | } |
| 133 | } |
| 134 | |
| 135 | /// `prin1-to-string` with `princ` for strings when `escape` is false. |
| 136 | public static func printed(_ v: Sexp, escape: Bool = false) -> String { |
| 137 | switch v { |
| 138 | case .string(let s): return escape ? v.description : s |
| 139 | case .float(let d): return floatText(d) |
| 140 | case .character(let c): return String(c) |
| 141 | case .list(let items): return "(" + items.map { printed($0, escape: true) }.joined(separator: " ") + ")" |
| 142 | case .dotted(let items, let last): return "(" + items.map { printed($0, escape: true) }.joined(separator: " ") + " . " + printed(last, escape: true) + ")" |
| 143 | case .vector(let items): return "[" + items.map { printed($0, escape: true) }.joined(separator: " ") + "]" |
| 144 | default: return v.description |
| 145 | } |
| 146 | } |
| 147 | |
| 148 | /// Emacs's float printing: the shortest text that reads back, with `.0` on whole numbers. |
| 149 | static func floatText(_ d: Double) -> String { |
| 150 | if d.isNaN { return d.sign == .minus ? "-0.0e+NaN" : "0.0e+NaN" } |
| 151 | if d.isInfinite { return d < 0 ? "-1.0e+INF" : "1.0e+INF" } |
| 152 | var text = "\(d)" |
| 153 | if let e = text.firstIndex(of: "e") { |
| 154 | let mantissa = text[..<e] |
| 155 | var exponent = String(text[text.index(after: e)...]) |
| 156 | if !exponent.hasPrefix("-"), !exponent.hasPrefix("+") { exponent = "+" + exponent } |
| 157 | text = mantissa.hasSuffix(".0") ? String(mantissa.dropLast(2)) + "e" + exponent : mantissa + "e" + exponent |
| 158 | } |
| 159 | return text |
| 160 | } |
| 161 | |
| 162 | // MARK: - Evaluation |
| 163 | |
| 164 | public func eval(_ form: Sexp) throws -> Sexp { |
| 165 | steps += 1 |
| 166 | if steps > Self.stepLimit { throw Signal(message: "Evaluation took too long") } |
| 167 | switch form { |
| 168 | case .symbol(let name): |
| 169 | if name == "nil" || name == "t" || name.hasPrefix(":") { return form } |
| 170 | return try value(name) |
| 171 | case .character(let c): return .integer(c) |
| 172 | case .list(let items): |
| 173 | guard let head = items.first else { return .nil } |
| 174 | guard case .symbol(let name) = head else { |
| 175 | if case .list(let lambda) = head, lambda.first == .symbol("lambda") { |
| 176 | return try call(head, try items.dropFirst().map(eval)) |
| 177 | } |
| 178 | throw Signal(message: "Invalid function: \(head.description)") |
| 179 | } |
| 180 | return try special(name, Array(items.dropFirst())) ?? callNamed(name, try items.dropFirst().map(eval)) |
| 181 | case .dotted: throw Signal(message: "Invalid function") |
| 182 | default: return form |
| 183 | } |
| 184 | } |
| 185 | |
| 186 | func progn(_ body: some Collection<Sexp>) throws -> Sexp { |
| 187 | var result = Sexp.nil |
| 188 | for form in body { result = try eval(form) } |
| 189 | return result |
| 190 | } |
| 191 | |
| 192 | /// Special forms and macros; nil when `name` is an ordinary function. |
| 193 | private func special(_ name: String, _ args: [Sexp]) throws -> Sexp? { |
| 194 | switch name { |
| 195 | case "quote": |
| 196 | return args.first ?? .nil |
| 197 | case "function": |
| 198 | return args.first ?? .nil |
| 199 | case "lambda": |
| 200 | return .list([.symbol("lambda")] + args) |
| 201 | case "progn": |
| 202 | return try progn(args) |
| 203 | case "prog1": |
| 204 | guard let first = args.first else { return .nil } |
| 205 | let value = try eval(first) |
| 206 | _ = try progn(args.dropFirst()) |
| 207 | return value |
| 208 | case "if": |
| 209 | guard args.count >= 2 else { throw Signal(message: "Wrong number of arguments: if") } |
| 210 | return Self.isNil(try eval(args[0])) ? try progn(args.dropFirst(2)) : try eval(args[1]) |
| 211 | case "when", "unless": |
| 212 | guard let test = args.first else { return .nil } |
| 213 | return Self.isNil(try eval(test)) == (name == "unless") ? try progn(args.dropFirst()) : .nil |
| 214 | case "cond": |
| 215 | for clause in args { |
| 216 | let parts = try Self.elements(clause) |
| 217 | guard let test = parts.first else { continue } |
| 218 | let value = try eval(test) |
| 219 | if !Self.isNil(value) { return parts.count == 1 ? value : try progn(parts.dropFirst()) } |
| 220 | } |
| 221 | return .nil |
| 222 | case "and": |
| 223 | var value = Self.t |
| 224 | for form in args { |
| 225 | value = try eval(form) |
| 226 | if Self.isNil(value) { return .nil } |
| 227 | } |
| 228 | return value |
| 229 | case "or": |
| 230 | for form in args { |
| 231 | let value = try eval(form) |
| 232 | if !Self.isNil(value) { return value } |
| 233 | } |
| 234 | return .nil |
| 235 | case "let", "let*": |
| 236 | guard let first = args.first else { return .nil } |
| 237 | var bindings: [String: Sexp] = [:] |
| 238 | scopes.append([:]) |
| 239 | defer { scopes.removeLast() } |
| 240 | for binding in try Self.elements(first) { |
| 241 | let (variable, value): (String, Sexp) |
| 242 | if case .symbol(let s) = binding { |
| 243 | (variable, value) = (s, .nil) |
| 244 | } else { |
| 245 | let parts = try Self.elements(binding) |
| 246 | guard case .symbol(let s)? = parts.first else { throw Signal(message: "Bad binding") } |
| 247 | (variable, value) = (s, parts.count > 1 ? try eval(parts[1]) : .nil) |
| 248 | } |
| 249 | if name == "let*" { scopes[scopes.count - 1][variable] = value } else { bindings[variable] = value } |
| 250 | } |
| 251 | if name == "let" { scopes[scopes.count - 1] = bindings } |
| 252 | return try progn(args.dropFirst()) |
| 253 | case "setq": |
| 254 | var value = Sexp.nil |
| 255 | var i = 0 |
| 256 | while i + 1 < args.count { |
| 257 | guard case .symbol(let variable) = args[i] else { throw Signal(message: "Bad setq") } |
| 258 | value = try eval(args[i + 1]) |
| 259 | assign(variable, value) |
| 260 | i += 2 |
| 261 | } |
| 262 | return value |
| 263 | case "push", "pop": |
| 264 | guard case .symbol(let variable)? = (name == "push" ? args.dropFirst().first : args.first) else { throw Unsupported(what: "\(name) on a place") } |
| 265 | let list = try value(variable) |
| 266 | if name == "pop" { |
| 267 | assign(variable, try Self.cdr(list)) |
| 268 | return try Self.car(list) |
| 269 | } |
| 270 | let pushed = Self.cons(try eval(args[0]), list) |
| 271 | assign(variable, pushed) |
| 272 | return pushed |
| 273 | case "while": |
| 274 | guard let test = args.first else { return .nil } |
| 275 | while !Self.isNil(try eval(test)) { _ = try progn(args.dropFirst()) } |
| 276 | return .nil |
| 277 | case "dolist", "dotimes": |
| 278 | let spec = try args.first.map(Self.elements) ?? [] |
| 279 | guard case .symbol(let variable)? = spec.first, spec.count >= 2 else { throw Signal(message: "Bad \(name)") } |
| 280 | let source = try eval(spec[1]) |
| 281 | let items = name == "dolist" ? try Self.elements(source) : (0..<max(0, try Self.int(source))).map { Sexp.integer($0) } |
| 282 | scopes.append([:]) |
| 283 | defer { scopes.removeLast() } |
| 284 | for item in items { |
| 285 | scopes[scopes.count - 1][variable] = item |
| 286 | _ = try progn(args.dropFirst()) |
| 287 | } |
| 288 | if spec.count > 2 { |
| 289 | scopes[scopes.count - 1][variable] = name == "dotimes" ? .integer(items.count) : .nil |
| 290 | return try eval(spec[2]) |
| 291 | } |
| 292 | return .nil |
| 293 | case "ignore-errors": |
| 294 | do { return try progn(args) } catch is Signal { return .nil } |
| 295 | case "condition-case": |
| 296 | guard args.count >= 2 else { throw Signal(message: "Bad condition-case") } |
| 297 | do { |
| 298 | return try eval(args[1]) |
| 299 | } catch let signal as Signal { |
| 300 | for handler in args.dropFirst(2) { |
| 301 | let parts = try Self.elements(handler) |
| 302 | guard let condition = parts.first else { continue } |
| 303 | let names = (try? Self.elements(condition)) ?? [condition] |
| 304 | guard names.contains(.symbol("error")) || names.contains(.symbol("t")) else { continue } |
| 305 | let bindings: [String: Sexp] = args[0].symbol.map { $0 == "nil" ? [:] : [$0: .list([.symbol("error"), .string(signal.message)])] } ?? [:] |
| 306 | return try binding(bindings) { try progn(parts.dropFirst()) } |
| 307 | } |
| 308 | throw signal |
| 309 | } |
| 310 | default: |
| 311 | return nil |
| 312 | } |
| 313 | } |
| 314 | |
| 315 | /// Calls a function value: a symbol naming one, or a lambda list. |
| 316 | public func call(_ function: Sexp, _ args: [Sexp]) throws -> Sexp { |
| 317 | switch function { |
| 318 | case .symbol(let name): return try callNamed(name, args) |
| 319 | case .list(let items) where items.first == .symbol("lambda") && items.count >= 2: |
| 320 | var bindings: [String: Sexp] = [:] |
| 321 | var mode = "required" |
| 322 | var i = 0 |
| 323 | for parameter in try Self.elements(items[1]) { |
| 324 | guard case .symbol(let p) = parameter else { throw Signal(message: "Bad lambda list") } |
| 325 | if p == "&optional" || p == "&rest" { |
| 326 | mode = p |
| 327 | continue |
| 328 | } |
| 329 | if mode == "&rest" { |
| 330 | bindings[p] = Self.list(Array(args.dropFirst(i))) |
| 331 | i = args.count |
| 332 | } else if i < args.count { |
| 333 | bindings[p] = args[i] |
| 334 | i += 1 |
| 335 | } else if mode == "&optional" { |
| 336 | bindings[p] = .nil |
| 337 | } else { |
| 338 | throw Signal(message: "Wrong number of arguments") |
| 339 | } |
| 340 | } |
| 341 | if i < args.count { throw Signal(message: "Wrong number of arguments") } |
| 342 | return try binding(bindings) { try progn(items.dropFirst(2)) } |
| 343 | default: |
| 344 | throw Signal(message: "Invalid function: \(function.description)") |
| 345 | } |
| 346 | } |
| 347 | |
| 348 | func callNamed(_ name: String, _ args: [Sexp]) throws -> Sexp { |
| 349 | guard let function = functions[name] else { throw Unsupported(what: "function \(name)") } |
| 350 | return try function(self, args) |
| 351 | } |
| 352 | |
| 353 | static func arity(_ args: [Sexp], _ range: ClosedRange<Int>, _ name: String) throws { |
| 354 | guard range.contains(args.count) else { throw Signal(message: "Wrong number of arguments: \(name), \(args.count)") } |
| 355 | } |
| 356 | |
| 357 | // MARK: - Functions |
| 358 | |
| 359 | private static func core(_ lisp: Elisp) { |
| 360 | func arithmetic(_ name: String, identity: Int, _ intOp: @escaping (Int, Int) -> (Int, Bool), _ floatOp: @escaping (Double, Double) -> Double) { |
| 361 | lisp.define(name) { _, args in |
| 362 | let numbers = try args.map(number) |
| 363 | guard var result = numbers.first else { return .integer(identity) } |
| 364 | if numbers.count == 1, name == "-" { |
| 365 | switch result { |
| 366 | case .int(let i): return .integer(-i) |
| 367 | case .float(let d): return .float(-d) |
| 368 | } |
| 369 | } |
| 370 | for n in numbers.dropFirst() { |
| 371 | switch (result, n) { |
| 372 | case (.int(let a), .int(let b)): |
| 373 | let (value, overflow) = intOp(a, b) |
| 374 | if overflow { throw Unsupported(what: "integer size") } |
| 375 | result = .int(value) |
| 376 | default: |
| 377 | result = .float(floatOp(result.double, n.double)) |
| 378 | } |
| 379 | } |
| 380 | return sexp(result) |
| 381 | } |
| 382 | } |
| 383 | arithmetic("+", identity: 0, { $0.addingReportingOverflow($1) }, +) |
| 384 | arithmetic("-", identity: 0, { $0.subtractingReportingOverflow($1) }, -) |
| 385 | arithmetic("*", identity: 1, { $0.multipliedReportingOverflow(by: $1) }, *) |
| 386 | lisp.define("/") { _, args in |
| 387 | try arity(args, 1...Int.max, "/") |
| 388 | let numbers = try args.map(number) |
| 389 | let floating = numbers.contains { if case .float = $0 { true } else { false } } |
| 390 | if numbers.count == 1 { return try sexp(divide(.int(1), numbers[0], floating: floating)) } |
| 391 | var result = numbers[0] |
| 392 | for n in numbers.dropFirst() { result = try divide(result, n, floating: floating) } |
| 393 | return sexp(result) |
| 394 | } |
| 395 | lisp.define("%") { _, args in |
| 396 | try arity(args, 2...2, "%") |
| 397 | let b = try int(args[1]) |
| 398 | guard b != 0 else { throw Signal(message: "Arithmetic error") } |
| 399 | return .integer(try int(args[0]) % b) |
| 400 | } |
| 401 | lisp.define("mod") { _, args in |
| 402 | try arity(args, 2...2, "mod") |
| 403 | switch (try number(args[0]), try number(args[1])) { |
| 404 | case (.int(let a), .int(let b)): |
| 405 | guard b != 0 else { throw Signal(message: "Arithmetic error") } |
| 406 | let r = a % b |
| 407 | return .integer(r != 0 && (r < 0) != (b < 0) ? r + b : r) |
| 408 | case (let a, let b): |
| 409 | let r = fmod(a.double, b.double) |
| 410 | return .float(r != 0 && (r < 0) != (b.double < 0) ? r + b.double : r) |
| 411 | } |
| 412 | } |
| 413 | lisp.define("1+") { _, args in try arity(args, 1...1, "1+"); return try sexp(add(number(args[0]), 1)) } |
| 414 | lisp.define("1-") { _, args in try arity(args, 1...1, "1-"); return try sexp(add(number(args[0]), -1)) } |
| 415 | lisp.define("abs") { _, args in |
| 416 | try arity(args, 1...1, "abs") |
| 417 | switch try number(args[0]) { |
| 418 | case .int(let i): return .integer(abs(i)) |
| 419 | case .float(let d): return .float(abs(d)) |
| 420 | } |
| 421 | } |
| 422 | for name in ["max", "min"] { |
| 423 | lisp.define(name) { _, args in |
| 424 | try arity(args, 1...Int.max, name) |
| 425 | let numbers = try args.map(number) |
| 426 | let floating = numbers.contains { if case .float = $0 { true } else { false } } |
| 427 | var best = numbers[0] |
| 428 | for n in numbers.dropFirst() where name == "max" ? n.double > best.double : n.double < best.double { best = n } |
| 429 | return floating ? .float(best.double) : sexp(best) |
| 430 | } |
| 431 | } |
| 432 | for name in ["floor", "ceiling", "round", "truncate"] { |
| 433 | lisp.define(name) { _, args in |
| 434 | try arity(args, 1...2, name) |
| 435 | var x = try number(args[0]).double |
| 436 | if args.count == 2, !isNil(args[1]) { |
| 437 | let divisor = try number(args[1]).double |
| 438 | guard divisor != 0 else { throw Signal(message: "Arithmetic error") } |
| 439 | x /= divisor |
| 440 | } else if case .int(let i) = try number(args[0]) { |
| 441 | return .integer(i) |
| 442 | } |
| 443 | let rule: FloatingPointRoundingRule = switch name { |
| 444 | case "floor": .down |
| 445 | case "ceiling": .up |
| 446 | case "round": .toNearestOrEven |
| 447 | default: .towardZero |
| 448 | } |
| 449 | guard let i = Int(exactly: x.rounded(rule)) else { throw Signal(message: "Arithmetic overflow error") } |
| 450 | return .integer(i) |
| 451 | } |
| 452 | } |
| 453 | lisp.define("float") { _, args in try arity(args, 1...1, "float"); return .float(try number(args[0]).double) } |
| 454 | for (name, op) in [("=", { (a: Double, b: Double) in a == b }), ("<", { $0 < $1 }), (">", { $0 > $1 }), ("<=", { $0 <= $1 }), (">=", { $0 >= $1 })] { |
| 455 | lisp.define(name) { _, args in |
| 456 | try arity(args, 1...Int.max, name) |
| 457 | let numbers = try args.map(number) |
| 458 | for (a, b) in zip(numbers, numbers.dropFirst()) { |
| 459 | let holds: Bool = switch (a, b) { |
| 460 | case (.int(let x), .int(let y)): op(Double(x), Double(y)) && (name != "=" || x == y) |
| 461 | default: op(a.double, b.double) |
| 462 | } |
| 463 | if !holds { return .nil } |
| 464 | } |
| 465 | return t |
| 466 | } |
| 467 | } |
| 468 | lisp.define("/=") { _, args in |
| 469 | try arity(args, 2...2, "/=") |
| 470 | return bool(try number(args[0]).double != (try number(args[1])).double) |
| 471 | } |
| 472 | lisp.define("zerop") { _, args in try arity(args, 1...1, "zerop"); return bool(try number(args[0]).double == 0) } |
| 473 | lisp.define("not") { _, args in try arity(args, 1...1, "not"); return bool(isNil(args[0])) } |
| 474 | lisp.define("null") { _, args in try arity(args, 1...1, "null"); return bool(isNil(args[0])) } |
| 475 | lisp.define("eq") { _, args in try arity(args, 2...2, "eq"); return bool(eq(args[0], args[1])) } |
| 476 | lisp.define("eql") { _, args in try arity(args, 2...2, "eql"); return bool(eq(args[0], args[1])) } |
| 477 | lisp.define("equal") { _, args in try arity(args, 2...2, "equal"); return bool(normalized(args[0]) == normalized(args[1])) } |
| 478 | lisp.define("numberp") { _, args in |
| 479 | try arity(args, 1...1, "numberp") |
| 480 | return bool((try? number(args[0])) != nil && args[0].character == nil) |
| 481 | } |
| 482 | lisp.define("integerp") { _, args in try arity(args, 1...1, "integerp"); return bool(args[0].integer != nil) } |
| 483 | lisp.define("floatp") { _, args in |
| 484 | try arity(args, 1...1, "floatp") |
| 485 | if case .float = args[0] { return t } |
| 486 | return .nil |
| 487 | } |
| 488 | lisp.define("stringp") { _, args in try arity(args, 1...1, "stringp"); return bool(args[0].string != nil) } |
| 489 | lisp.define("listp") { _, args in |
| 490 | try arity(args, 1...1, "listp") |
| 491 | switch args[0] { |
| 492 | case .list, .dotted: return t |
| 493 | default: return bool(isNil(args[0])) |
| 494 | } |
| 495 | } |
| 496 | lisp.define("consp") { _, args in |
| 497 | try arity(args, 1...1, "consp") |
| 498 | switch args[0] { |
| 499 | case .list(let items): return bool(!items.isEmpty) |
| 500 | case .dotted: return t |
| 501 | default: return .nil |
| 502 | } |
| 503 | } |
| 504 | lisp.define("symbolp") { _, args in try arity(args, 1...1, "symbolp"); return bool(args[0].symbol != nil || isNil(args[0])) } |
| 505 | |
| 506 | // Lists. |
| 507 | lisp.define("car") { _, args in try arity(args, 1...1, "car"); return try car(args[0]) } |
| 508 | lisp.define("cdr") { _, args in try arity(args, 1...1, "cdr"); return try cdr(args[0]) } |
| 509 | lisp.define("cadr") { _, args in try arity(args, 1...1, "cadr"); return try car(cdr(args[0])) } |
| 510 | lisp.define("cddr") { _, args in try arity(args, 1...1, "cddr"); return try cdr(cdr(args[0])) } |
| 511 | lisp.define("cons") { _, args in try arity(args, 2...2, "cons"); return cons(args[0], args[1]) } |
| 512 | lisp.define("list") { _, args in list(args) } |
| 513 | lisp.define("nth") { _, args in |
| 514 | try arity(args, 2...2, "nth") |
| 515 | var v = args[1] |
| 516 | for _ in 0..<max(0, try int(args[0])) { v = try cdr(v) } |
| 517 | return try car(v) |
| 518 | } |
| 519 | lisp.define("nthcdr") { _, args in |
| 520 | try arity(args, 2...2, "nthcdr") |
| 521 | var v = args[1] |
| 522 | for _ in 0..<max(0, try int(args[0])) { v = try cdr(v) } |
| 523 | return v |
| 524 | } |
| 525 | lisp.define("elt") { _, args in |
| 526 | try arity(args, 2...2, "elt") |
| 527 | let items = try sequence(args[0]) |
| 528 | let i = try int(args[1]) |
| 529 | if case .list = args[0], i >= items.count { return .nil } |
| 530 | guard items.indices.contains(i) else { throw Signal(message: "Args out of range") } |
| 531 | return items[i] |
| 532 | } |
| 533 | lisp.define("aref") { _, args in |
| 534 | try arity(args, 2...2, "aref") |
| 535 | let items = try sequence(args[0]) |
| 536 | let i = try int(args[1]) |
| 537 | guard items.indices.contains(i) else { throw Signal(message: "Args out of range") } |
| 538 | return items[i] |
| 539 | } |
| 540 | lisp.define("append") { _, args in |
| 541 | guard let last = args.last else { return .nil } |
| 542 | var items: [Sexp] = [] |
| 543 | for arg in args.dropLast() { items += try sequence(arg) } |
| 544 | return try items.reversed().reduce(last) { cons($1, $0) } |
| 545 | } |
| 546 | lisp.define("length") { _, args in |
| 547 | try arity(args, 1...1, "length") |
| 548 | return .integer(try sequence(args[0]).count) |
| 549 | } |
| 550 | lisp.define("reverse") { _, args in |
| 551 | try arity(args, 1...1, "reverse") |
| 552 | if case .string(let s) = args[0] { return .string(String(s.reversed())) } |
| 553 | return list(try elements(args[0]).reversed()) |
| 554 | } |
| 555 | lisp.define("number-sequence") { _, args in |
| 556 | try arity(args, 1...3, "number-sequence") |
| 557 | let from = try int(args[0]) |
| 558 | guard args.count > 1, !isNil(args[1]) else { return .list([.integer(from)]) } |
| 559 | let to = try int(args[1]) |
| 560 | let step = args.count > 2 && !isNil(args[2]) ? try int(args[2]) : 1 |
| 561 | guard step != 0 else { throw Signal(message: "The increment can not be zero") } |
| 562 | return list(Array(stride(from: from, through: to, by: step)).map { .integer($0) }) |
| 563 | } |
| 564 | for name in ["memq", "member", "memql"] { |
| 565 | lisp.define(name) { _, args in |
| 566 | try arity(args, 2...2, name) |
| 567 | var rest = args[1] |
| 568 | while case .list(let items) = rest, let first = items.first { |
| 569 | if name == "member" ? normalized(first) == normalized(args[0]) : eq(first, args[0]) { return rest } |
| 570 | rest = list(Array(items.dropFirst())) |
| 571 | } |
| 572 | return .nil |
| 573 | } |
| 574 | } |
| 575 | for name in ["assoc", "assq"] { |
| 576 | lisp.define(name) { _, args in |
| 577 | try arity(args, 2...3, name) |
| 578 | for pair in try elements(args[1]) { |
| 579 | guard let key = try? car(pair) else { continue } |
| 580 | if name == "assoc" ? normalized(key) == normalized(args[0]) : eq(key, args[0]) { return pair } |
| 581 | } |
| 582 | return .nil |
| 583 | } |
| 584 | } |
| 585 | lisp.define("identity") { _, args in try arity(args, 1...1, "identity"); return args[0] } |
| 586 | lisp.define("ignore") { _, _ in .nil } |
| 587 | lisp.define("funcall") { lisp, args in |
| 588 | try arity(args, 1...Int.max, "funcall") |
| 589 | return try lisp.call(args[0], Array(args.dropFirst())) |
| 590 | } |
| 591 | lisp.define("apply") { lisp, args in |
| 592 | try arity(args, 1...Int.max, "apply") |
| 593 | let spread = args.count > 1 ? Array(args[1..<(args.count - 1)]) + (try elements(args[args.count - 1])) : [] |
| 594 | return try lisp.call(args[0], spread) |
| 595 | } |
| 596 | lisp.define("mapcar") { lisp, args in |
| 597 | try arity(args, 2...2, "mapcar") |
| 598 | return list(try sequence(args[1]).map { try lisp.call(args[0], [$0]) }) |
| 599 | } |
| 600 | lisp.define("mapc") { lisp, args in |
| 601 | try arity(args, 2...2, "mapc") |
| 602 | for item in try sequence(args[1]) { _ = try lisp.call(args[0], [item]) } |
| 603 | return args[1] |
| 604 | } |
| 605 | lisp.define("mapconcat") { lisp, args in |
| 606 | try arity(args, 1...3, "mapconcat") |
| 607 | let separator = args.count > 2 ? try string(args[2]) : "" |
| 608 | return .string(try sequence(args[1]).map { try printedString(lisp.call(args[0], [$0])) }.joined(separator: separator)) |
| 609 | } |
| 610 | lisp.define("delq") { _, args in |
| 611 | try arity(args, 2...2, "delq") |
| 612 | return list(try elements(args[1]).filter { !eq($0, args[0]) }) |
| 613 | } |
| 614 | lisp.define("delete") { _, args in |
| 615 | try arity(args, 2...2, "delete") |
| 616 | return list(try elements(args[1]).filter { normalized($0) != normalized(args[0]) }) |
| 617 | } |
| 618 | lisp.define("error") { _, args in |
| 619 | let message = args.isEmpty ? "" : try format(args) |
| 620 | throw Signal(message: message) |
| 621 | } |
| 622 | lisp.define("user-error") { _, args in |
| 623 | throw Signal(message: args.isEmpty ? "" : try format(args)) |
| 624 | } |
| 625 | |
| 626 | // Strings. |
| 627 | lisp.define("concat") { _, args in .string(try args.map(printedString).joined()) } |
| 628 | lisp.define("format") { _, args in .string(try format(args)) } |
| 629 | lisp.define("format-message") { _, args in .string(try format(args)) } |
| 630 | lisp.define("string=") { _, args in |
| 631 | try arity(args, 2...2, "string=") |
| 632 | return bool(try stringOrSymbol(args[0]) == (try stringOrSymbol(args[1]))) |
| 633 | } |
| 634 | lisp.define("string-equal") { _, args in |
| 635 | try arity(args, 2...2, "string-equal") |
| 636 | return bool(try stringOrSymbol(args[0]) == (try stringOrSymbol(args[1]))) |
| 637 | } |
| 638 | lisp.define("string<") { _, args in |
| 639 | try arity(args, 2...2, "string<") |
| 640 | return bool(Array(try stringOrSymbol(args[0]).unicodeScalars.map(\.value)).lexicographicallyPrecedes(try stringOrSymbol(args[1]).unicodeScalars.map(\.value))) |
| 641 | } |
| 642 | lisp.define("string-lessp") { lisp, args in try lisp.callNamed("string<", args) } |
| 643 | lisp.define("upcase") { _, args in |
| 644 | try arity(args, 1...1, "upcase") |
| 645 | if case .integer(let c) = args[0] { return .integer(Int(Unicode.Scalar(c).map { String($0).uppercased().unicodeScalars.first!.value } ?? UInt32(c))) } |
| 646 | return .string(try string(args[0]).uppercased()) |
| 647 | } |
| 648 | lisp.define("downcase") { _, args in |
| 649 | try arity(args, 1...1, "downcase") |
| 650 | if case .integer(let c) = args[0] { return .integer(Int(Unicode.Scalar(c).map { String($0).lowercased().unicodeScalars.first!.value } ?? UInt32(c))) } |
| 651 | return .string(try string(args[0]).lowercased()) |
| 652 | } |
| 653 | lisp.define("capitalize") { _, args in |
| 654 | try arity(args, 1...1, "capitalize") |
| 655 | return .string(try string(args[0]).capitalized) |
| 656 | } |
| 657 | lisp.define("substring") { _, args in |
| 658 | try arity(args, 1...3, "substring") |
| 659 | let chars = Array(try string(args[0])) |
| 660 | func index(_ v: Sexp?, _ fallback: Int) throws -> Int { |
| 661 | guard let v, !isNil(v) else { return fallback } |
| 662 | let i = try int(v) |
| 663 | return i < 0 ? chars.count + i : i |
| 664 | } |
| 665 | let from = try index(args.count > 1 ? args[1] : nil, 0) |
| 666 | let to = try index(args.count > 2 ? args[2] : nil, chars.count) |
| 667 | guard from >= 0, to <= chars.count, from <= to else { throw Signal(message: "Args out of range") } |
| 668 | return .string(String(chars[from..<to])) |
| 669 | } |
| 670 | lisp.define("string-to-number") { _, args in |
| 671 | try arity(args, 1...2, "string-to-number") |
| 672 | return stringToNumber(try string(args[0])) |
| 673 | } |
| 674 | for name in ["number-to-string", "int-to-string"] { |
| 675 | lisp.define(name) { _, args in |
| 676 | try arity(args, 1...1, name) |
| 677 | return .string(printed(sexp(try number(args[0])))) |
| 678 | } |
| 679 | } |
| 680 | lisp.define("string-prefix-p") { _, args in |
| 681 | try arity(args, 2...3, "string-prefix-p") |
| 682 | return bool(try string(args[1]).hasPrefix(try string(args[0]))) |
| 683 | } |
| 684 | lisp.define("string-suffix-p") { _, args in |
| 685 | try arity(args, 2...3, "string-suffix-p") |
| 686 | return bool(try string(args[1]).hasSuffix(try string(args[0]))) |
| 687 | } |
| 688 | lisp.define("string-empty-p") { _, args in |
| 689 | try arity(args, 1...1, "string-empty-p") |
| 690 | return bool(try stringOrSymbol(args[0]).isEmpty) |
| 691 | } |
| 692 | lisp.define("string-trim") { _, args in |
| 693 | try arity(args, 1...1, "string-trim") |
| 694 | return .string(try string(args[0]).trimmingCharacters(in: .whitespacesAndNewlines)) |
| 695 | } |
| 696 | lisp.define("split-string") { _, args in |
| 697 | try arity(args, 1...2, "split-string") |
| 698 | let s = try string(args[0]) |
| 699 | if args.count == 2, !isNil(args[1]) { |
| 700 | let separator = try string(args[1]) |
| 701 | let regex = try NSRegularExpression(pattern: separator) |
| 702 | let ns = s as NSString |
| 703 | var parts: [Sexp] = [] |
| 704 | var start = 0 |
| 705 | for m in regex.matches(in: s, range: NSRange(location: 0, length: ns.length)) where m.range.length > 0 { |
| 706 | parts.append(.string(ns.substring(with: NSRange(location: start, length: m.range.location - start)))) |
| 707 | start = NSMaxRange(m.range) |
| 708 | } |
| 709 | parts.append(.string(ns.substring(from: start))) |
| 710 | return list(parts) |
| 711 | } |
| 712 | return list(s.split(whereSeparator: { " \t\n\r\u{0C}\u{0B}".contains($0) }).map { .string(String($0)) }) |
| 713 | } |
| 714 | } |
| 715 | |
| 716 | static func add(_ n: Number, _ k: Int) -> Number { |
| 717 | switch n { |
| 718 | case .int(let i): .int(i + k) |
| 719 | case .float(let d): .float(d + Double(k)) |
| 720 | } |
| 721 | } |
| 722 | |
| 723 | static func divide(_ a: Number, _ b: Number, floating: Bool) throws -> Number { |
| 724 | if !floating, case .int(let x) = a, case .int(let y) = b { |
| 725 | guard y != 0 else { throw Signal(message: "Arithmetic error") } |
| 726 | return .int(x / y) |
| 727 | } |
| 728 | return .float(a.double / b.double) |
| 729 | } |
| 730 | |
| 731 | static func eq(_ a: Sexp, _ b: Sexp) -> Bool { |
| 732 | switch (normalized(a), normalized(b)) { |
| 733 | case (.symbol(let x), .symbol(let y)): x == y |
| 734 | case (.integer(let x), .integer(let y)): x == y |
| 735 | case (.float(let x), .float(let y)): x == y |
| 736 | default: false |
| 737 | } |
| 738 | } |
| 739 | |
| 740 | /// Characters as integers and the empty list as nil, for comparing. |
| 741 | static func normalized(_ v: Sexp) -> Sexp { |
| 742 | switch v { |
| 743 | case .character(let c): .integer(c) |
| 744 | case .list(let items): items.isEmpty ? .nil : .list(items.map(normalized)) |
| 745 | case .dotted(let items, let last): .dotted(items.map(normalized), normalized(last)) |
| 746 | case .vector(let items): .vector(items.map(normalized)) |
| 747 | default: v |
| 748 | } |
| 749 | } |
| 750 | |
| 751 | static func sequence(_ v: Sexp) throws -> [Sexp] { |
| 752 | switch v { |
| 753 | case .string(let s): return s.unicodeScalars.map { .integer(Int($0.value)) } |
| 754 | case .vector(let items): return items |
| 755 | default: return try elements(v) |
| 756 | } |
| 757 | } |
| 758 | |
| 759 | static func stringOrSymbol(_ v: Sexp) throws -> String { |
| 760 | if case .symbol(let s) = v { return s } |
| 761 | return try string(v) |
| 762 | } |
| 763 | |
| 764 | /// What `concat` and `mapconcat` accept: strings, and lists or vectors of characters. |
| 765 | static func printedString(_ v: Sexp) throws -> String { |
| 766 | switch v { |
| 767 | case .string(let s): return s |
| 768 | case _ where isNil(v): return "" |
| 769 | case .list, .vector: |
| 770 | return String(String.UnicodeScalarView(try sequence(v).map { Unicode.Scalar(UInt32(try int($0))) ?? " " })) |
| 771 | default: throw Signal(message: "Wrong type argument: sequencep, \(v.description)") |
| 772 | } |
| 773 | } |
| 774 | |
| 775 | /// `string-to-number` in base 10. |
| 776 | static func stringToNumber(_ s: String) -> Sexp { |
| 777 | let trimmed = s.drop { $0 == " " || $0 == "\t" || $0 == "\n" } |
| 778 | guard let r = trimmed.range(of: "^[-+]?([0-9]+\\.?[0-9]*|\\.[0-9]+)([eE][-+]?[0-9]+)?", options: .regularExpression) else { return .integer(0) } |
| 779 | let text = String(trimmed[r]) |
| 780 | if text.range(of: "^[-+]?[0-9]+$", options: .regularExpression) != nil, let i = Int(text.hasPrefix("+") ? String(text.dropFirst()) : text) { |
| 781 | return .integer(i) |
| 782 | } |
| 783 | if text.range(of: "^[-+]?[0-9]+\\.$", options: .regularExpression) != nil, let i = Int(text.dropLast().replacingOccurrences(of: "+", with: "")) { |
| 784 | return .integer(i) |
| 785 | } |
| 786 | return .float(Double(text) ?? 0) |
| 787 | } |
| 788 | |
| 789 | /// `format`. |
| 790 | static func format(_ args: [Sexp]) throws -> String { |
| 791 | let spec = Array(try string(args[0])) |
| 792 | var out = "" |
| 793 | var next = 1 |
| 794 | var i = 0 |
| 795 | func argument() throws -> Sexp { |
| 796 | guard next < args.count else { throw Signal(message: "Not enough arguments for format string") } |
| 797 | defer { next += 1 } |
| 798 | return args[next] |
| 799 | } |
| 800 | while i < spec.count { |
| 801 | let c = spec[i] |
| 802 | i += 1 |
| 803 | guard c == "%" else { |
| 804 | out.append(c) |
| 805 | continue |
| 806 | } |
| 807 | var flags = "" |
| 808 | while i < spec.count, "-+ #0".contains(spec[i]) { |
| 809 | flags.append(spec[i]) |
| 810 | i += 1 |
| 811 | } |
| 812 | var width = "" |
| 813 | while i < spec.count, spec[i].isNumber { |
| 814 | width.append(spec[i]) |
| 815 | i += 1 |
| 816 | } |
| 817 | var precision: Int? |
| 818 | if i < spec.count, spec[i] == "." { |
| 819 | i += 1 |
| 820 | var digits = "" |
| 821 | while i < spec.count, spec[i].isNumber { |
| 822 | digits.append(spec[i]) |
| 823 | i += 1 |
| 824 | } |
| 825 | precision = Int(digits) ?? 0 |
| 826 | } |
| 827 | guard i < spec.count else { throw Signal(message: "Format string ends in middle of format specifier") } |
| 828 | let conversion = spec[i] |
| 829 | i += 1 |
| 830 | var text: String |
| 831 | switch conversion { |
| 832 | case "%": |
| 833 | out.append("%") |
| 834 | continue |
| 835 | case "s", "S": |
| 836 | text = printed(try argument(), escape: conversion == "S") |
| 837 | if let precision { text = String(text.prefix(precision)) } |
| 838 | case "d", "o", "x", "X": |
| 839 | let value: Int |
| 840 | switch try number(try argument()) { |
| 841 | case .int(let n): value = n |
| 842 | case .float(let d): |
| 843 | guard let n = Int(exactly: d.rounded(.towardZero)) else { throw Signal(message: "Arithmetic overflow") } |
| 844 | value = n |
| 845 | } |
| 846 | text = String(format: "%" + flags + width + (precision.map { ".\($0)" } ?? "") + (conversion == "d" ? "ld" : "l" + String(conversion)), value) |
| 847 | out += text |
| 848 | continue |
| 849 | case "c": |
| 850 | text = Unicode.Scalar(UInt32(try int(try argument()))).map { String($0) } ?? "" |
| 851 | case "e", "f", "g": |
| 852 | let value = try number(try argument()).double |
| 853 | out += String(format: "%" + flags + width + (precision.map { ".\($0)" } ?? "") + String(conversion), value) |
| 854 | continue |
| 855 | default: |
| 856 | throw Signal(message: "Invalid format operation %\(conversion)") |
| 857 | } |
| 858 | let pad = max(0, (Int(width) ?? 0) - text.count) |
| 859 | out += flags.contains("-") ? text + String(repeating: " ", count: pad) : String(repeating: " ", count: pad) + text |
| 860 | } |
| 861 | return out |
| 862 | } |
| 863 | } |
| 864 | |
| 865 | extension Sexp { |
| 866 | var character: Int? { if case .character(let c) = self { return c } else { return nil } } |
| 867 | } |
| 868 | |
| 869 | extension LispReader { |
| 870 | /// The first form in `text` and the number of characters it spans, as `forward-sexp` |
| 871 | /// would read it. |
| 872 | public static func readFirst(_ text: String) throws -> (sexp: Sexp, length: Int) { |
| 873 | var reader = Reader(Array(text.unicodeScalars)) |
| 874 | let sexp = try reader.form() |
| 875 | let consumed = String(String.UnicodeScalarView(reader.chars[..<reader.index])) |
| 876 | return (sexp, consumed.count) |
| 877 | } |
| 878 | } |