ocaml: character type — Char of int, #\a parser, all char primitives
- Char of int variant in sx_types.ml (Unicode codepoint) - type_of → "char", inspect → #\a / #\space / #\newline notation - #\ char literal reader in sx_parser.ml (named + single-char) - make-char 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 Char values) and list->string (accepts Char values) - fix get_val in sx_runtime.ml: add Integer n case for list indexing - fix raw_serialize in sx_server.ml: Integer and Char variants - 4493/4493 tests — +43 passing, zero regressions Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -2225,4 +2225,80 @@ let () =
|
||||
register "symbol-interned?" (fun args ->
|
||||
match args with
|
||||
| [Symbol _] -> Bool true
|
||||
| _ -> raise (Eval_error "symbol-interned?: expected 1 symbol"))
|
||||
| _ -> raise (Eval_error "symbol-interned?: expected 1 symbol"));
|
||||
(* Phase 13: character type *)
|
||||
let char_downcase_cp n =
|
||||
if n >= 65 && n <= 90 then n + 32 else n in
|
||||
let char_upcase_cp n =
|
||||
if n >= 97 && n <= 122 then n - 32 else n in
|
||||
register "make-char" (fun args ->
|
||||
match args with
|
||||
| [Integer n] -> Char n
|
||||
| _ -> raise (Eval_error "make-char: expected integer codepoint"));
|
||||
register "char?" (fun args ->
|
||||
match args with
|
||||
| [Char _] -> Bool true | [_] -> Bool false
|
||||
| _ -> raise (Eval_error "char?: expected 1 argument"));
|
||||
register "char->integer" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Integer n
|
||||
| _ -> raise (Eval_error "char->integer: expected char"));
|
||||
register "integer->char" (fun args ->
|
||||
match args with
|
||||
| [Integer n] -> Char n
|
||||
| _ -> raise (Eval_error "integer->char: expected integer"));
|
||||
register "char-upcase" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Char (char_upcase_cp n)
|
||||
| _ -> raise (Eval_error "char-upcase: expected char"));
|
||||
register "char-downcase" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Char (char_downcase_cp n)
|
||||
| _ -> raise (Eval_error "char-downcase: expected char"));
|
||||
register "char=?" (fun args -> match args with [Char a; Char b] -> Bool (a = b) | _ -> raise (Eval_error "char=?: expected 2 chars"));
|
||||
register "char<?" (fun args -> match args with [Char a; Char b] -> Bool (a < b) | _ -> raise (Eval_error "char<?: expected 2 chars"));
|
||||
register "char>?" (fun args -> match args with [Char a; Char b] -> Bool (a > b) | _ -> raise (Eval_error "char>?: expected 2 chars"));
|
||||
register "char<=?" (fun args -> match args with [Char a; Char b] -> Bool (a <= b) | _ -> raise (Eval_error "char<=?: expected 2 chars"));
|
||||
register "char>=?" (fun args -> match args with [Char a; Char b] -> Bool (a >= b) | _ -> raise (Eval_error "char>=?: expected 2 chars"));
|
||||
register "char-ci=?" (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a = char_downcase_cp b) | _ -> raise (Eval_error "char-ci=?: expected 2 chars"));
|
||||
register "char-ci<?" (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a < char_downcase_cp b) | _ -> raise (Eval_error "char-ci<?: expected 2 chars"));
|
||||
register "char-ci>?" (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a > char_downcase_cp b) | _ -> raise (Eval_error "char-ci>?: expected 2 chars"));
|
||||
register "char-ci<=?" (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a <= char_downcase_cp b) | _ -> raise (Eval_error "char-ci<=?: expected 2 chars"));
|
||||
register "char-ci>=?" (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a >= char_downcase_cp b) | _ -> raise (Eval_error "char-ci>=?: expected 2 chars"));
|
||||
register "char-alphabetic?" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Bool ((n >= 65 && n <= 90) || (n >= 97 && n <= 122))
|
||||
| _ -> raise (Eval_error "char-alphabetic?: expected char"));
|
||||
register "char-numeric?" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Bool (n >= 48 && n <= 57)
|
||||
| _ -> raise (Eval_error "char-numeric?: expected char"));
|
||||
register "char-whitespace?" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Bool (n = 32 || n = 9 || n = 10 || n = 13)
|
||||
| _ -> raise (Eval_error "char-whitespace?: expected char"));
|
||||
register "char-upper-case?" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Bool (n >= 65 && n <= 90)
|
||||
| _ -> raise (Eval_error "char-upper-case?: expected char"));
|
||||
register "char-lower-case?" (fun args ->
|
||||
match args with
|
||||
| [Char n] -> Bool (n >= 97 && n <= 122)
|
||||
| _ -> raise (Eval_error "char-lower-case?: expected char"));
|
||||
register "string->list" (fun args ->
|
||||
match args with
|
||||
| [String s] ->
|
||||
let chars = ref [] in
|
||||
String.iter (fun c -> chars := Char (Char.code c) :: !chars) s;
|
||||
List (List.rev !chars)
|
||||
| _ -> raise (Eval_error "string->list: expected string"));
|
||||
register "list->string" (fun args ->
|
||||
match args with
|
||||
| [List chars] | [ListRef { contents = chars }] ->
|
||||
let buf = Buffer.create (List.length chars) in
|
||||
List.iter (function
|
||||
| Char n -> Buffer.add_char buf (Char.chr (n land 0xFF))
|
||||
| v -> raise (Eval_error ("list->string: expected char, got " ^ type_of v))
|
||||
) chars;
|
||||
String (Buffer.contents buf)
|
||||
| _ -> raise (Eval_error "list->string: expected list of chars"))
|
||||
|
||||
Reference in New Issue
Block a user