Skip to content

Commit 77535ee

Browse files
objecthubobjecthub
committed
Implement functionallity of SRFI 258. Include procedures generate-uninterned-symbol and symbol<? in (lispkit core). Support #f, symbols and strings as argument of gensym and generate-uninterned-symbol.
1 parent 2c8f5c9 commit 77535ee

File tree

5 files changed

+166
-4
lines changed

5 files changed

+166
-4
lines changed

‎LispKit.xcodeproj/project.pbxproj

+12
Original file line numberDiff line numberDiff line change
@@ -1345,6 +1345,10 @@
13451345
CCEFE6111ED80BBA00DFED9B /* 142.sld in Copy pre-installed SRFI libraries */ = {isa = PBXBuildFile; fileRef = CCEFE6101ED804E900DFED9B /* 142.sld */; };
13461346
CCEFE6131ED8F43300DFED9B /* 133.sld in Copy pre-installed SRFI libraries */ = {isa = PBXBuildFile; fileRef = CCEFE6121ED8F17700DFED9B /* 133.sld */; };
13471347
CCEFE6151ED8F56600DFED9B /* SRFI133.scm in Resources */ = {isa = PBXBuildFile; fileRef = CCEFE6141ED8F55D00DFED9B /* SRFI133.scm */; };
1348+
CCF37FFF2DAB93BD000936CA /* 258.sld in Copy pre-installed SRFI libraries */ = {isa = PBXBuildFile; fileRef = CCF37FFE2DAB90B2000936CA /* 258.sld */; };
1349+
CCF380002DAB93D1000936CA /* 258.sld in Copy pre-installed SRFI libraries */ = {isa = PBXBuildFile; fileRef = CCF37FFE2DAB90B2000936CA /* 258.sld */; };
1350+
CCF380022DAB95F9000936CA /* SRFI-258.scm in Copy tests */ = {isa = PBXBuildFile; fileRef = CCF380012DAB94E7000936CA /* SRFI-258.scm */; };
1351+
CCF380032DAB9616000936CA /* SRFI-258.scm in Copy tests */ = {isa = PBXBuildFile; fileRef = CCF380012DAB94E7000936CA /* SRFI-258.scm */; };
13481352
CCF529981CBC73F7000C2959 /* StringBuilder.swift in Sources */ = {isa = PBXBuildFile; fileRef = CCF529971CBC73F7000C2959 /* StringBuilder.swift */; };
13491353
CCF578D72896767100BC082C /* matrix.sld in Copy pre-installed LispKit library: LispKit Math */ = {isa = PBXBuildFile; fileRef = CCF578D62896764C00BC082C /* matrix.sld */; };
13501354
CCF578D82896767C00BC082C /* matrix.sld in Copy pre-installed LispKit library: LispKit Math */ = {isa = PBXBuildFile; fileRef = CCF578D62896764C00BC082C /* matrix.sld */; };
@@ -1412,6 +1416,7 @@
14121416
dstPath = Root/LispKit/Tests;
14131417
dstSubfolderSpec = 7;
14141418
files = (
1419+
CCF380022DAB95F9000936CA /* SRFI-258.scm in Copy tests */,
14151420
CC35C0212C88FDA100DF6E9D /* LispKit-Control.scm in Copy tests */,
14161421
CCCCEC902C5457A600509902 /* LispKit-Shared-Queue.scm in Copy tests */,
14171422
CCD5B5DE2C152B21002BF2F0 /* LispKit-JSON-Schema.scm in Copy tests */,
@@ -2151,6 +2156,7 @@
21512156
dstPath = Root/LispKit/Libraries/srfi;
21522157
dstSubfolderSpec = 7;
21532158
files = (
2159+
CCF37FFF2DAB93BD000936CA /* 258.sld in Copy pre-installed SRFI libraries */,
21542160
CC491BB92A407D71008CA24C /* 235.sld in Copy pre-installed SRFI libraries */,
21552161
CCB457432A3A6BE200599565 /* 131.sld in Copy pre-installed SRFI libraries */,
21562162
CC7D4B792A2558990066BA94 /* 239.sld in Copy pre-installed SRFI libraries */,
@@ -2268,6 +2274,7 @@
22682274
dstPath = Root/LispKit/Libraries/srfi;
22692275
dstSubfolderSpec = 7;
22702276
files = (
2277+
CCF380002DAB93D1000936CA /* 258.sld in Copy pre-installed SRFI libraries */,
22712278
CC491BBB2A407D91008CA24C /* 235.sld in Copy pre-installed SRFI libraries */,
22722279
CCB457442A3A6BF400599565 /* 131.sld in Copy pre-installed SRFI libraries */,
22732280
CC7D4B7A2A2558B20066BA94 /* 239.sld in Copy pre-installed SRFI libraries */,
@@ -2638,6 +2645,7 @@
26382645
dstPath = Root/LispKit/Tests;
26392646
dstSubfolderSpec = 7;
26402647
files = (
2648+
CCF380032DAB9616000936CA /* SRFI-258.scm in Copy tests */,
26412649
CC35C0232C88FDD900DF6E9D /* LispKit-Control.scm in Copy tests */,
26422650
CC35C0222C88FDC800DF6E9D /* LispKit-Shared-Queue.scm in Copy tests */,
26432651
CCD5B5DF2C152B38002BF2F0 /* LispKit-JSON-Schema.scm in Copy tests */,
@@ -3807,6 +3815,8 @@
38073815
CCEFE6101ED804E900DFED9B /* 142.sld */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = 142.sld; sourceTree = "<group>"; };
38083816
CCEFE6121ED8F17700DFED9B /* 133.sld */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = 133.sld; sourceTree = "<group>"; };
38093817
CCEFE6141ED8F55D00DFED9B /* SRFI133.scm */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = SRFI133.scm; sourceTree = "<group>"; };
3818+
CCF37FFE2DAB90B2000936CA /* 258.sld */ = {isa = PBXFileReference; lastKnownFileType = text; path = 258.sld; sourceTree = "<group>"; };
3819+
CCF380012DAB94E7000936CA /* SRFI-258.scm */ = {isa = PBXFileReference; lastKnownFileType = text; path = "SRFI-258.scm"; sourceTree = "<group>"; };
38103820
CCF529971CBC73F7000C2959 /* StringBuilder.swift */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.swift; path = StringBuilder.swift; sourceTree = "<group>"; };
38113821
CCF578D62896764C00BC082C /* matrix.sld */ = {isa = PBXFileReference; lastKnownFileType = text; path = matrix.sld; sourceTree = "<group>"; };
38123822
CCF602E3239BE71F00087740 /* Markdown.scm */ = {isa = PBXFileReference; lastKnownFileType = text; path = Markdown.scm; sourceTree = "<group>"; };
@@ -3956,6 +3966,7 @@
39563966
CC6E93C9281CA00C0002C4BC /* SRFI-232.scm */,
39573967
CCCD1ABB298C6D910057DCEB /* SRFI-233.scm */,
39583968
CC491BB72A407B1C008CA24C /* SRFI-235.scm */,
3969+
CCF380012DAB94E7000936CA /* SRFI-258.scm */,
39593970
);
39603971
path = Tests;
39613972
sourceTree = "<group>";
@@ -4367,6 +4378,7 @@
43674378
CC491BB82A407C56008CA24C /* 235.sld */,
43684379
CCCD1ABE298C6FEA0057DCEB /* 236.sld */,
43694380
CC7D4B782A2554760066BA94 /* 239.sld */,
4381+
CCF37FFE2DAB90B2000936CA /* 258.sld */,
43704382
);
43714383
path = srfi;
43724384
sourceTree = "<group>";

‎Sources/LispKit/Primitives/CoreLibrary.swift

+35-3
Original file line numberDiff line numberDiff line change
@@ -107,7 +107,9 @@ public final class CoreLibrary: NativeLibrary {
107107
self.define(Procedure("symbol?", isSymbol))
108108
self.define(Procedure("symbol-interned?", isSymbolInterned))
109109
self.define(Procedure("gensym", gensym))
110-
self.define(Procedure("symbol=?", stringEquals))
110+
self.define(Procedure("generate-uninterned-symbol", generateUninternedSymbol))
111+
self.define(Procedure("symbol=?", symbolEquals))
112+
self.define(Procedure("symbol<?", symbolLess))
111113
self.define(Procedure("string->symbol", stringToSymbol))
112114
self.define(Procedure("string->uninterned-symbol", stringToUninternedSymbol))
113115
self.define(Procedure("symbol->string", symbolToString))
@@ -1136,10 +1138,28 @@ public final class CoreLibrary: NativeLibrary {
11361138
}
11371139

11381140
private func gensym(expr: Expr?) throws -> Expr {
1139-
return .symbol(self.context.symbols.gensym(try expr?.asString() ?? "g"))
1141+
switch expr {
1142+
case .none, .some(.false):
1143+
return .symbol(self.context.symbols.gensym("g"))
1144+
case .some(.symbol(let sym)):
1145+
return .symbol(self.context.symbols.gensym(sym.identifier))
1146+
case .some(let e):
1147+
return .symbol(self.context.symbols.gensym(try e.asString()))
1148+
}
11401149
}
11411150

1142-
private func stringEquals(expr: Expr, args: Arguments) throws -> Expr {
1151+
private func generateUninternedSymbol(expr: Expr?) throws -> Expr {
1152+
switch expr {
1153+
case .none, .some(.false):
1154+
return .symbol(self.context.symbols.gensym("g", intern: false))
1155+
case .some(.symbol(let sym)):
1156+
return .symbol(self.context.symbols.gensym(sym.identifier, intern: false))
1157+
case .some(let e):
1158+
return .symbol(self.context.symbols.gensym(try e.asString(), intern: false))
1159+
}
1160+
}
1161+
1162+
private func symbolEquals(expr: Expr, args: Arguments) throws -> Expr {
11431163
let sym = try expr.asSymbol()
11441164
for arg in args {
11451165
guard try sym == arg.asSymbol() else {
@@ -1149,6 +1169,18 @@ public final class CoreLibrary: NativeLibrary {
11491169
return .true
11501170
}
11511171

1172+
private func symbolLess(expr: Expr, args: Arguments) throws -> Expr {
1173+
var sym = try expr.asSymbol().identifier
1174+
for arg in args {
1175+
let str = try arg.asSymbol().identifier
1176+
guard sym < str else {
1177+
return .false
1178+
}
1179+
sym = str
1180+
}
1181+
return .true
1182+
}
1183+
11521184
private func stringToSymbol(expr: Expr) throws -> Expr {
11531185
return .symbol(self.context.symbols.intern(try expr.asString()))
11541186
}

‎Sources/LispKit/Resources/Libraries/srfi/258.sld

+38
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
;;; SRFI 258
2+
;;; Uninterned Symbols
3+
;;;
4+
;;; This SRFI provides functionality to deal with uninterend symbols.
5+
;;; An uninterned symbol is not the same as any other symbol, even one
6+
;;; with the same name. These symbols are useful in macro programming
7+
;;; and in other situations where guaranteed-unique names are needed.
8+
;;;
9+
;;; Author of spec: Wolfgang Corcoran-Mathe.
10+
;;;
11+
;;; Copyright © 2025 Matthias Zenger. All rights reserved.
12+
;;;
13+
;;; Permission is hereby granted, free of charge, to any person obtaining
14+
;;; a copy of this software and associated documentation files (the
15+
;;; "Software"), to deal in the Software without restriction, including
16+
;;; without limitation the rights to use, copy, modify, merge, publish,
17+
;;; distribute, sublicense, and/or sell copies of the Software, and to
18+
;;; permit persons to whom the Software is furnished to do so, subject to
19+
;;; the following conditions:
20+
;;;
21+
;;; The above copyright notice and this permission notice shall be included
22+
;;; in all copies or substantial portions of the Software.
23+
;;;
24+
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
25+
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
26+
;;; FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
27+
;;; COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
28+
;;; IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
29+
;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
30+
31+
(define-library (srfi 258)
32+
33+
(export generate-uninterned-symbol
34+
string->uninterned-symbol
35+
symbol-interned?)
36+
37+
(import (lispkit base))
38+
)

‎Sources/LispKit/Resources/Tests/SRFI-235.scm

+1-1
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@
3131
(srfi 235)
3232
(srfi 1))
3333

34-
(test-begin "Combinators")
34+
(test-begin "SRFI 235: Combinators")
3535

3636
(test-group
3737
"Combinators: constantly"

‎Sources/LispKit/Resources/Tests/SRFI-258.scm

+80
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
;;; SRFI 258 REGRESSION TEST SUITE
2+
;;;
3+
;;; This is the test suite for SRFI 258.
4+
;;;
5+
;;; Copyright © 2025 Wolfgang Corcoran-Mathe. All rights reserved.
6+
;;;
7+
;;; Permission is hereby granted, free of charge, to any person
8+
;;; obtaining a copy of this software and associated documentation
9+
;;; files (the "Software"), to deal in the Software without restriction,
10+
;;; including without limitation the rights to use, copy, modify, merge,
11+
;;; publish, distribute, sublicense, and/or sell copies of the Software,
12+
;;; and to permit persons to whom the Software is furnished to do so,
13+
;;; subject to the following conditions:
14+
;;;
15+
;;; The above copyright notice and this permission notice shall be
16+
;;; included in all copies or substantial portions of the Software.
17+
;;;
18+
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19+
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
20+
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
21+
;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
22+
;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
23+
;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
24+
;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
25+
;;;
26+
;;; LispKit Port:
27+
;;; Copyright © 2025 Matthias Zenger. All rights reserved.
28+
29+
(import (lispkit base)
30+
(lispkit test)
31+
(srfi 258))
32+
33+
(test-begin "SRFI 258: Uninterned symbols")
34+
35+
(test-assert "Usym is symbol? (S->US)"
36+
(symbol? (string->uninterned-symbol "x")))
37+
38+
(test-assert "Usym is symbol? (GUS)"
39+
(symbol? (generate-uninterned-symbol)))
40+
41+
(test-assert "Usym is unique (S->US)"
42+
(not (eqv? (string->uninterned-symbol "x")
43+
(string->uninterned-symbol "x"))))
44+
45+
(test-assert "Usym is unique (GUS)"
46+
(not (eqv? (generate-uninterned-symbol)
47+
(generate-uninterned-symbol))))
48+
49+
(test-assert "Usym is eqv? to itself (S->US)"
50+
(let ((x (string->uninterned-symbol "x")))
51+
(eqv? x x)))
52+
53+
(test-assert "Usym is eqv? to itself (GUS)"
54+
(let ((x (generate-uninterned-symbol)))
55+
(eqv? x x)))
56+
57+
(test-assert "Usym is not symbol-interned? (S->US)"
58+
(not (symbol-interned? (string->uninterned-symbol "x"))))
59+
60+
(test-assert "Usym is not symbol-interned? (GUS)"
61+
(not (symbol-interned? (generate-uninterned-symbol))))
62+
63+
(test-assert "generate-uninterned-symbol with string prefix"
64+
(let* ((prefix "perfection")
65+
(g (generate-uninterned-symbol prefix)))
66+
(equal? prefix
67+
(substring (symbol->string g)
68+
0
69+
(string-length prefix)))))
70+
71+
(test-assert "generate-uninterned-symbol with symbol prefix"
72+
(let* ((prefix 'perfection)
73+
(ps (symbol->string prefix))
74+
(g (generate-uninterned-symbol prefix)))
75+
(equal? ps
76+
(substring (symbol->string g)
77+
0
78+
(string-length ps)))))
79+
80+
(test-end)

0 commit comments

Comments
 (0)