Skip to content

Commit 4aad1b3

Browse files
objecthubobjecthub
committed
Turn current-input-port, current-output-port, and current-error-port into parameter objects as required by R7RS.
1 parent fca680f commit 4aad1b3

File tree

6 files changed

+100
-114
lines changed

6 files changed

+100
-114
lines changed

‎README.md‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -60,9 +60,7 @@ _LispKit_ is incompatible or incomplete with respect to the following R7RS featu
6060

6161
- Lists are immutable. Mutable cons-cells are supported in a way similar to
6262
[Racket](https://racket-lang.org)
63-
- `current-input-port`, `current-output-port`, and `current-error-port` are functions
64-
(as required by R5RS) and not parameter objects (as required by R7RS)
65-
- Datum comments introduced via `#;` do not always work as expected.
63+
- Datum comments introduced via `#;` do not always work as in other Scheme dialects.
6664

6765
The following [SRFI](https://srfi.schemers.org/) libraries have been ported to _LispKit_ and are included in the
6866
framework:

‎Sources/LispKit/Compiler/EvalError.swift‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -67,6 +67,7 @@ public enum EvalError: Int, Hashable {
6767
case cannotOpenUrl
6868
case invalidUrl
6969
case cannotWriteToPort
70+
case invalidDefaultPort
7071
case illegalContinuationApplication
7172
case attemptToModifyImmutableData
7273
case unknownFieldOfRecordType
@@ -177,6 +178,8 @@ public enum EvalError: Int, Hashable {
177178
return "invalid URL: $,0"
178179
case .cannotWriteToPort:
179180
return "cannot write to port $0"
181+
case .invalidDefaultPort:
182+
return "invalid default port: $0"
180183
case .illegalContinuationApplication:
181184
return "continuation application in wrong context ($0 in $1)"
182185
case .attemptToModifyImmutableData:

‎Sources/LispKit/Primitives/PortLibrary.swift‎

Lines changed: 90 additions & 101 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,19 @@ public final class PortLibrary: NativeLibrary {
2828
/// Imported native library
2929
private var systemLibrary: SystemLibrary!
3030

31+
/// Exported parameter objects
32+
public let outputPortParam: Procedure
33+
public let inputPortParam: Procedure
34+
public let errorPortParam: Procedure
35+
36+
/// Initialize port library, in particular its parameter objects.
37+
public required init(in context: Context) throws {
38+
self.outputPortParam = Procedure(.null, .port(context.outputPort))
39+
self.inputPortParam = Procedure(.null, .port(context.inputPort))
40+
self.errorPortParam = Procedure(.null, .port(context.outputPort))
41+
try super.init(in: context)
42+
}
43+
3144
/// Name of the library.
3245
public override class var name: [String] {
3346
return ["lispkit", "port"]
@@ -38,11 +51,14 @@ public final class PortLibrary: NativeLibrary {
3851
self.`import`(from: ["lispkit", "core"], "define", "lambda", "quote")
3952
self.`import`(from: ["lispkit", "control"], "let", "let*")
4053
self.`import`(from: ["lispkit", "system"], "current-directory")
41-
self.`import`(from: ["lispkit", "dynamic"], "dynamic-wind")
54+
self.`import`(from: ["lispkit", "dynamic"], "parameterize")
4255
}
4356

4457
/// Declarations of the library.
4558
public override func declarations() {
59+
self.define("current-output-port", as: self.outputPortParam)
60+
self.define("current-input-port", as: self.inputPortParam)
61+
self.define("current-error-port", as: self.errorPortParam)
4662
self.define(Procedure("port?", isPort))
4763
self.define(Procedure("input-port?", isInputPort))
4864
self.define(Procedure("output-port?", isOutputPort))
@@ -65,9 +81,6 @@ public final class PortLibrary: NativeLibrary {
6581
self.define(Procedure("close-port", closePort))
6682
self.define(Procedure("close-input-port", closeInputPort))
6783
self.define(Procedure("close-output-port", closeOutputPort))
68-
self.define(Procedure("current-input-port", currentInputPort))
69-
self.define(Procedure("current-output-port", currentOutputPort))
70-
self.define(Procedure("current-error-port", currentErrorPort))
7184
self.define(Procedure("eof-object?", isEofObject))
7285
self.define(Procedure("eof-object", eofObject))
7386
self.define(Procedure("read", read))
@@ -93,52 +106,34 @@ public final class PortLibrary: NativeLibrary {
93106
self.define(Procedure("write-bytevector", writeBytevector))
94107
self.define(Procedure("flush-output-port", flushOutputPort))
95108
self.define("with-input-from-port", via:
96-
"(define (with-input-from-port new thunk)",
97-
" (let ((old (current-input-port)))",
98-
" (dynamic-wind (lambda () (current-input-port new))",
99-
" (lambda () (let ((res (thunk))) (close-input-port new) res))",
100-
" (lambda () (current-input-port old)))))")
109+
"(define (with-input-from-port new thunk) (parameterize ((current-input-port new)) (thunk)))")
101110
self.define("with-output-to-port", via:
102-
"(define (with-output-to-port new thunk)",
103-
" (let ((old (current-output-port)))",
104-
" (dynamic-wind (lambda () (current-output-port new))",
105-
" (lambda () (let ((res (thunk))) (close-output-port new) res))",
106-
" (lambda () (current-output-port old)))))")
111+
"(define (with-output-to-port new thunk) (parameterize ((current-output-port new)) (thunk)))")
107112
self.define("with-input-from-file", via:
108113
"(define (with-input-from-file file thunk)",
109-
" (let ((old (current-input-port))",
110-
" (new (open-input-file file)))",
111-
" (dynamic-wind (lambda () (current-input-port new))",
112-
" (lambda () (let ((res (thunk))) (close-input-port new) res))",
113-
" (lambda () (current-input-port old)))))")
114+
" (let ((new (open-input-file file)))",
115+
" (parameterize ((current-input-port new))",
116+
" (let ((res (thunk))) (close-input-port new) res))))")
114117
self.define("with-output-to-file", via:
115118
"(define (with-output-to-file file thunk)",
116-
" (let ((old (current-output-port))",
117-
" (new (open-output-file file)))",
118-
" (dynamic-wind (lambda () (current-output-port new))",
119-
" (lambda () (let ((res (thunk))) (close-output-port new) res))",
120-
" (lambda () (current-output-port old)))))")
119+
" (let ((new (open-output-file file)))",
120+
" (parameterize ((current-output-port new))",
121+
" (let ((res (thunk))) (close-output-port new) res))))")
121122
self.define("with-input-from-string", via:
122123
"(define (with-input-from-string str thunk)",
123-
" (let ((old (current-input-port))",
124-
" (new (open-input-string str)))",
125-
" (dynamic-wind (lambda () (current-input-port new))",
126-
" (lambda () (let ((res (thunk))) (close-input-port new) res))",
127-
" (lambda () (current-input-port old)))))")
124+
" (let ((new (open-input-string str)))",
125+
" (parameterize ((current-input-port new))",
126+
" (let ((res (thunk))) (close-input-port new) res))))")
128127
self.define("with-output-to-string", via:
129128
"(define (with-output-to-string thunk)",
130-
" (let ((old (current-output-port))",
131-
" (new (open-output-string)))",
132-
" (dynamic-wind (lambda () (current-output-port new))",
133-
" (lambda () (let ((res (thunk))) (close-output-port new) res))",
134-
" (lambda () (current-output-port old)))))")
129+
" (let ((new (open-output-string)))",
130+
" (parameterize ((current-output-port new))",
131+
" (let ((res (thunk))) (close-output-port new) res))))")
135132
self.define("with-input-from-url", via:
136133
"(define (with-input-from-url url thunk)",
137-
" (let ((old (current-input-port))",
138-
" (new (open-input-url url)))",
139-
" (dynamic-wind (lambda () (current-input-port new))",
140-
" (lambda () (let ((res (thunk))) (close-input-port new) res))",
141-
" (lambda () (current-input-port old)))))")
134+
" (let ((new (open-input-url url)))",
135+
" (parameterize ((current-input-port new))",
136+
" (let ((res (thunk))) (close-input-port new) res))))")
142137
self.define("call-with-port", via:
143138
"(define (call-with-port port proc) (let ((res (proc port))) (close-port port) res))")
144139
self.define("call-with-input-file", via:
@@ -165,33 +160,63 @@ public final class PortLibrary: NativeLibrary {
165160
self.systemLibrary = self.nativeLibrary(SystemLibrary.self)
166161
}
167162

163+
public var outputPort: Port? {
164+
guard case .some(.port(let port)) = self.context.machine.getParam(self.outputPortParam) else {
165+
return nil
166+
}
167+
return port
168+
}
169+
170+
public var inputPort: Port? {
171+
guard case .some(.port(let port)) = self.context.machine.getParam(self.inputPortParam) else {
172+
return nil
173+
}
174+
return port
175+
}
176+
177+
public var errorPort: Port? {
178+
guard case .some(.port(let port)) = self.context.machine.getParam(self.inputPortParam) else {
179+
return nil
180+
}
181+
return port
182+
}
183+
184+
public func defaultPort(_ param: Procedure) throws -> Port {
185+
guard let value = self.context.machine.getParam(param) else {
186+
throw RuntimeError.eval(.invalidDefaultPort, .false)
187+
}
188+
guard case .port(let port) = value else {
189+
throw RuntimeError.eval(.invalidDefaultPort, value)
190+
}
191+
return port
192+
}
168193

169194
func textInputFrom(_ expr: Expr?) throws -> TextInput {
170-
let port = try expr?.asPort() ?? self.context.inputPort!
195+
let port = try expr?.asPort() ?? self.defaultPort(self.inputPortParam)
171196
guard case .textInputPort(let input) = port.kind else {
172197
throw RuntimeError.type(.port(port), expected: [.textInputPortType])
173198
}
174199
return input
175200
}
176201

177202
func binaryInputFrom(_ expr: Expr?) throws -> BinaryInput {
178-
let port = try expr?.asPort() ?? self.context.inputPort!
203+
let port = try expr?.asPort() ?? self.defaultPort(self.inputPortParam)
179204
guard case .binaryInputPort(let input) = port.kind else {
180205
throw RuntimeError.type(.port(port), expected: [.binaryInputPortType])
181206
}
182207
return input
183208
}
184209

185210
func textOutputFrom(_ expr: Expr?) throws -> TextOutput {
186-
let port = try expr?.asPort() ?? self.context.outputPort!
211+
let port = try expr?.asPort() ?? self.defaultPort(self.outputPortParam)
187212
guard case .textOutputPort(let output) = port.kind else {
188213
throw RuntimeError.type(.port(port), expected: [.textInputPortType])
189214
}
190215
return output
191216
}
192217

193218
func binaryOutputFrom(_ expr: Expr?) throws -> BinaryOutput {
194-
let port = try expr?.asPort() ?? self.context.outputPort!
219+
let port = try expr?.asPort() ?? self.defaultPort(self.outputPortParam)
195220
guard case .binaryOutputPort(let output) = port.kind else {
196221
throw RuntimeError.type(.port(port), expected: [.binaryInputPortType])
197222
}
@@ -357,51 +382,6 @@ public final class PortLibrary: NativeLibrary {
357382
return .void
358383
}
359384

360-
func currentInputPort(_ expr: Expr?) throws -> Expr {
361-
switch expr {
362-
case .none:
363-
return .port(self.context.inputPort)
364-
case .some(.port(let port)):
365-
guard port.isInputPort else {
366-
throw RuntimeError.type(expr!, expected: [.inputPortType])
367-
}
368-
self.context.inputPort = port
369-
return .void
370-
default:
371-
throw RuntimeError.type(expr!, expected: [.inputPortType])
372-
}
373-
}
374-
375-
func currentOutputPort(_ expr: Expr?) throws -> Expr {
376-
switch expr {
377-
case .none:
378-
return .port(self.context.outputPort)
379-
case .some(.port(let port)):
380-
guard port.isOutputPort else {
381-
throw RuntimeError.type(expr!, expected: [.outputPortType])
382-
}
383-
self.context.outputPort = port
384-
return .void
385-
default:
386-
throw RuntimeError.type(expr!, expected: [.outputPortType])
387-
}
388-
}
389-
390-
func currentErrorPort(_ expr: Expr?) throws -> Expr {
391-
switch expr {
392-
case .none:
393-
return .port(self.context.errorPort)
394-
case .some(.port(let port)):
395-
guard port.isOutputPort else {
396-
throw RuntimeError.type(expr!, expected: [.outputPortType])
397-
}
398-
self.context.errorPort = port
399-
return .void
400-
default:
401-
throw RuntimeError.type(expr!, expected: [.outputPortType])
402-
}
403-
}
404-
405385
func isEofObject(_ expr: Expr) -> Expr {
406386
return .makeBoolean(expr == .eof)
407387
}
@@ -501,7 +481,7 @@ public final class PortLibrary: NativeLibrary {
501481

502482
func readBytevectorSet(_ bvec: Expr, args: Arguments) throws -> Expr {
503483
let bvector = try bvec.asByteVector()
504-
guard let (pexpr, s, e) = args.optional(.port(self.context.inputPort),
484+
guard let (pexpr, s, e) = args.optional(.port(try self.defaultPort(self.inputPortParam)),
505485
.makeNumber(bvector.value.count),
506486
.makeNumber(0)) else {
507487
throw RuntimeError.argumentCount(num: 4, args: .pair(bvec, .makeList(args)))
@@ -531,7 +511,8 @@ public final class PortLibrary: NativeLibrary {
531511
func write(_ expr: Expr, port: Expr?) throws -> Expr {
532512
let output = try self.textOutputFrom(port)
533513
guard output.writeString(expr.description) else {
534-
throw RuntimeError.eval(.cannotWriteToPort, port ?? .port(self.context.outputPort))
514+
let outPort = try port ?? .port(self.defaultPort(self.outputPortParam))
515+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
535516
}
536517
return .void
537518
}
@@ -541,7 +522,8 @@ public final class PortLibrary: NativeLibrary {
541522
func writeShared(_ expr: Expr, port: Expr?) throws -> Expr {
542523
let output = try self.textOutputFrom(port)
543524
guard output.writeString(expr.description) else {
544-
throw RuntimeError.eval(.cannotWriteToPort, port ?? .port(self.context.outputPort))
525+
let outPort = try port ?? .port(self.defaultPort(self.outputPortParam))
526+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
545527
}
546528
return .void
547529
}
@@ -551,41 +533,46 @@ public final class PortLibrary: NativeLibrary {
551533
func writeSimple(_ expr: Expr, port: Expr?) throws -> Expr {
552534
let output = try self.textOutputFrom(port)
553535
guard output.writeString(expr.description) else {
554-
throw RuntimeError.eval(.cannotWriteToPort, port ?? .port(self.context.outputPort))
536+
let outPort = try port ?? .port(self.defaultPort(self.outputPortParam))
537+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
555538
}
556539
return .void
557540
}
558541

559542
func display(_ expr: Expr, port: Expr? = nil) throws -> Expr {
560543
let output = try self.textOutputFrom(port)
561544
guard output.writeString(expr.unescapedDescription) else {
562-
throw RuntimeError.eval(.cannotWriteToPort, port ?? .port(self.context.outputPort))
545+
let outPort = try port ?? .port(self.defaultPort(self.outputPortParam))
546+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
563547
}
564548
return .void
565549
}
566550

567551
func newline(_ port: Expr?) throws -> Expr {
568552
guard try self.textOutputFrom(port).writeString("\n") else {
569-
throw RuntimeError.eval(.cannotWriteToPort, port ?? .port(self.context.outputPort))
553+
let outPort = try port ?? .port(self.defaultPort(self.outputPortParam))
554+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
570555
}
571556
return .void
572557
}
573558

574559
func writeChar(_ expr: Expr, port: Expr?) throws -> Expr {
575560
guard try self.textOutputFrom(port).write(expr.asUniChar()) else {
576-
throw RuntimeError.eval(.cannotWriteToPort, port ?? .port(self.context.outputPort))
561+
let outPort = try port ?? .port(self.defaultPort(self.outputPortParam))
562+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
577563
}
578564
return .void
579565
}
580566

581567
func writeString(_ expr: Expr, args: Arguments) throws -> Expr {
582568
if args.count < 2 {
583569
guard try self.textOutputFrom(args.first).writeString(expr.asString()) else {
584-
throw RuntimeError.eval(.cannotWriteToPort, args.first ?? .port(self.context.outputPort))
570+
let outPort = try args.first ?? .port(self.defaultPort(self.outputPortParam))
571+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
585572
}
586573
} else {
587574
let chars = try expr.asString().utf16
588-
guard let (port, s, e) = args.optional(.port(self.context.outputPort),
575+
guard let (port, s, e) = args.optional(.port(try self.defaultPort(self.outputPortParam)),
589576
.makeNumber(chars.count),
590577
.makeNumber(0)) else {
591578
throw RuntimeError.argumentCount(of: "write-string",
@@ -622,7 +609,8 @@ public final class PortLibrary: NativeLibrary {
622609

623610
func writeU8(_ expr: Expr, port: Expr?) throws -> Expr {
624611
guard try self.binaryOutputFrom(port).write(expr.asUInt8()) else {
625-
throw RuntimeError.eval(.cannotWriteToPort, port ?? .port(self.context.outputPort))
612+
let outPort = try port ?? .port(self.defaultPort(self.outputPortParam))
613+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
626614
}
627615
return .void
628616
}
@@ -632,10 +620,11 @@ public final class PortLibrary: NativeLibrary {
632620
if args.count < 2 {
633621
guard try self.binaryOutputFrom(args.first)
634622
.writeFrom(bvector, start: 0, end: bvector.count) else {
635-
throw RuntimeError.eval(.cannotWriteToPort, args.first ?? .port(self.context.outputPort))
623+
let outPort = try args.first ?? .port(self.defaultPort(self.outputPortParam))
624+
throw RuntimeError.eval(.cannotWriteToPort, outPort)
636625
}
637626
} else {
638-
guard let (port, s, e) = args.optional(.port(self.context.outputPort),
627+
guard let (port, s, e) = args.optional(.port(try self.defaultPort(self.outputPortParam)),
639628
.makeNumber(bvector.count),
640629
.makeNumber(0)) else {
641630
throw RuntimeError.argumentCount(of: "write-bytevector",
@@ -666,7 +655,7 @@ public final class PortLibrary: NativeLibrary {
666655
}
667656

668657
func flushOutputPort(_ port: Expr?) throws -> Expr {
669-
let port = try port?.asPort() ?? self.context.outputPort!
658+
let port = try port?.asPort() ?? self.defaultPort(self.outputPortParam)
670659
switch port.kind {
671660
case .binaryOutputPort(let output):
672661
output.flush(true)

‎Sources/LispKit/Primitives/SystemLibrary.swift‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ public final class SystemLibrary: NativeLibrary {
5757
self.context.fileHandler.currentDirectoryPath))
5858
self.compileAndEvalFirstProc =
5959
Procedure("_compileAndEvalFirst", self.compileAndEvalFirst)
60-
self.define("current-directory", as: .procedure(self.currentDirectoryProc))
60+
self.define("current-directory", as: self.currentDirectoryProc)
6161
self.define(Procedure("file-path", self.filePath))
6262
self.define(Procedure("parent-file-path", self.parentFilePath))
6363
self.define(Procedure("file-path-root?", self.filePathRoot))

0 commit comments

Comments
 (0)