coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

spec: character type (char? char->integer #\a literals + predicates)

Browse Source 
- Add SxChar tagged object {_char, codepoint} to JS platform
- char? char->integer integer->char char-upcase char-downcase
- char=? char<? char>? char<=? char>=? comparators
- char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=? case-insensitive
- char-alphabetic? char-numeric? char-whitespace? char-upper-case? char-lower-case?
- string->list (returns chars) and list->string (accepts chars)
- #\a #\space #\newline reader syntax in spec/parser.sx
- integer->char alias in spec/evaluator.sx
- js-char-renames dict in transpiler.sx for ->-containing names
- 43 tests in spec/tests/test-chars.sx, all passing

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-01 11:50:04 +00:00
parent 46da676c29
commit 4b600f17e8
7 changed files with 788 additions and 297 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
hosts/javascript/platform.py
View File

@@ -1080,6 +1080,41 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
PRIMITIVES["slice"] = function(c, a, b) { if (!c || typeof c.slice !== "function") { console.error("[sx-debug] slice called on non-sliceable:", typeof c, c, "a=", a, "b=", b, new Error().stack); return []; } return b !== undefined ? c.slice(a, b) : c.slice(a); };
PRIMITIVES["substring"] = function(s, a, b) { return String(s).substring(a, b); };
PRIMITIVES["char-from-code"] = function(n) { return String.fromCharCode(n); };
PRIMITIVES["char-code"] = function(s) { return String(s).charCodeAt(0); };
var charCode = PRIMITIVES["char-code"];
function makeChar(n) { return {_char: true, codepoint: n}; }
PRIMITIVES["make-char"] = makeChar;
var isChar = function(v) { return v != null && typeof v === "object" && v._char === true; };
PRIMITIVES["char?"] = isChar;
var charToInteger = function(c) { return c.codepoint; };
PRIMITIVES["char->integer"] = charToInteger;
var charUpcase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toUpperCase().charCodeAt(0)); };
PRIMITIVES["char-upcase"] = charUpcase;
var charDowncase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toLowerCase().charCodeAt(0)); };
PRIMITIVES["char-downcase"] = charDowncase;
PRIMITIVES["char=?"] = function(a, b) { return a.codepoint === b.codepoint; };
PRIMITIVES["char<?"] = function(a, b) { return a.codepoint < b.codepoint; };
PRIMITIVES["char>?"] = function(a, b) { return a.codepoint > b.codepoint; };
PRIMITIVES["char<=?"] = function(a, b) { return a.codepoint <= b.codepoint; };
PRIMITIVES["char>=?"] = function(a, b) { return a.codepoint >= b.codepoint; };
PRIMITIVES["char-ci=?"] = function(a, b) { return charDowncase(a).codepoint === charDowncase(b).codepoint; };
PRIMITIVES["char-ci<?"] = function(a, b) { return charDowncase(a).codepoint < charDowncase(b).codepoint; };
PRIMITIVES["char-ci>?"] = function(a, b) { return charDowncase(a).codepoint > charDowncase(b).codepoint; };
PRIMITIVES["char-ci<=?"] = function(a, b) { return charDowncase(a).codepoint <= charDowncase(b).codepoint; };
PRIMITIVES["char-ci>=?"] = function(a, b) { return charDowncase(a).codepoint >= charDowncase(b).codepoint; };
PRIMITIVES["char-alphabetic?"] = function(c) { var n = c.codepoint; return (n >= 65 && n <= 90) || (n >= 97 && n <= 122); };
PRIMITIVES["char-numeric?"] = function(c) { var n = c.codepoint; return n >= 48 && n <= 57; };
PRIMITIVES["char-whitespace?"] = function(c) { var n = c.codepoint; return n === 32 || n === 9 || n === 10 || n === 13; };
PRIMITIVES["char-upper-case?"] = function(c) { var n = c.codepoint; return n >= 65 && n <= 90; };
PRIMITIVES["char-lower-case?"] = function(c) { var n = c.codepoint; return n >= 97 && n <= 122; };
PRIMITIVES["string->list"] = function(s) {
var chars = []; var str = String(s);
for (var i = 0; i < str.length; i++) chars.push(makeChar(str.charCodeAt(i)));
return chars;
};
PRIMITIVES["list->string"] = function(chars) {
return chars.map(function(c) { return String.fromCharCode(c.codepoint); }).join('');
};
PRIMITIVES["string-length"] = function(s) { return String(s).length; };
var stringLength = PRIMITIVES["string-length"];
PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; };
@@ -1397,6 +1432,7 @@ PLATFORM_JS_PRE = '''
if (x._macro) return "macro";
if (x._raw) return "raw-html";
if (x._sx_expr) return "sx-expr";
if (x._char) return "char";
if (x._vector) return "vector";
if (x._string_buffer) return "string-buffer";
if (x._hash_table) return "hash-table";
@@ -2045,6 +2081,9 @@ PLATFORM_PARSER_JS = r"""
}
function sxExprSource(e) { return typeof e === "string" ? e : (e && e.source ? e.source : String(e)); }
var charFromCode = PRIMITIVES["char-from-code"];
var makeChar = PRIMITIVES["make-char"];
var charToInteger = PRIMITIVES["char->integer"];
var isChar = PRIMITIVES["char?"];
"""

57
hosts/javascript/transpiler.sx
View File

File diff suppressed because one or more lines are too long

68
shared/static/scripts/sx-browser.js
View File

@@ -31,7 +31,7 @@
// =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-05-01T10:26:58Z";
var SX_VERSION = "2026-05-01T11:46:28Z";
function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -168,6 +168,7 @@
if (x._macro) return "macro";
if (x._raw) return "raw-html";
if (x._sx_expr) return "sx-expr";
if (x._char) return "char";
if (x._vector) return "vector";
if (x._string_buffer) return "string-buffer";
if (x._hash_table) return "hash-table";
@@ -475,6 +476,41 @@
PRIMITIVES["slice"] = function(c, a, b) { if (!c || typeof c.slice !== "function") { console.error("[sx-debug] slice called on non-sliceable:", typeof c, c, "a=", a, "b=", b, new Error().stack); return []; } return b !== undefined ? c.slice(a, b) : c.slice(a); };
PRIMITIVES["substring"] = function(s, a, b) { return String(s).substring(a, b); };
PRIMITIVES["char-from-code"] = function(n) { return String.fromCharCode(n); };
PRIMITIVES["char-code"] = function(s) { return String(s).charCodeAt(0); };
var charCode = PRIMITIVES["char-code"];
function makeChar(n) { return {_char: true, codepoint: n}; }
PRIMITIVES["make-char"] = makeChar;
var isChar = function(v) { return v != null && typeof v === "object" && v._char === true; };
PRIMITIVES["char?"] = isChar;
var charToInteger = function(c) { return c.codepoint; };
PRIMITIVES["char->integer"] = charToInteger;
var charUpcase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toUpperCase().charCodeAt(0)); };
PRIMITIVES["char-upcase"] = charUpcase;
var charDowncase = function(c) { return makeChar(String.fromCharCode(c.codepoint).toLowerCase().charCodeAt(0)); };
PRIMITIVES["char-downcase"] = charDowncase;
PRIMITIVES["char=?"] = function(a, b) { return a.codepoint === b.codepoint; };
PRIMITIVES["char<?"] = function(a, b) { return a.codepoint < b.codepoint; };
PRIMITIVES["char>?"] = function(a, b) { return a.codepoint > b.codepoint; };
PRIMITIVES["char<=?"] = function(a, b) { return a.codepoint <= b.codepoint; };
PRIMITIVES["char>=?"] = function(a, b) { return a.codepoint >= b.codepoint; };
PRIMITIVES["char-ci=?"] = function(a, b) { return charDowncase(a).codepoint === charDowncase(b).codepoint; };
PRIMITIVES["char-ci<?"] = function(a, b) { return charDowncase(a).codepoint < charDowncase(b).codepoint; };
PRIMITIVES["char-ci>?"] = function(a, b) { return charDowncase(a).codepoint > charDowncase(b).codepoint; };
PRIMITIVES["char-ci<=?"] = function(a, b) { return charDowncase(a).codepoint <= charDowncase(b).codepoint; };
PRIMITIVES["char-ci>=?"] = function(a, b) { return charDowncase(a).codepoint >= charDowncase(b).codepoint; };
PRIMITIVES["char-alphabetic?"] = function(c) { var n = c.codepoint; return (n >= 65 && n <= 90) || (n >= 97 && n <= 122); };
PRIMITIVES["char-numeric?"] = function(c) { var n = c.codepoint; return n >= 48 && n <= 57; };
PRIMITIVES["char-whitespace?"] = function(c) { var n = c.codepoint; return n === 32 || n === 9 || n === 10 || n === 13; };
PRIMITIVES["char-upper-case?"] = function(c) { var n = c.codepoint; return n >= 65 && n <= 90; };
PRIMITIVES["char-lower-case?"] = function(c) { var n = c.codepoint; return n >= 97 && n <= 122; };
PRIMITIVES["string->list"] = function(s) {
var chars = []; var str = String(s);
for (var i = 0; i < str.length; i++) chars.push(makeChar(str.charCodeAt(i)));
return chars;
};
PRIMITIVES["list->string"] = function(chars) {
return chars.map(function(c) { return String.fromCharCode(c.codepoint); }).join('');
};
PRIMITIVES["string-length"] = function(s) { return String(s).length; };
var stringLength = PRIMITIVES["string-length"];
PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; };
@@ -1102,6 +1138,9 @@
}
function sxExprSource(e) { return typeof e === "string" ? e : (e && e.source ? e.source : String(e)); }
var charFromCode = PRIMITIVES["char-from-code"];
var makeChar = PRIMITIVES["make-char"];
var charToInteger = PRIMITIVES["char->integer"];
var isChar = PRIMITIVES["char?"];
// String/number utilities needed by transpiled spec code (content-hash etc)
@@ -3599,6 +3638,10 @@ PRIMITIVES["intern"] = intern;
var symbolInterned_p = function(sym) { return true; };
PRIMITIVES["symbol-interned?"] = symbolInterned_p;
// integer->char
var integerToChar = makeChar;
PRIMITIVES["integer->char"] = integerToChar;
// === Transpiled from freeze (serializable state boundaries) ===
@@ -3901,6 +3944,21 @@ PRIMITIVES["raw-loop"] = rawLoop;
return buf;
})(); };
PRIMITIVES["read-raw-string"] = readRawString;
var readCharLiteral = function() { return (isSxTruthy((pos >= lenSrc)) ? error("Unexpected end of input after #\\") : (function() {
var firstCh = nth(source, pos);
return (isSxTruthy(isIdentStart(firstCh)) ? (function() {
var charStart = pos;
var readCharNameLoop = function() { while(true) { if (isSxTruthy((isSxTruthy((pos < lenSrc)) && isIdentChar(nth(source, pos))))) { pos = (pos + 1);
continue; } else { return NIL; } } };
PRIMITIVES["read-char-name-loop"] = readCharNameLoop;
readCharNameLoop();
return (function() {
var charName = slice(source, charStart, pos);
return makeChar((isSxTruthy(sxEq(charName, "space")) ? 32 : (isSxTruthy(sxEq(charName, "newline")) ? 10 : (isSxTruthy(sxEq(charName, "tab")) ? 9 : (isSxTruthy(sxEq(charName, "nul")) ? 0 : (isSxTruthy(sxEq(charName, "null")) ? 0 : (isSxTruthy(sxEq(charName, "return")) ? 13 : (isSxTruthy(sxEq(charName, "escape")) ? 27 : (isSxTruthy(sxEq(charName, "delete")) ? 127 : (isSxTruthy(sxEq(charName, "backspace")) ? 8 : (isSxTruthy(sxEq(charName, "altmode")) ? 27 : (isSxTruthy(sxEq(charName, "rubout")) ? 127 : charCode(firstCh)))))))))))));
})();
})() : ((pos = (pos + 1)), makeChar(charCode(firstCh))));
})()); };
PRIMITIVES["read-char-literal"] = readCharLiteral;
var readExpr = function() { while(true) { skipWs();
if (isSxTruthy((pos >= lenSrc))) { return error("Unexpected end of input"); } else { { var ch = nth(source, pos);
if (isSxTruthy(sxEq(ch, "("))) { pos = (pos + 1);
@@ -3916,7 +3974,8 @@ if (isSxTruthy(sxEq(dispatchCh, ";"))) { pos = (pos + 1);
readExpr();
continue; } else if (isSxTruthy(sxEq(dispatchCh, "|"))) { pos = (pos + 1);
return readRawString(); } else if (isSxTruthy(sxEq(dispatchCh, "'"))) { pos = (pos + 1);
return [makeSymbol("quote"), readExpr()]; } else if (isSxTruthy(isIdentStart(dispatchCh))) { { var macroName = readIdent();
return [makeSymbol("quote"), readExpr()]; } else if (isSxTruthy(sxEq(dispatchCh, "\\"))) { pos = (pos + 1);
return readCharLiteral(); } else if (isSxTruthy(isIdentStart(dispatchCh))) { { var macroName = readIdent();
{ var handler = readerMacroGet(macroName);
if (isSxTruthy(handler)) { return handler(readExpr()); } else { return error((String("Unknown reader macro: #") + String(macroName))); } } } } else { return error((String("Unknown reader macro: #") + String(dispatchCh))); } } } } else if (isSxTruthy(sxOr((isSxTruthy((ch >= "0")) && (ch <= "9")), (isSxTruthy(sxEq(ch, "-")) && isSxTruthy(((pos + 1) < lenSrc)) && (function() {
var nextCh = nth(source, (pos + 1));
@@ -3937,7 +3996,10 @@ PRIMITIVES["parse-loop"] = parseLoop;
PRIMITIVES["sx-parse"] = sxParse;
// sx-serialize
var sxSerialize = function(val) { return (function() { var _m = typeOf(val); if (_m == "nil") return "nil"; if (_m == "boolean") return (isSxTruthy(val) ? "true" : "false"); if (_m == "number") return (String(val)); if (_m == "string") return (String("\"") + String(escapeString(val)) + String("\"")); if (_m == "symbol") return symbolName(val); if (_m == "keyword") return (String(":") + String(keywordName(val))); if (_m == "list") return (String("(") + String(join(" ", map(sxSerialize, val))) + String(")")); if (_m == "dict") return sxSerializeDict(val); if (_m == "sx-expr") return sxExprSource(val); if (_m == "spread") return (String("(make-spread ") + String(sxSerializeDict(spreadAttrs(val))) + String(")")); return (String(val)); })(); };
var sxSerialize = function(val) { return (function() { var _m = typeOf(val); if (_m == "nil") return "nil"; if (_m == "boolean") return (isSxTruthy(val) ? "true" : "false"); if (_m == "number") return (String(val)); if (_m == "string") return (String("\"") + String(escapeString(val)) + String("\"")); if (_m == "symbol") return symbolName(val); if (_m == "keyword") return (String(":") + String(keywordName(val))); if (_m == "list") return (String("(") + String(join(" ", map(sxSerialize, val))) + String(")")); if (_m == "dict") return sxSerializeDict(val); if (_m == "sx-expr") return sxExprSource(val); if (_m == "spread") return (String("(make-spread ") + String(sxSerializeDict(spreadAttrs(val))) + String(")")); if (_m == "char") return (function() {
var n = charToInteger(val);
return (String("#\\") + String((isSxTruthy(sxEq(n, 32)) ? "space" : (isSxTruthy(sxEq(n, 10)) ? "newline" : (isSxTruthy(sxEq(n, 9)) ? "tab" : (isSxTruthy(sxEq(n, 13)) ? "return" : (isSxTruthy(sxEq(n, 0)) ? "nul" : (isSxTruthy(sxEq(n, 27)) ? "escape" : (isSxTruthy(sxEq(n, 127)) ? "delete" : (isSxTruthy(sxEq(n, 8)) ? "backspace" : charFromCode(n)))))))))));
})(); return (String(val)); })(); };
PRIMITIVES["sx-serialize"] = sxSerialize;
// sx-serialize-dict

2
spec/evaluator.sx
View File

@@ -4776,3 +4776,5 @@
(define intern (fn (s) (make-symbol s)))
(define symbol-interned? (fn (sym) true))
(define integer->char make-char)

700
spec/parser.sx
View File

@@ -14,13 +14,14 @@
;; list → '(' expr* ')'
;; vector → '[' expr* ']' (sugar for list)
;; map → '{' (key expr)* '}'
;; atom → string | number | keyword | symbol | boolean | nil
;; atom → string | number | keyword | symbol | boolean | nil | char
;; string → '"' (char | escape)* '"'
;; number → '-'? digit+ ('.' digit+)? ([eE] [+-]? digit+)?
;; keyword → ':' ident
;; symbol → ident
;; boolean → 'true' | 'false'
;; nil → 'nil'
;; char → '#\' (ident | single-char)
;; ident → ident-start ident-char*
;; comment → ';' to end of line (discarded)
;;
@@ -34,6 +35,8 @@
;; #;expr → datum comment (read and discard expr)
;; #|raw chars| → raw string literal (no escape processing)
;; #'expr → (quote expr)
;; #\a → character literal (char value)
;; #\space → named character (space = 32)
;; #name expr → extensible dispatch (calls registered handler)
;;
;; Platform interface (each target implements natively):
@@ -42,6 +45,10 @@
;; (make-symbol name) → Symbol value
;; (make-keyword name) → Keyword value
;; (escape-string s) → string with " and \ escaped for serialization
;; (make-char n) → Char value from Unicode codepoint
;; (char->integer c) → Unicode codepoint of char c
;; (char-from-code n) → single-char string from codepoint
;; (char-code s) → codepoint of first char in string s
;; ==========================================================================
@@ -51,308 +58,416 @@
;; Returns a list of top-level AST expressions.
;; Parse SX source string into AST
(define sx-parse :effects []
(fn ((source :as string))
(let ((pos 0)
(len-src (len source)))
;; -- Cursor helpers (closure over pos, source, len-src) --
(define skip-comment :effects []
(fn ()
(when (and (< pos len-src) (not (= (nth source pos) "\n")))
(define
sx-parse
:effects ()
(fn
((source :as string))
(let
((pos 0) (len-src (len source)))
(define
skip-comment
:effects ()
(fn
()
(when
(and (< pos len-src) (not (= (nth source pos) "\n")))
(set! pos (inc pos))
(skip-comment))))
(define skip-ws :effects []
(fn ()
(when (< pos len-src)
(let ((ch (nth source pos)))
(define
skip-ws
:effects ()
(fn
()
(when
(< pos len-src)
(let
((ch (nth source pos)))
(cond
;; Whitespace
(or (= ch " ") (= ch "\t") (= ch "\n") (= ch "\r"))
(do (set! pos (inc pos)) (skip-ws))
;; Comment — skip to end of line
(do (set! pos (inc pos)) (skip-ws))
(= ch ";")
(do (set! pos (inc pos))
(skip-comment)
(skip-ws))
;; Not whitespace or comment — stop
(do (set! pos (inc pos)) (skip-comment) (skip-ws))
:else nil)))))
;; -- Atom readers --
(define hex-digit-value :effects []
(define
hex-digit-value
:effects ()
(fn (ch) (index-of "0123456789abcdef" (lower ch))))
(define read-string :effects []
(fn ()
(set! pos (inc pos)) ;; skip opening "
(let ((buf ""))
(define read-str-loop :effects []
(fn ()
(if (>= pos len-src)
(define
read-string
:effects ()
(fn
()
(set! pos (inc pos))
(let
((buf ""))
(define
read-str-loop
:effects ()
(fn
()
(if
(>= pos len-src)
(error "Unterminated string")
(let ((ch (nth source pos)))
(let
((ch (nth source pos)))
(cond
(= ch "\"")
(do (set! pos (inc pos)) nil) ;; done
(do (set! pos (inc pos)) nil)
(= ch "\\")
(do (set! pos (inc pos))
(let ((esc (nth source pos)))
(if (= esc "u")
;; Unicode escape: \uXXXX → char
(do (set! pos (inc pos))
(let ((d0 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d1 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d2 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d3 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos))))
(set! buf (str buf (char-from-code
(+ (* d0 4096) (* d1 256) (* d2 16) d3))))
(read-str-loop)))
;; Standard escapes: \n \t \r or literal
(do (set! buf (str buf
(cond
(= esc "n") "\n"
(= esc "t") "\t"
(= esc "r") "\r"
:else esc)))
(set! pos (inc pos))
(read-str-loop)))))
:else
(do (set! buf (str buf ch))
(set! pos (inc pos))
(read-str-loop)))))))
(do
(set! pos (inc pos))
(let
((esc (nth source pos)))
(if
(= esc "u")
(do
(set! pos (inc pos))
(let
((d0 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d1 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d2 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos)))
(d3 (hex-digit-value (nth source pos)))
(_ (set! pos (inc pos))))
(set!
buf
(str
buf
(char-from-code
(+
(* d0 4096)
(* d1 256)
(* d2 16)
d3))))
(read-str-loop)))
(do
(set!
buf
(str
buf
(cond
(= esc "n")
"\n"
(= esc "t")
"\t"
(= esc "r")
"\r"
:else esc)))
(set! pos (inc pos))
(read-str-loop)))))
:else (do
(set! buf (str buf ch))
(set! pos (inc pos))
(read-str-loop)))))))
(read-str-loop)
buf)))
(define read-ident :effects []
(fn ()
(let ((start pos))
(define read-ident-loop :effects []
(fn ()
(when (and (< pos len-src)
(ident-char? (nth source pos)))
(define
read-ident
:effects ()
(fn
()
(let
((start pos))
(define
read-ident-loop
:effects ()
(fn
()
(when
(and (< pos len-src) (ident-char? (nth source pos)))
(set! pos (inc pos))
(read-ident-loop))))
(read-ident-loop)
(slice source start pos))))
(define read-keyword :effects []
(fn ()
(set! pos (inc pos)) ;; skip :
(make-keyword (read-ident))))
(define read-number :effects []
(fn ()
(let ((start pos))
;; Optional leading minus
(when (and (< pos len-src) (= (nth source pos) "-"))
(define
read-keyword
:effects ()
(fn () (set! pos (inc pos)) (make-keyword (read-ident))))
(define
read-number
:effects ()
(fn
()
(let
((start pos))
(when
(and (< pos len-src) (= (nth source pos) "-"))
(set! pos (inc pos)))
;; Integer digits
(define read-digits :effects []
(fn ()
(when (and (< pos len-src)
(let ((c (nth source pos)))
(and (>= c "0") (<= c "9"))))
(define
read-digits
:effects ()
(fn
()
(when
(and
(< pos len-src)
(let
((c (nth source pos)))
(and (>= c "0") (<= c "9"))))
(set! pos (inc pos))
(read-digits))))
(read-digits)
;; Decimal part
(when (and (< pos len-src) (= (nth source pos) "."))
(when
(and (< pos len-src) (= (nth source pos) "."))
(set! pos (inc pos))
(read-digits))
;; Exponent
(when (and (< pos len-src)
(or (= (nth source pos) "e")
(= (nth source pos) "E")))
(when
(and
(< pos len-src)
(or (= (nth source pos) "e") (= (nth source pos) "E")))
(set! pos (inc pos))
(when (and (< pos len-src)
(or (= (nth source pos) "+")
(= (nth source pos) "-")))
(when
(and
(< pos len-src)
(or (= (nth source pos) "+") (= (nth source pos) "-")))
(set! pos (inc pos)))
(read-digits))
(parse-number (slice source start pos)))))
(define read-symbol :effects []
(fn ()
(let ((name (read-ident)))
(define
read-symbol
:effects ()
(fn
()
(let
((name (read-ident)))
(cond
(= name "true") true
(= name "false") false
(= name "nil") nil
:else (make-symbol name)))))
;; -- Composite readers --
(define read-list :effects []
(fn ((close-ch :as string))
(let ((items (list)))
(define read-list-loop :effects []
(fn ()
(= name "true")
true
(= name "false")
false
(= name "nil")
nil
:else (make-symbol name)))))
(define
read-list
:effects ()
(fn
((close-ch :as string))
(let
((items (list)))
(define
read-list-loop
:effects ()
(fn
()
(skip-ws)
(if (>= pos len-src)
(if
(>= pos len-src)
(error "Unterminated list")
(if (= (nth source pos) close-ch)
(do (set! pos (inc pos)) nil) ;; done
(do (append! items (read-expr))
(read-list-loop))))))
(if
(= (nth source pos) close-ch)
(do (set! pos (inc pos)) nil)
(do (append! items (read-expr)) (read-list-loop))))))
(read-list-loop)
items)))
(define read-map :effects []
(fn ()
(let ((result (dict)))
(define read-map-loop :effects []
(fn ()
(define
read-map
:effects ()
(fn
()
(let
((result (dict)))
(define
read-map-loop
:effects ()
(fn
()
(skip-ws)
(if (>= pos len-src)
(if
(>= pos len-src)
(error "Unterminated map")
(if (= (nth source pos) "}")
(do (set! pos (inc pos)) nil) ;; done
(let ((key-expr (read-expr))
(key-str (if (= (type-of key-expr) "keyword")
(keyword-name key-expr)
(str key-expr)))
(val-expr (read-expr)))
(if
(= (nth source pos) "}")
(do (set! pos (inc pos)) nil)
(let
((key-expr (read-expr))
(key-str
(if
(= (type-of key-expr) "keyword")
(keyword-name key-expr)
(str key-expr)))
(val-expr (read-expr)))
(dict-set! result key-str val-expr)
(read-map-loop))))))
(read-map-loop)
result)))
;; -- Raw string reader (for #|...|) --
(define read-raw-string :effects []
(fn ()
(let ((buf ""))
(define raw-loop :effects []
(fn ()
(if (>= pos len-src)
(define
read-raw-string
:effects ()
(fn
()
(let
((buf ""))
(define
raw-loop
:effects ()
(fn
()
(if
(>= pos len-src)
(error "Unterminated raw string")
(let ((ch (nth source pos)))
(if (= ch "|")
(do (set! pos (inc pos)) nil) ;; done
(do (set! buf (str buf ch))
(set! pos (inc pos))
(raw-loop)))))))
(let
((ch (nth source pos)))
(if
(= ch "|")
(do (set! pos (inc pos)) nil)
(do
(set! buf (str buf ch))
(set! pos (inc pos))
(raw-loop)))))))
(raw-loop)
buf)))
;; -- Main expression reader --
(define read-expr :effects []
(fn ()
(define
read-char-literal
:effects ()
(fn
()
(if
(>= pos len-src)
(error "Unexpected end of input after #\\")
(let
((first-ch (nth source pos)))
(if
(ident-start? first-ch)
(let
((char-start pos))
(define
read-char-name-loop
:effects ()
(fn
()
(when
(and (< pos len-src) (ident-char? (nth source pos)))
(set! pos (inc pos))
(read-char-name-loop))))
(read-char-name-loop)
(let
((char-name (slice source char-start pos)))
(make-char
(cond
(= char-name "space")
32
(= char-name "newline")
10
(= char-name "tab")
9
(= char-name "nul")
0
(= char-name "null")
0
(= char-name "return")
13
(= char-name "escape")
27
(= char-name "delete")
127
(= char-name "backspace")
8
(= char-name "altmode")
27
(= char-name "rubout")
127
:else (char-code first-ch)))))
(do (set! pos (inc pos)) (make-char (char-code first-ch))))))))
(define
read-expr
:effects ()
(fn
()
(skip-ws)
(if (>= pos len-src)
(if
(>= pos len-src)
(error "Unexpected end of input")
(let ((ch (nth source pos)))
(let
((ch (nth source pos)))
(cond
;; Lists
(= ch "(")
(do (set! pos (inc pos)) (read-list ")"))
(do (set! pos (inc pos)) (read-list ")"))
(= ch "[")
(do (set! pos (inc pos)) (read-list "]"))
;; Map
(do (set! pos (inc pos)) (read-list "]"))
(= ch "{")
(do (set! pos (inc pos)) (read-map))
;; String
(do (set! pos (inc pos)) (read-map))
(= ch "\"")
(read-string)
;; Keyword
(read-string)
(= ch ":")
(read-keyword)
;; Quote sugar
(read-keyword)
(= ch "'")
(do (set! pos (inc pos))
(list (make-symbol "quote") (read-expr)))
;; Quasiquote sugar
(do
(set! pos (inc pos))
(list (make-symbol "quote") (read-expr)))
(= ch "`")
(do (set! pos (inc pos))
(list (make-symbol "quasiquote") (read-expr)))
;; Unquote / splice-unquote
(do
(set! pos (inc pos))
(list (make-symbol "quasiquote") (read-expr)))
(= ch ",")
(do (set! pos (inc pos))
(if (and (< pos len-src) (= (nth source pos) "@"))
(do (set! pos (inc pos))
(list (make-symbol "splice-unquote") (read-expr)))
(list (make-symbol "unquote") (read-expr))))
;; Reader macros: #
(do
(set! pos (inc pos))
(if
(and (< pos len-src) (= (nth source pos) "@"))
(do
(set! pos (inc pos))
(list (make-symbol "splice-unquote") (read-expr)))
(list (make-symbol "unquote") (read-expr))))
(= ch "#")
(do (set! pos (inc pos))
(if (>= pos len-src)
(error "Unexpected end of input after #")
(let ((dispatch-ch (nth source pos)))
(cond
;; #; — datum comment: read and discard next expr
(= dispatch-ch ";")
(do (set! pos (inc pos))
(read-expr) ;; read and discard
(read-expr)) ;; return the NEXT expr
;; #| — raw string
(= dispatch-ch "|")
(do (set! pos (inc pos))
(read-raw-string))
;; #' — quote shorthand
(= dispatch-ch "'")
(do (set! pos (inc pos))
(list (make-symbol "quote") (read-expr)))
;; #name — extensible dispatch
(ident-start? dispatch-ch)
(let ((macro-name (read-ident)))
(let ((handler (reader-macro-get macro-name)))
(if handler
(handler (read-expr))
(error (str "Unknown reader macro: #" macro-name)))))
:else
(error (str "Unknown reader macro: #" dispatch-ch))))))
;; Number (or negative number)
(or (and (>= ch "0") (<= ch "9"))
(and (= ch "-")
(< (inc pos) len-src)
(let ((next-ch (nth source (inc pos))))
(and (>= next-ch "0") (<= next-ch "9")))))
(read-number)
;; Ellipsis (... as a symbol)
(and (= ch ".")
(< (+ pos 2) len-src)
(= (nth source (+ pos 1)) ".")
(= (nth source (+ pos 2)) "."))
(do (set! pos (+ pos 3))
(make-symbol "..."))
;; Symbol (must be ident-start char)
(do
(set! pos (inc pos))
(if
(>= pos len-src)
(error "Unexpected end of input after #")
(let
((dispatch-ch (nth source pos)))
(cond
(= dispatch-ch ";")
(do (set! pos (inc pos)) (read-expr) (read-expr))
(= dispatch-ch "|")
(do (set! pos (inc pos)) (read-raw-string))
(= dispatch-ch "'")
(do
(set! pos (inc pos))
(list (make-symbol "quote") (read-expr)))
(= dispatch-ch "\\")
(do (set! pos (inc pos)) (read-char-literal))
(ident-start? dispatch-ch)
(let
((macro-name (read-ident)))
(let
((handler (reader-macro-get macro-name)))
(if
handler
(handler (read-expr))
(error
(str "Unknown reader macro: #" macro-name)))))
:else (error (str "Unknown reader macro: #" dispatch-ch))))))
(or
(and (>= ch "0") (<= ch "9"))
(and
(= ch "-")
(< (inc pos) len-src)
(let
((next-ch (nth source (inc pos))))
(and (>= next-ch "0") (<= next-ch "9")))))
(read-number)
(and
(= ch ".")
(< (+ pos 2) len-src)
(= (nth source (+ pos 1)) ".")
(= (nth source (+ pos 2)) "."))
(do (set! pos (+ pos 3)) (make-symbol "..."))
(ident-start? ch)
(read-symbol)
;; Unexpected
:else
(error (str "Unexpected character: " ch)))))))
;; -- Entry point: parse all top-level expressions --
(let ((exprs (list)))
(define parse-loop :effects []
(fn ()
(read-symbol)
:else (error (str "Unexpected character: " ch)))))))
(let
((exprs (list)))
(define
parse-loop
:effects ()
(fn
()
(skip-ws)
(when (< pos len-src)
(append! exprs (read-expr))
(parse-loop))))
(when (< pos len-src) (append! exprs (read-expr)) (parse-loop))))
(parse-loop)
exprs))))
@@ -362,30 +477,75 @@
;; --------------------------------------------------------------------------
;; Serialize AST value back to SX source
(define sx-serialize :effects []
(fn (val)
(case (type-of val)
"nil" "nil"
"boolean" (if val "true" "false")
"number" (str val)
"string" (str "\"" (escape-string val) "\"")
"symbol" (symbol-name val)
"keyword" (str ":" (keyword-name val))
"list" (str "(" (join " " (map sx-serialize val)) ")")
"dict" (sx-serialize-dict val)
"sx-expr" (sx-expr-source val)
"spread" (str "(make-spread " (sx-serialize-dict (spread-attrs val)) ")")
:else (str val))))
(define
sx-serialize
:effects ()
(fn
(val)
(case
(type-of val)
"nil"
"nil"
"boolean"
(if val "true" "false")
"number"
(str val)
"string"
(str "\"" (escape-string val) "\"")
"symbol"
(symbol-name val)
"keyword"
(str ":" (keyword-name val))
"list"
(str "(" (join " " (map sx-serialize val)) ")")
"dict"
(sx-serialize-dict val)
"sx-expr"
(sx-expr-source val)
"spread"
(str "(make-spread " (sx-serialize-dict (spread-attrs val)) ")")
"char"
(let
((n (char->integer val)))
(str
"#\\"
(cond
(= n 32)
"space"
(= n 10)
"newline"
(= n 9)
"tab"
(= n 13)
"return"
(= n 0)
"nul"
(= n 27)
"escape"
(= n 127)
"delete"
(= n 8)
"backspace"
:else (char-from-code n))))
:else (str val))))
;; Serialize a dict to SX {:key val} format
(define sx-serialize-dict :effects []
(fn ((d :as dict))
(str "{"
(join " "
(define
sx-serialize-dict
:effects ()
(fn
((d :as dict))
(str
"{"
(join
" "
(reduce
(fn ((acc :as list) (key :as string))
(concat acc (list (str ":" key) (sx-serialize (dict-get d key)))))
(fn
((acc :as list) (key :as string))
(concat
acc
(list (str ":" key) (sx-serialize (dict-get d key)))))
(list)
(keys d)))
"}")))
@@ -410,10 +570,14 @@
;; (make-symbol name) → Symbol value
;; (make-keyword name) → Keyword value
;; (parse-number s) → number (int or float from string)
;; (make-char n) → Char value from Unicode codepoint n
;; (char->integer c) → Unicode codepoint of char c
;;
;; String utilities:
;; (escape-string s) → string with " and \ escaped
;; (sx-expr-source e) → unwrap SxExpr to its source string
;; (char-from-code n) → single-char string from codepoint n
;; (char-code s) → codepoint of first char in string s
;;
;; Reader macro registry:
;; (reader-macro-get name) → handler fn or nil

34
spec/primitives.sx
View File

@@ -492,6 +492,12 @@
:returns "string"
:doc "Convert Unicode code point to single-character string.")
(define-primitive
"char-code"
:params ((s :as string))
:returns "number"
:doc "Unicode codepoint of the first character of string s.")
(define-primitive
"substring"
:params ((s :as string) (start :as number) (end :as number))
@@ -546,15 +552,15 @@
:returns "boolean"
:doc "True if string s starts with prefix.")
;; --------------------------------------------------------------------------
;; Core — Dict operations
;; --------------------------------------------------------------------------
(define-primitive
"ends-with?"
:params ((s :as string) (suffix :as string))
:returns "boolean"
:doc "True if string s ends with suffix.")
;; --------------------------------------------------------------------------
;; Core — Dict operations
;; --------------------------------------------------------------------------
(define-module :core.collections)
(define-primitive
@@ -599,15 +605,15 @@
:returns "any"
:doc "Last element, or nil if empty.")
;; --------------------------------------------------------------------------
;; Stdlib — Format
;; --------------------------------------------------------------------------
(define-primitive
"rest"
:params ((coll :as list))
:returns "list"
:doc "All elements except the first.")
;; --------------------------------------------------------------------------
;; Stdlib — Format
;; --------------------------------------------------------------------------
(define-primitive
"nth"
:params ((coll :as list) (n :as number))
@@ -632,15 +638,15 @@
:returns "list"
:doc "Mutate coll by appending x in-place. Returns coll.")
;; --------------------------------------------------------------------------
;; Stdlib — Text
;; --------------------------------------------------------------------------
(define-primitive
"reverse"
:params ((coll :as list))
:returns "list"
:doc "Return coll in reverse order.")
;; --------------------------------------------------------------------------
;; Stdlib — Text
;; --------------------------------------------------------------------------
(define-primitive
"flatten"
:params ((coll :as list))
@@ -659,29 +665,29 @@
:returns "list"
:doc "Consecutive pairs: (1 2 3 4) → ((1 2) (2 3) (3 4)).")
(define-module :core.dict)
;; --------------------------------------------------------------------------
;; Stdlib — Style
;; --------------------------------------------------------------------------
;; --------------------------------------------------------------------------
;; Stdlib — Debug
;; --------------------------------------------------------------------------
(define-module :core.dict)
(define-primitive
"keys"
:params ((d :as dict))
:returns "list"
:doc "List of dict keys.")
;; --------------------------------------------------------------------------
;; Type introspection — platform primitives
;; --------------------------------------------------------------------------
(define-primitive
"vals"
:params ((d :as dict))
:returns "list"
:doc "List of dict values.")
;; --------------------------------------------------------------------------
;; Type introspection — platform primitives
;; --------------------------------------------------------------------------
(define-primitive
"merge"
:params (&rest (dicts :as dict))

185
spec/tests/test-chars.sx Normal file
View File

@@ -0,0 +1,185 @@
;; Tests for character type (Phase 13)
;; Uses (make-char n) and (char-code "x") instead of #\x literals
;; (char literal parser syntax tested via sx-parse call)
(deftest
"make-char produces a char"
(assert= true (char? (make-char 97))))
(deftest "char? false for string" (assert= false (char? "a")))
(deftest "char? false for number" (assert= false (char? 65)))
(deftest "char? false for nil" (assert= false (char? nil)))
(deftest
"char->integer extracts codepoint"
(assert= 97 (char->integer (make-char 97))))
(deftest
"integer->char alias for make-char"
(assert= 65 (char->integer (integer->char 65))))
(deftest
"char->integer round-trip"
(assert= 122 (char->integer (make-char 122))))
(deftest
"char=? equal"
(assert= true (char=? (make-char 97) (make-char 97))))
(deftest
"char=? unequal"
(assert= false (char=? (make-char 97) (make-char 98))))
(deftest
"char<? ordering"
(assert= true (char<? (make-char 97) (make-char 98))))
(deftest
"char>? ordering"
(assert= true (char>? (make-char 98) (make-char 97))))
(deftest
"char<=? equal"
(assert= true (char<=? (make-char 65) (make-char 65))))
(deftest
"char>=? greater"
(assert= true (char>=? (make-char 90) (make-char 65))))
(deftest
"char-ci=? ignores case (a vs A)"
(assert= true (char-ci=? (make-char 97) (make-char 65))))
(deftest
"char-ci<? a < b case-insensitive"
(assert= true (char-ci<? (make-char 97) (make-char 98))))
(deftest
"char-ci>? b > a case-insensitive"
(assert= true (char-ci>? (make-char 66) (make-char 65))))
(deftest
"char-alphabetic? true for a"
(assert= true (char-alphabetic? (make-char 97))))
(deftest
"char-alphabetic? true for Z"
(assert= true (char-alphabetic? (make-char 90))))
(deftest
"char-alphabetic? false for digit"
(assert= false (char-alphabetic? (make-char 48))))
(deftest
"char-numeric? true for 0"
(assert= true (char-numeric? (make-char 48))))
(deftest
"char-numeric? true for 9"
(assert= true (char-numeric? (make-char 57))))
(deftest
"char-numeric? false for letter"
(assert= false (char-numeric? (make-char 65))))
(deftest
"char-whitespace? true for space"
(assert= true (char-whitespace? (make-char 32))))
(deftest
"char-whitespace? true for newline"
(assert= true (char-whitespace? (make-char 10))))
(deftest
"char-whitespace? false for letter"
(assert= false (char-whitespace? (make-char 65))))
(deftest
"char-upper-case? true for A"
(assert= true (char-upper-case? (make-char 65))))
(deftest
"char-upper-case? false for a"
(assert= false (char-upper-case? (make-char 97))))
(deftest
"char-lower-case? true for a"
(assert= true (char-lower-case? (make-char 97))))
(deftest
"char-lower-case? false for A"
(assert= false (char-lower-case? (make-char 65))))
(deftest
"char-upcase converts a to A"
(assert= 65 (char->integer (char-upcase (make-char 97)))))
(deftest
"char-downcase converts A to a"
(assert=
97
(char->integer (char-downcase (make-char 65)))))
(deftest
"char-upcase idempotent on uppercase"
(assert= 65 (char->integer (char-upcase (make-char 65)))))
(deftest
"string->list returns list of chars"
(assert= 3 (len (string->list "abc"))))
(deftest
"string->list element 0 is char"
(assert= true (char? (get (string->list "abc") 0))))
(deftest
"string->list codepoints correct"
(assert= 97 (char->integer (get (string->list "abc") 0))))
(deftest
"list->string from chars produces string"
(assert=
"abc"
(list->string
(list
(make-char 97)
(make-char 98)
(make-char 99)))))
(deftest
"string->list list->string round-trip"
(let ((s "hello")) (assert= s (list->string (string->list s)))))
(deftest
"char literal parsed via sx-parse"
(let
((ast (sx-parse "#\\a")))
(assert= true (char? (get ast 0)))))
(deftest
"char literal codepoint via sx-parse"
(let
((ast (sx-parse "#\\a")))
(assert= 97 (char->integer (get ast 0)))))
(deftest
"named char space via sx-parse"
(let
((ast (sx-parse "#\\space")))
(assert= 32 (char->integer (get ast 0)))))
(deftest
"named char newline via sx-parse"
(let
((ast (sx-parse "#\\newline")))
(assert= 10 (char->integer (get ast 0)))))
(deftest
"char-ci<=? equal case-insensitive"
(assert= true (char-ci<=? (make-char 65) (make-char 97))))
(deftest
"char-ci>=? equal case-insensitive"
(assert= true (char-ci>=? (make-char 97) (make-char 65))))