Master is merged into the when, get and if let lane, and dyn get over text counts characters through at's own body.
This commit is contained in:
commit
b545584de8
16
TODO.org
16
TODO.org
@ -31,10 +31,18 @@ last form is not kept. =get= over dyn text or vec is nil when out of range; =.fi
|
||||
Decided 2026-09-25: the typed read-only text is =str= (the rename from =string= is
|
||||
done; =string= is refused with the fix); =String= is new, owned, growable, always valid UTF-8, through an allocator. The prelude's text
|
||||
builders return =String=; =(Vec u8)= stays for raw bytes. Text is UTF-8 everywhere and
|
||||
a character is a code point; dyn gets a character tag, so \\I prints as \\I.
|
||||
Dyn text stays immutable, with chars and text converting to and from a dyn
|
||||
vector of characters; length and indexing count characters on dyn text and bytes on
|
||||
str. Waits on the dyn-unless-annotated design.
|
||||
a character is a code point; length and indexing count bytes on str. Waits on the
|
||||
dyn-unless-annotated design.
|
||||
|
||||
** DONE Dyn has a char, and dyn text counts characters
|
||||
CLOSED: [2026-09-26]
|
||||
Only a char literal, =at= on a text and =chars= make one, and it prints as its
|
||||
literal, bare too, a control character as \\uXXXX. Into any integer width it gives its
|
||||
code point where that fits, into a byte only when ASCII; a dyn int into any width is
|
||||
range-checked, while a cast on either wraps as a typed cast does. length, at and slice
|
||||
on dyn text count code points, a malformed byte counting as one U+FFFD. A non-ASCII
|
||||
literal defaults to i32 and is refused where a byte is wanted. Rules out char
|
||||
arithmetic, a typed code point turning into a char, and byte offsets on dyn text.
|
||||
|
||||
** DONE String is a prelude struct over (Vec u8), kept valid by the checker
|
||||
CLOSED: [2026-09-26]
|
||||
|
||||
@ -165,6 +165,10 @@ reply without a daemon behind them, and so that this file names
|
||||
(defun flan-inspect--read-atom (s i)
|
||||
"Read a bare token at I: a number, a keyword, `true', `none', `...'."
|
||||
(let ((start i))
|
||||
;; A char, \x: the character after the backslash is taken whatever it
|
||||
;; is, so \) and \] do not close the sequence they sit in.
|
||||
(when (and (eq (aref s i) ?\\) (< (1+ i) (length s)))
|
||||
(setq i (+ i 2)))
|
||||
(while (and (< i (length s))
|
||||
(not (memq (aref s i) '(?\s ?\n ?\t ?\) ?\] ?\}))))
|
||||
(setq i (1+ i)))
|
||||
|
||||
@ -98,6 +98,14 @@
|
||||
(test-flan--check "indexed from zero"
|
||||
(equal (mapcar #'car (plist-get n :children)) '(0 1 2))))
|
||||
|
||||
;; A dyn vec of chars, as runtime/flan_dyn.c's [char_spell] writes one: \)
|
||||
;; and \] are chars, not closers.
|
||||
(let ((n (flan-inspect-parse "[\\a \\) \\] \\日 \\space]")))
|
||||
(test-flan--check "a char is one element, whatever follows the backslash"
|
||||
(equal (mapcar (lambda (k) (plist-get (cdr k) :text))
|
||||
(plist-get n :children))
|
||||
'("\\a" "\\)" "\\]" "\\日" "\\space"))))
|
||||
|
||||
;; [[0 0] [1 ...] ...] — span truncation at both levels, which is what
|
||||
;; sand's [100 [100 u32]] actually produces.
|
||||
(let* ((n (flan-inspect-parse "[[0 0] [1 ...] ...]"))
|
||||
|
||||
110
lib/check.ml
110
lib/check.ml
@ -4488,34 +4488,34 @@ let mismatch_found : Types.t Found.t = Found.create 16
|
||||
let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr =
|
||||
let need sym ty = rt loc ty sym [ e ] in
|
||||
match want with
|
||||
| Types.Int Types.I64 -> need "flan_dyn_need_i64" dyn_i64
|
||||
| Types.Float Types.F64 -> need "flan_dyn_need_f64" dyn_f64
|
||||
| Types.Bool ->
|
||||
(* The ABI answers an [int32_t]; [bool] is an [i1]. The narrowing is the
|
||||
language's own cast and cannot fail — the runtime already decided the
|
||||
value was a bool, so what comes back is 0 or 1. *)
|
||||
widen loc Types.Bool (need "flan_dyn_need_bool" (Types.Int Types.I32))
|
||||
(* Every other width is refused rather than served by a need_i64 and a
|
||||
truncation. Narrowing is written or it does not happen — that survives
|
||||
widening becoming implicit (TODO.org, "Implicit numeric widening is
|
||||
legal; narrowing stays a hard error") untouched, and this is the
|
||||
boundary where it matters most: the value's type was *already* uncertain
|
||||
here, so an annotation that quietly discarded the high bits would read as
|
||||
a check and be the opposite of one.
|
||||
|
||||
Nor does widening reach this arm from the other side. The box carries one
|
||||
integer width and one float width, so there is no narrower source here to
|
||||
widen from — a u32 want is asking the i64 in the box to fit in half of
|
||||
itself, which is the refusal above and not a conversion the lattice has.
|
||||
The ABI grows a per-width entry point when there is a reason to; until
|
||||
then the spelling that works is an i64 and a written conversion after
|
||||
it. *)
|
||||
| Types.Int _ | Types.Float _ ->
|
||||
no_dyn_yet loc ~into:false want
|
||||
(Printf.sprintf
|
||||
" — take it as %s and convert"
|
||||
(if Types.is_numeric want && (match want with Types.Float _ -> true | _ -> false)
|
||||
then "f64" else "i64"))
|
||||
(* Any integer width, checked at run time at this site (TODO.org, "Dyn
|
||||
unless annotated"): an int in the width's range, or a char's code point
|
||||
where it fits — ASCII only into a byte, since a byte past ASCII is not
|
||||
that char in UTF-8. The runtime answers an i64 it has already checked,
|
||||
so the narrowing after it cannot lose a bit. *)
|
||||
| Types.Int k ->
|
||||
let code =
|
||||
match k with
|
||||
| Types.I8 -> 0L | Types.U8 -> 1L | Types.I16 -> 2L | Types.U16 -> 3L
|
||||
| Types.I32 -> 4L | Types.U32 -> 5L | Types.I64 -> 6L | Types.U64 -> 7L
|
||||
in
|
||||
let n =
|
||||
rt loc dyn_i64 "flan_dyn_need_int"
|
||||
[ e; mk loc (Types.Int Types.I32) (Tast.Int (code, Types.I32)); here loc ]
|
||||
in
|
||||
if k = Types.I64 then n else mk loc want (Tast.Prim (Tast.Cast want, [ n ]))
|
||||
(* An f32 is refused rather than served by a need_f64 and a rounding: the
|
||||
box carries one float width, and narrowing is written or it does not
|
||||
happen (TODO.org, "Implicit numeric widening is legal; narrowing stays a
|
||||
hard error"). *)
|
||||
| Types.Float _ ->
|
||||
no_dyn_yet loc ~into:false want " — take it as f64 and convert"
|
||||
| _ -> no_dyn_yet loc ~into:false want ""
|
||||
|
||||
(* A dyn where a str, a slice, a fixed array or a struct was written:
|
||||
@ -4624,7 +4624,7 @@ let cast_dyn ctx loc (target : Types.t) (got : Tast.expr) : Tast.expr =
|
||||
[ mk loc target
|
||||
(Tast.If (is_float,
|
||||
arm "flan_dyn_need_f64" dyn_f64,
|
||||
arm "flan_dyn_need_i64" dyn_i64)) ]))
|
||||
arm "flan_dyn_int_of" dyn_i64)) ]))
|
||||
|
||||
(* nil is written [nil] and nothing else produces it, so this is the whole of
|
||||
"the checker can see a nil reaching here" — a name, not a dataflow fact.
|
||||
@ -6055,8 +6055,39 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr =
|
||||
n (tyname loc t) gname var (Int64.neg n) n
|
||||
| Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n
|
||||
| Ast.UInt (n, s) -> wide_literal loc ~want n s
|
||||
(* A char literal that ends up dyn is a dyn char, never an int; a typed code
|
||||
point that crosses later is an int, because only the literal says char. *)
|
||||
| Ast.Byte b when want = Some Types.Dyn ->
|
||||
rt loc Types.Dyn "flan_dyn_from_char"
|
||||
[ mk loc (Types.Int Types.I32) (Tast.Int (Int64.of_int b, Types.I32)) ]
|
||||
(* A char literal is a code point, and a byte type holds one only when it
|
||||
is ASCII: \é as a u8 would be 0xE9, which is not é in UTF-8 and never
|
||||
equals a byte of it. Refused by the char's name, not its number. *)
|
||||
| Ast.Byte b
|
||||
when (match want with
|
||||
| Some (Types.Int (Types.U8 | Types.I8)) -> b > 127
|
||||
| Some (Types.Int Types.I16) -> b > 32767
|
||||
| Some (Types.Int Types.U16) -> b > 65535
|
||||
| _ -> false) ->
|
||||
let t = tyname loc (Option.get want) in
|
||||
let c = Form.byte_repr b in
|
||||
if (match want with
|
||||
| Some (Types.Int (Types.U8 | Types.I8)) -> true
|
||||
| _ -> false)
|
||||
then
|
||||
Loc.failk literal_at_want loc
|
||||
"%s is %d bytes in UTF-8, not one, so it is not a %s. Write the str \
|
||||
\"%s\" for its bytes, or take its code point as an i32"
|
||||
c (String.length (Form.utf8 b)) t (Form.utf8 b)
|
||||
else
|
||||
Loc.failk literal_at_want loc
|
||||
"%s is code point %d, which does not fit in a %s. Take its code point \
|
||||
as an i32" c b t
|
||||
(* A non-ASCII literal is a code point, which a u8 cannot hold as itself:
|
||||
its default is the prelude's rune, an i32. *)
|
||||
| Ast.Byte b ->
|
||||
int_literal loc ~want ~preds:ctx.env.tvpreds ~default:Types.U8
|
||||
int_literal loc ~want ~preds:ctx.env.tvpreds
|
||||
~default:(if b > 127 then Types.I32 else Types.U8)
|
||||
(Int64.of_int b)
|
||||
(* The float literal's own dyn case, for the reason the integer's has one:
|
||||
the ABI carries one width and the literal is built at it. f64 is already
|
||||
@ -8756,6 +8787,7 @@ and generic_ctor ctx ~want loc name given =
|
||||
match a.Ast.e with
|
||||
| Ast.Float _ -> Types.Float (float_default ())
|
||||
| Ast.UInt _ -> Types.Int Types.U64
|
||||
| Ast.Byte b when b > 127 -> Types.Int Types.I32
|
||||
| Ast.Byte _ -> Types.Int Types.U8
|
||||
| _ -> Types.Int Types.I32
|
||||
in
|
||||
@ -9793,8 +9825,7 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?want loc
|
||||
if p >= 17 || float_of_string t = x then t else go (p + 1)
|
||||
in
|
||||
go 1
|
||||
| Ast.Byte b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
|
||||
| Ast.Byte b -> string_of_int b
|
||||
| Ast.Byte b -> Form.byte_repr b
|
||||
| Ast.Str t -> Printf.sprintf "%S" t
|
||||
| Ast.Kw k -> ":" ^ k
|
||||
| Ast.Var b -> b
|
||||
@ -13774,6 +13805,15 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
(rt loc Types.Dyn "flan_dyn_type_of" [ check ctx ~want:Types.Dyn v ])
|
||||
| _ -> assert false)
|
||||
|
||||
(* (chars t) and (text x): a dyn text as a vec of its chars, and back. A
|
||||
dyn text is immutable, so a vec of chars is how one is edited. *)
|
||||
| "chars" | "text" ->
|
||||
arity ctx loc name 1 args;
|
||||
let sym = if name = "chars" then "flan_dyn_chars" else "flan_dyn_text" in
|
||||
expect ctx loc ~want
|
||||
(rt loc Types.Dyn sym
|
||||
[ check ctx ~want:Types.Dyn (List.hd args); here loc ])
|
||||
|
||||
(* (map-remove m k) -> (Option V): the value that was there, or None when
|
||||
the key was not. The same answer [get] gives, for the same reason — a key
|
||||
that is not in the map is an answer and not a failure — and the value
|
||||
@ -14983,7 +15023,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
at the target instead, so (u64 2935910691) and (i64 5000000000) are the
|
||||
constants they say. One that fits i32 keeps the default and the cast,
|
||||
which is what (u32 -1) has always meant. *)
|
||||
let want =
|
||||
let operand_want =
|
||||
match (List.hd args).Ast.e, target with
|
||||
| Ast.Int n, (Types.Int _ | Types.Float _)
|
||||
when Int64.compare n (-2147483648L) < 0
|
||||
@ -14996,7 +15036,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
Some (Types.Float Types.F64)
|
||||
| _ -> None
|
||||
in
|
||||
let a = check ctx ?want (List.hd args) in
|
||||
let a = check ctx ?want:operand_want (List.hd args) in
|
||||
(match a.Tast.ty with
|
||||
| Types.Enum _ -> ()
|
||||
(* A dyn opens here — [cast_dyn], TODO.org, "A numeric cast opens a dyn
|
||||
@ -15014,7 +15054,7 @@ and named_call ?(qualified = false) ctx ~want loc name args =
|
||||
~what:"a number or an enum" ~is:"a number" v
|
||||
| t -> fail loc "%s converts a number, found %s" name (tyname loc t));
|
||||
(match a.Tast.ty with
|
||||
| Types.Dyn -> cast_dyn ctx loc target a
|
||||
| Types.Dyn -> expect ctx loc ~want (cast_dyn ctx loc target a)
|
||||
| _ -> prim (Tast.Cast target) target [ a ])
|
||||
|
||||
(* ── ordinary calls ────────────────────────────────────────────── *)
|
||||
@ -16515,9 +16555,15 @@ let builtins : (string * string * string) list =
|
||||
is the same generic function written the other way.");
|
||||
("type-of", "type-of [dyn] dyn",
|
||||
"The value's kind as a keyword — :nil :bool :int :float :text :vec \
|
||||
:keyword :map — or, for a value built by a defclass constructor, the \
|
||||
:keyword :map :char — or, for a value built by a defclass constructor, the \
|
||||
class's name as class-of answers it. A typed value answers the kind it \
|
||||
has as a dyn value: an i32 is :int.");
|
||||
("chars", "chars [dyn] dyn",
|
||||
"A dyn text's characters, as a new dyn vector of chars. A dyn text \
|
||||
counts characters, not bytes, in length, at and slice.");
|
||||
("text", "text [dyn] dyn",
|
||||
"The dyn text a dyn vector of chars, or a single char, spells: \
|
||||
(text (chars t)) is t.");
|
||||
("keyword", "keyword [str|[const u8]] dyn",
|
||||
"The interned dyn keyword named by the bytes, for a name that only \
|
||||
exists at run time — a reader building :texture-path out of a token's \
|
||||
@ -16560,8 +16606,8 @@ let builtins : (string * string * string) list =
|
||||
(* containers *)
|
||||
("length", "length [[n T]|[T]|str|String|(Vec T)|(Map K V)] i32",
|
||||
"How many elements. One question and one word across an array, a slice, \
|
||||
a string, a Vec and a Map. A str and a String count bytes; rune-count \
|
||||
counts characters.");
|
||||
a string, a Vec and a Map. A str and a String count bytes, as rune-count \
|
||||
does not; a dyn text counts characters.");
|
||||
("at", "at [collection i32 ...] T",
|
||||
"The element at an index, bounds-checked — and for a Vec with the \
|
||||
allocator's epoch checked first. On a string it is the byte, a u8. It \
|
||||
|
||||
@ -5056,6 +5056,9 @@ declare i64 @flan_dyn_from_i64(i64)
|
||||
declare i64 @flan_dyn_from_f64(double)
|
||||
declare i64 @flan_dyn_from_bool(i32)
|
||||
declare i64 @flan_dyn_from_bytes(ptr, i64)
|
||||
declare i64 @flan_dyn_from_char(i32)
|
||||
declare i64 @flan_dyn_chars(i64, ptr, i64)
|
||||
declare i64 @flan_dyn_text(i64, ptr, i64)
|
||||
declare i64 @flan_dyn_from_string(ptr)
|
||||
declare i64 @flan_dyn_vec_new()
|
||||
declare i64 @flan_dyn_map_new()
|
||||
@ -5128,6 +5131,9 @@ declare ptr @flan_dev_literal(ptr, i64)
|
||||
declare i64 @flan_dyn_need_i64(i64)
|
||||
declare double @flan_dyn_need_f64(i64)
|
||||
declare i32 @flan_dyn_need_bool(i64)
|
||||
declare i32 @flan_dyn_need_i32(i64, ptr, i64)
|
||||
declare i64 @flan_dyn_need_int(i64, i32, ptr, i64)
|
||||
declare i64 @flan_dyn_int_of(i64)
|
||||
; A numeric cast written on a dyn answers which numeric tag the box holds;
|
||||
; check.ml's [cast_dyn] branches on it and each arm is an ordinary need plus
|
||||
; the ordinary cast. The two slices are the site's location and the target's
|
||||
|
||||
@ -191,7 +191,10 @@ let rec unmarshal ~(sites : sites) ~loc (p : Dynload.addr) : Form.t =
|
||||
| _ -> Form.make (Form.Int i) loc)
|
||||
| TFloat -> Form.make (Form.Float (Dynload.peek_f64 p payload)) loc
|
||||
| TByte ->
|
||||
Form.make (Form.Byte (Int32.to_int (Dynload.peek_i32 p payload) land 0xff)) loc
|
||||
(* A char is a code point; anything that is not a scalar value keeps the
|
||||
byte it always was. *)
|
||||
let b = Int32.to_int (Dynload.peek_i32 p payload) in
|
||||
Form.make (Form.Byte (if Uchar.is_valid b then b else b land 0xff)) loc
|
||||
| TSym -> Form.make (Form.Sym (str ())) (here ())
|
||||
| TKw -> Form.make (Form.Kw (str ())) (here ())
|
||||
| TStr -> Form.make (Form.Str (str ())) (here ())
|
||||
|
||||
51
lib/form.ml
51
lib/form.ml
@ -18,7 +18,7 @@ and value =
|
||||
| UInt of int64 * string
|
||||
| Float of float (* 0.05 *)
|
||||
| Str of string (* "SAND" *)
|
||||
| Byte of int (* \space \0 \( (0..255) *)
|
||||
| Byte of int (* \space \0 \( \é a code point, a char *)
|
||||
| List of t list (* (f x) *)
|
||||
| Vec of t list (* [1 2 3] and every binding/type bracket *)
|
||||
| Map of t list (* {.field v} a struct value, and a defn's
|
||||
@ -28,6 +28,29 @@ and value =
|
||||
|
||||
let make v loc = { v; loc }
|
||||
|
||||
(* A code point's UTF-8 bytes. *)
|
||||
let utf8 b =
|
||||
let buf = Buffer.create 4 in
|
||||
Buffer.add_utf_8_uchar buf (Uchar.of_int b);
|
||||
Buffer.contents buf
|
||||
|
||||
(* A char's spelling, the one [Reader.read_byte] reads back as the same code
|
||||
point: a name where the reader has one, Clojure's \uXXXX for every other
|
||||
control character (C0, DEL and C1), and the character itself otherwise.
|
||||
runtime/flan_dyn.c's [char_spell] writes the same table. *)
|
||||
let byte_repr b =
|
||||
match b with
|
||||
| 32 -> "\\space"
|
||||
| 9 -> "\\tab"
|
||||
| 10 -> "\\newline"
|
||||
| 13 -> "\\return"
|
||||
| 0 -> "\\nul"
|
||||
| 8 -> "\\backspace"
|
||||
| 12 -> "\\formfeed"
|
||||
| b when b < 32 || (b >= 127 && b <= 0x9F) -> Printf.sprintf "\\u%04X" b
|
||||
| b when b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
|
||||
| b -> "\\" ^ utf8 b
|
||||
|
||||
let rec to_string f =
|
||||
let seq l = String.concat " " (List.map to_string l) in
|
||||
match f.v with
|
||||
@ -37,12 +60,7 @@ let rec to_string f =
|
||||
| UInt (_, s) -> s
|
||||
| Float x -> Printf.sprintf "%g" x
|
||||
| Str s -> Printf.sprintf "%S" s
|
||||
| Byte b ->
|
||||
(match Char.chr b with
|
||||
| ' ' -> "\\space"
|
||||
| '\t' -> "\\tab"
|
||||
| '\n' -> "\\newline"
|
||||
| c -> Printf.sprintf "\\%c" c)
|
||||
| Byte b -> byte_repr b
|
||||
| List l -> "(" ^ seq l ^ ")"
|
||||
| Vec l -> "[" ^ seq l ^ "]"
|
||||
| Map l -> "{" ^ seq l ^ "}"
|
||||
@ -70,9 +88,8 @@ let rec to_string f =
|
||||
- [%S] is OCaml's escaping. The reader takes exactly six escapes — newline,
|
||||
tab, return, backslash, quote and nul — and every other byte literally,
|
||||
so the three-digit decimal escape [%S] writes would not read back.
|
||||
- [Byte] falls through to \<char>, which spells 0 and 13 as a NUL and a
|
||||
carriage return sitting in the middle of the source. The reader has names
|
||||
for those and this uses them. *)
|
||||
- A control character written as itself is a raw byte in the middle of
|
||||
the source. [byte_repr] names it, or writes \uXXXX. *)
|
||||
|
||||
let escape s =
|
||||
let b = Buffer.create (String.length s + 2) in
|
||||
@ -110,20 +127,6 @@ let float_repr x =
|
||||
in
|
||||
if plain then s ^ ".0" else s
|
||||
|
||||
let byte_repr b =
|
||||
match b with
|
||||
| 32 -> "\\space"
|
||||
| 9 -> "\\tab"
|
||||
| 10 -> "\\newline"
|
||||
| 13 -> "\\return"
|
||||
| 0 -> "\\nul"
|
||||
(* Printable ASCII is written as itself. Anything else has no spelling in
|
||||
the reader at all — [read_byte] takes a name or a single character — so
|
||||
it is written as the decimal the reader would have to grow, rather than
|
||||
as a byte that would corrupt the line it is on. *)
|
||||
| b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
|
||||
| b -> Printf.sprintf "\\%d" b
|
||||
|
||||
(** One line, and a reader reads it back. *)
|
||||
let rec to_source f =
|
||||
let seq l = String.concat " " (List.map to_source l) in
|
||||
|
||||
@ -113,7 +113,8 @@ let read_string st =
|
||||
go ();
|
||||
spanned st loc (Form.Str (Buffer.contents buf))
|
||||
|
||||
(* \space \tab \newline \return \nul, or \<any single char> *)
|
||||
(* \space \tab \newline \return \nul \backspace \formfeed, Clojure's \uXXXX
|
||||
(four hex digits), or \<any single char> *)
|
||||
let read_byte st =
|
||||
let loc = here st in
|
||||
advance st; (* backslash *)
|
||||
@ -128,7 +129,23 @@ let read_byte st =
|
||||
| "newline" -> 10
|
||||
| "return" -> 13
|
||||
| "nul" -> 0
|
||||
| "backspace" -> 8
|
||||
| "formfeed" -> 12
|
||||
| n when String.length n = 1 -> Char.code n.[0]
|
||||
| n when String.length n = 5 && n.[0] = 'u'
|
||||
&& String.for_all
|
||||
(function '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false)
|
||||
(String.sub n 1 4) ->
|
||||
let c = int_of_string ("0x" ^ String.sub n 1 4) in
|
||||
if not (Uchar.is_valid c) then
|
||||
Loc.failk "reader/unknown-character" loc
|
||||
"\\%s is a surrogate, which is not a character" n;
|
||||
c
|
||||
(* One code point written as itself, UTF-8 in the source: \é \日. *)
|
||||
| n when (let d = String.get_utf_8_uchar n 0 in
|
||||
Uchar.utf_decode_is_valid d
|
||||
&& Uchar.utf_decode_length d = String.length n) ->
|
||||
Uchar.to_int (Uchar.utf_decode_uchar (String.get_utf_8_uchar n 0))
|
||||
| n -> Loc.failk "reader/unknown-character" loc "unknown character literal \\%s" n
|
||||
in
|
||||
spanned st loc (Form.Byte code)
|
||||
|
||||
@ -211,6 +211,9 @@ typedef struct flan_desc {
|
||||
* name are the same word, so equality is the identity compare [dyn_equal]
|
||||
* already opens with, never a memcmp. */
|
||||
#define BOX_KW 4u
|
||||
/* A character: the payload is its code point, a Unicode scalar value, so two
|
||||
* equal chars are the same word and nothing about one is ever allocated. */
|
||||
#define BOX_CHAR 5u
|
||||
|
||||
/* Restated from flan_dyn.h — a view's element kind. */
|
||||
#define FLAN_VIEW_I64 0
|
||||
@ -526,7 +529,8 @@ static unsigned ring_at;
|
||||
* somebody can act on and "tag 2 and tag 4" is a puzzle. */
|
||||
|
||||
static const char *const tag_words[] = { "nil", "bool", "int", "float",
|
||||
"text", "vec", "keyword", "map" };
|
||||
"text", "vec", "keyword", "map",
|
||||
"char" };
|
||||
|
||||
#define FLAN_DYN_TAG_NIL 0
|
||||
#define FLAN_DYN_TAG_BOOL 1
|
||||
@ -536,6 +540,8 @@ static const char *const tag_words[] = { "nil", "bool", "int", "float",
|
||||
#define FLAN_DYN_TAG_VEC 5
|
||||
#define FLAN_DYN_TAG_KEYWORD 6
|
||||
#define FLAN_DYN_TAG_MAP 7
|
||||
#define FLAN_DYN_TAG_CHAR 8
|
||||
#define FLAN_DYN_TAG_LAST FLAN_DYN_TAG_CHAR
|
||||
|
||||
static inline flan_obj *dyn_obj(flan_dyn v) {
|
||||
return (flan_obj *)(uintptr_t)dyn_payload(v);
|
||||
@ -562,6 +568,7 @@ int32_t flan_dyn_tag(flan_dyn v) {
|
||||
case BOX_BOOL: return FLAN_DYN_TAG_BOOL;
|
||||
case BOX_INT: return FLAN_DYN_TAG_INT;
|
||||
case BOX_KW: return FLAN_DYN_TAG_KEYWORD;
|
||||
case BOX_CHAR: return FLAN_DYN_TAG_CHAR;
|
||||
default: {
|
||||
flan_obj *o = dyn_obj(v);
|
||||
if (o == NULL) return FLAN_DYN_TAG_NIL;
|
||||
@ -582,7 +589,7 @@ int32_t flan_dyn_tag(flan_dyn v) {
|
||||
}
|
||||
|
||||
const char *flan_dyn_tag_name(int32_t tag) {
|
||||
if (tag < 0 || tag > FLAN_DYN_TAG_MAP) return "?";
|
||||
if (tag < 0 || tag > FLAN_DYN_TAG_LAST) return "?";
|
||||
return tag_words[tag];
|
||||
}
|
||||
|
||||
@ -677,6 +684,119 @@ static void emit_escaped(dyn_sink w, const uint8_t *p, int64_t n) {
|
||||
emit(w, "\"");
|
||||
}
|
||||
|
||||
/* ── Characters ────────────────────────────────────────────────────────
|
||||
*
|
||||
* Text is UTF-8 and a char is one code point. A text's length and its
|
||||
* indices count code points, so a byte that does not start a well-formed
|
||||
* sequence — possible, because a text can be made from any typed bytes —
|
||||
* counts as one char and reads as U+FFFD: the prelude's decode-rune refusal,
|
||||
* width 1, given the replacement character as its value. */
|
||||
|
||||
static int utf8_encode(uint32_t cp, uint8_t out[4]) {
|
||||
if (cp < 0x80) { out[0] = (uint8_t)cp; return 1; }
|
||||
if (cp < 0x800) {
|
||||
out[0] = (uint8_t)(0xC0 | (cp >> 6));
|
||||
out[1] = (uint8_t)(0x80 | (cp & 0x3F));
|
||||
return 2;
|
||||
}
|
||||
if (cp < 0x10000) {
|
||||
out[0] = (uint8_t)(0xE0 | (cp >> 12));
|
||||
out[1] = (uint8_t)(0x80 | ((cp >> 6) & 0x3F));
|
||||
out[2] = (uint8_t)(0x80 | (cp & 0x3F));
|
||||
return 3;
|
||||
}
|
||||
out[0] = (uint8_t)(0xF0 | (cp >> 18));
|
||||
out[1] = (uint8_t)(0x80 | ((cp >> 12) & 0x3F));
|
||||
out[2] = (uint8_t)(0x80 | ((cp >> 6) & 0x3F));
|
||||
out[3] = (uint8_t)(0x80 | (cp & 0x3F));
|
||||
return 4;
|
||||
}
|
||||
|
||||
/* The code point at [p], of the [n] bytes left, and its width. Overlong
|
||||
* forms, surrogates and anything past U+10FFFF are malformed. */
|
||||
static uint32_t utf8_decode(const uint8_t *p, int64_t n, int *w) {
|
||||
uint32_t c = p[0], cp;
|
||||
int k, i;
|
||||
*w = 1;
|
||||
if (c < 0x80) return c;
|
||||
if (c >= 0xC2 && c <= 0xDF) { k = 2; cp = c & 0x1F; }
|
||||
else if (c >= 0xE0 && c <= 0xEF) { k = 3; cp = c & 0x0F; }
|
||||
else if (c >= 0xF0 && c <= 0xF4) { k = 4; cp = c & 0x07; }
|
||||
else return 0xFFFD;
|
||||
if (n < k) return 0xFFFD;
|
||||
for (i = 1; i < k; i++) {
|
||||
if ((p[i] & 0xC0) != 0x80) return 0xFFFD;
|
||||
cp = (cp << 6) | (p[i] & 0x3F);
|
||||
}
|
||||
if ((k == 3 && cp < 0x800) || (k == 4 && cp < 0x10000) || cp > 0x10FFFF ||
|
||||
(cp >= 0xD800 && cp <= 0xDFFF))
|
||||
return 0xFFFD;
|
||||
*w = k;
|
||||
return cp;
|
||||
}
|
||||
|
||||
static int is_scalar(int64_t cp) {
|
||||
return cp >= 0 && cp <= 0x10FFFF && !(cp >= 0xD800 && cp <= 0xDFFF);
|
||||
}
|
||||
|
||||
/* A char's spelling, as lib/reader.ml's [read_byte] reads it back and
|
||||
* lib/form.ml's [byte_repr] writes it: a name where there is one, \uXXXX
|
||||
* for every other control character (C0, DEL and C1), the character itself after the
|
||||
* backslash otherwise. */
|
||||
static void char_spell(uint32_t cp, char buf[16]) {
|
||||
uint8_t u[4];
|
||||
int n, i;
|
||||
switch (cp) {
|
||||
case 32: strcpy(buf, "\\space"); return;
|
||||
case 9: strcpy(buf, "\\tab"); return;
|
||||
case 10: strcpy(buf, "\\newline"); return;
|
||||
case 13: strcpy(buf, "\\return"); return;
|
||||
case 0: strcpy(buf, "\\nul"); return;
|
||||
case 8: strcpy(buf, "\\backspace"); return;
|
||||
case 12: strcpy(buf, "\\formfeed"); return;
|
||||
default: break;
|
||||
}
|
||||
if (cp < 32 || (cp >= 127 && cp <= 0x9F)) {
|
||||
snprintf(buf, 16, "\\u%04X", (unsigned)cp);
|
||||
return;
|
||||
}
|
||||
n = utf8_encode(cp, u);
|
||||
buf[0] = '\\';
|
||||
for (i = 0; i < n; i++) buf[1 + i] = (char)u[i];
|
||||
buf[1 + n] = '\0';
|
||||
}
|
||||
|
||||
/* A text is immutable, so its char count is taken once, when it is made, and
|
||||
* kept in the header's [u.i], which a text does not otherwise use. A count
|
||||
* equal to the byte length means every byte is ASCII, and an index is then a
|
||||
* byte offset. [gen] is not touched: on a text it is [pin_text]'s stamp. */
|
||||
static void text_measure(flan_obj *o) {
|
||||
const uint8_t *p = obj_text_bytes(o);
|
||||
int64_t i = 0, n = 0;
|
||||
int w;
|
||||
while (i < o->len) {
|
||||
if (p[i] < 0x80) { i++; n++; continue; }
|
||||
utf8_decode(p + i, o->len - i, &w);
|
||||
i += w;
|
||||
n++;
|
||||
}
|
||||
o->u.i = n;
|
||||
}
|
||||
|
||||
/* The byte offset of char [k], 0 <= k <= the char count. */
|
||||
static int64_t text_offset(flan_obj *o, int64_t k) {
|
||||
const uint8_t *p = obj_text_bytes(o);
|
||||
int64_t i = 0;
|
||||
int w;
|
||||
if (o->u.i == o->len) return k;
|
||||
while (k > 0 && i < o->len) {
|
||||
utf8_decode(p + i, o->len - i, &w);
|
||||
i += w;
|
||||
k--;
|
||||
}
|
||||
return i;
|
||||
}
|
||||
|
||||
static int64_t dyn_int_value(flan_dyn v); /* forward: both int shapes */
|
||||
static double dyn_num_value(flan_dyn v);
|
||||
|
||||
@ -735,6 +855,11 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
|
||||
else emit_n(w, obj_text_bytes(o), o->len);
|
||||
return;
|
||||
}
|
||||
/* A char prints as the literal that reads back as it, at every depth. */
|
||||
case FLAN_DYN_TAG_CHAR:
|
||||
char_spell((uint32_t)dyn_payload(v), buf);
|
||||
emit(w, buf);
|
||||
return;
|
||||
/* A keyword prints with its colon, bare, at every depth: :a is its own
|
||||
* spelling the way true is, and quoting it would make it a text. */
|
||||
case FLAN_DYN_TAG_KEYWORD: {
|
||||
@ -866,6 +991,9 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
if (d != d) snprintf(buf, sizeof buf, "nan");
|
||||
else snprintf(buf, sizeof buf, "%g", d);
|
||||
say_puts(s, buf);
|
||||
/* A trap's sentence says 2.0 for a float of 2, so it cannot be read as
|
||||
the int 2; inf and an exponent already say float. */
|
||||
if (strspn(buf, "-0123456789") == strlen(buf)) say_puts(s, ".0");
|
||||
return;
|
||||
}
|
||||
case FLAN_DYN_TAG_TEXT: {
|
||||
@ -882,6 +1010,10 @@ static void say_render(sayer *s, flan_dyn v, int depth) {
|
||||
say_puts(s, i < o->len ? "...\"" : "\"");
|
||||
return;
|
||||
}
|
||||
case FLAN_DYN_TAG_CHAR:
|
||||
char_spell((uint32_t)dyn_payload(v), buf);
|
||||
say_puts(s, buf);
|
||||
return;
|
||||
case FLAN_DYN_TAG_KEYWORD: {
|
||||
kw_entry *k = dyn_kw(v);
|
||||
int64_t i;
|
||||
@ -1546,8 +1678,9 @@ static void mark_desc(char *base, const flan_desc *d) {
|
||||
* allocator put there next.
|
||||
*
|
||||
* A text is pinned once per stamp, however often it crosses: the stamp's
|
||||
* number is written into the text's [gen], which nothing else reads for a
|
||||
* text, so a program that never calls free-temp and passes the same texts
|
||||
* number is written into the text's [gen], which nothing else reads or
|
||||
* writes for a text — its char count is in [u.i], and whether it is ASCII is
|
||||
* that count against its length ([text_measure]) — so a program that never calls free-temp and passes the same texts
|
||||
* in a loop keeps a flat list. Distinct texts cost one pointer each here,
|
||||
* and each keeps its own object alive until the stamp ends — heavier than
|
||||
* i64->bytes's few bytes of arena, since the object has a header. The pins
|
||||
@ -1790,9 +1923,19 @@ flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n) {
|
||||
o = gc_alloc(OBJ_TEXT, n);
|
||||
o->len = n;
|
||||
if (n > 0) memcpy(obj_text_bytes(o), p, (size_t)n);
|
||||
text_measure(o);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
}
|
||||
|
||||
/* Only a scalar value is a char; the reader and [chars] make nothing else,
|
||||
* so a refusal here is a compiler bug and not a program's. */
|
||||
flan_dyn flan_dyn_from_char(int32_t cp) {
|
||||
if (!is_scalar(cp))
|
||||
trap1(NULL, 0, TYPE_TRAP, "char", "a char is a Unicode scalar value",
|
||||
flan_dyn_from_i64(cp));
|
||||
return dyn_make(BOX_CHAR, (uint64_t)(uint32_t)cp);
|
||||
}
|
||||
|
||||
/* A String crossing into dyn: its (Vec u8), by address, copied into dyn text.
|
||||
* A copy and not a view, because dyn text is immutable and a String is not. */
|
||||
flan_dyn flan_dyn_from_string(const void *vec) {
|
||||
@ -2531,17 +2674,15 @@ flan_dyn flan_dyn_class_of(flan_dyn v) {
|
||||
/* The kind of a value as a keyword named by [tag_words], or a class instance's
|
||||
* class name as [flan_dyn_class_of] answers it. A class may not be named like
|
||||
* a kind (the parser refuses it), so :map always means a plain map. Keywords
|
||||
* are immortal, so each kind's keyword is interned once and kept. When dyn
|
||||
* gains a char, its tag gets a word in [tag_words] and :char falls out here
|
||||
* with no change to this function. */
|
||||
* are immortal, so each kind's keyword is interned once and kept. */
|
||||
flan_dyn flan_dyn_type_of(flan_dyn v) {
|
||||
static flan_dyn kinds[FLAN_DYN_TAG_MAP + 1];
|
||||
static flan_dyn kinds[FLAN_DYN_TAG_LAST + 1];
|
||||
static int interned;
|
||||
int32_t t = flan_dyn_tag(v);
|
||||
if (t == FLAN_DYN_TAG_MAP && dyn_obj(v)->u.v.klass != NULL)
|
||||
return flan_dyn_class_of(v);
|
||||
if (!interned) {
|
||||
for (int i = 0; i <= FLAN_DYN_TAG_MAP; i++)
|
||||
for (int i = 0; i <= FLAN_DYN_TAG_LAST; i++)
|
||||
kinds[i] = flan_dyn_kw((const uint8_t *)tag_words[i],
|
||||
(int64_t)strlen(tag_words[i]));
|
||||
interned = 1;
|
||||
@ -2659,6 +2800,81 @@ double flan_dyn_need_f64(flan_dyn v) {
|
||||
return dyn_num_value(v);
|
||||
}
|
||||
|
||||
static const char *an(const char *w); /* forward: "a" or "an" */
|
||||
|
||||
/* A dyn into a typed integer of width [kind] — 0..7 for i8 u8 i16 u16 i32
|
||||
* u32 i64 u64, check.ml's [unbox] — answered as an i64 the caller narrows:
|
||||
* an int in the width's range, or a char's code point where it fits. A byte
|
||||
* takes only an ASCII char, because a byte past ASCII is not that char in
|
||||
* UTF-8. A dyn int is an i64, so a u64 takes 0 up to the largest i64. The
|
||||
* sentence names what was found and what would do, and no call: the site in
|
||||
* front of it is the one that failed. */
|
||||
static const char *const int_names[8] = { "i8", "u8", "i16", "u16",
|
||||
"i32", "u32", "i64", "u64" };
|
||||
|
||||
int64_t flan_dyn_need_int(flan_dyn v, int32_t kind, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
static const int64_t lo[8] = { -128, 0, -32768, 0, INT32_MIN, 0, INT64_MIN, 0 };
|
||||
static const int64_t hi[8] = { 127, 255, 32767, 65535, INT32_MAX,
|
||||
4294967295LL, INT64_MAX, INT64_MAX };
|
||||
int32_t t = flan_dyn_tag(v);
|
||||
const char *name;
|
||||
char sv[SAY_MAX];
|
||||
if (kind < 0 || kind > 7) kind = 6;
|
||||
name = int_names[kind];
|
||||
if (t == FLAN_DYN_TAG_CHAR) {
|
||||
int64_t cp = (int64_t)dyn_payload(v);
|
||||
int64_t top = kind <= 1 ? 127 : hi[kind];
|
||||
char cs[16];
|
||||
if (cp <= top) return cp;
|
||||
char_spell((uint32_t)cp, cs);
|
||||
if (kind <= 1)
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and the char %s is more than one "
|
||||
"byte in UTF-8. Take its code point as an i32",
|
||||
an(name), name, cs);
|
||||
else
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and the char %s, code point %lld, "
|
||||
"is outside %s %s's range", an(name), name, cs, (long long)cp,
|
||||
an(name), name);
|
||||
flan_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
if (t == FLAN_DYN_TAG_INT) {
|
||||
int64_t x = dyn_int_value(v);
|
||||
if (x >= lo[kind] && x <= hi[kind]) return x;
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and the int %lld is outside %s %s's "
|
||||
"range", an(name), name, (long long)x, an(name), name);
|
||||
flan_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
if (t == FLAN_DYN_TAG_NIL) sv[0] = '\0';
|
||||
else say(sv, SAY_MAX, v);
|
||||
flan_say(loc, loclen,
|
||||
"dyn: %s %s is wanted here, and this is %s%s%s%s%s. %s %s takes an "
|
||||
"int or a char's code point%s%s%s",
|
||||
an(name), name, t == FLAN_DYN_TAG_NIL ? "" : an(tag_of(v)),
|
||||
t == FLAN_DYN_TAG_NIL ? "" : " ", tag_of(v), t == FLAN_DYN_TAG_NIL ? "" : ", ", sv,
|
||||
name[0] == 'i' ? "An" : "A", name,
|
||||
t == FLAN_DYN_TAG_FLOAT ? "; convert a float with (" : "",
|
||||
t == FLAN_DYN_TAG_FLOAT ? name : "",
|
||||
t == FLAN_DYN_TAG_FLOAT ? " x)" : "");
|
||||
flan_trap((const uint8_t *)"DynType", 7);
|
||||
}
|
||||
|
||||
int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
return (int32_t)flan_dyn_need_int(v, 4, loc, loclen);
|
||||
}
|
||||
|
||||
/* The int arm of a numeric cast written on a dyn ([check.ml]'s [cast_dyn]),
|
||||
* reached once [flan_dyn_cast_kind] has said the box is not a float: an
|
||||
* int's value, or a char's code point, so (i32 c) is the code point the
|
||||
* implicit crossing into an i32 gives. */
|
||||
int64_t flan_dyn_int_of(flan_dyn v) {
|
||||
if (flan_dyn_tag(v) == FLAN_DYN_TAG_CHAR) return (int64_t)dyn_payload(v);
|
||||
return flan_dyn_need_i64(v);
|
||||
}
|
||||
|
||||
uint8_t flan_dyn_need_bool(flan_dyn v) {
|
||||
if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL)
|
||||
trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v);
|
||||
@ -2748,6 +2964,19 @@ int32_t flan_dyn_cast_kind(flan_dyn v, const uint8_t *loc, int64_t loc_len,
|
||||
const uint8_t *target, int64_t target_len,
|
||||
int32_t want_float) {
|
||||
int32_t tag = flan_dyn_tag(v);
|
||||
/* A char casts as its code point, an int: the arm after this reads it
|
||||
through [flan_dyn_int_of], so (i32 c) is what passing c to an i32 is. */
|
||||
if (tag == FLAN_DYN_TAG_CHAR) {
|
||||
if (want_float && site_first_time(loc, loc_len)) {
|
||||
fflush(stdout);
|
||||
fprintf(stderr,
|
||||
"%.*s: (%.*s x) found a dyn holding a char, and converted its "
|
||||
"code point to %.*s — warned once for this site\n",
|
||||
(int)loc_len, (const char *)loc, (int)target_len,
|
||||
(const char *)target, (int)target_len, (const char *)target);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
if (tag != FLAN_DYN_TAG_INT && tag != FLAN_DYN_TAG_FLOAT) {
|
||||
/* [trap1] takes the operation as a C string and the target is a Flan
|
||||
* slice, so it is copied out. Every cast name is two or three bytes; the
|
||||
@ -3062,8 +3291,14 @@ static int order(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
if (c != 0) return c < 0 ? -1 : 1;
|
||||
return x->len < y->len ? -1 : (x->len > y->len ? 1 : 0);
|
||||
}
|
||||
if (flan_dyn_tag(a) == FLAN_DYN_TAG_CHAR &&
|
||||
flan_dyn_tag(b) == FLAN_DYN_TAG_CHAR) {
|
||||
uint64_t x = dyn_payload(a), y = dyn_payload(b);
|
||||
return x < y ? -1 : (x > y ? 1 : 0);
|
||||
}
|
||||
trap2(loc, loclen, TYPE_TRAP, op,
|
||||
"it compares two numbers or two texts, and these are neither", a, b);
|
||||
"it compares two numbers, two texts or two chars, and these are "
|
||||
"neither", a, b);
|
||||
}
|
||||
|
||||
flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc,
|
||||
@ -3837,6 +4072,27 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (int_range(*d, &lo, &hi)) {
|
||||
int64_t n;
|
||||
/* A char is written as its code point where it fits, [into_put]'s rule:
|
||||
into a byte only when ASCII, since a byte past ASCII is not that char
|
||||
in UTF-8. */
|
||||
if (flan_dyn_tag(x) == FLAN_DYN_TAG_CHAR) {
|
||||
char cs[16];
|
||||
int byte = *d == 'b' || *d == 'B';
|
||||
n = (int64_t)dyn_payload(x);
|
||||
if (n <= (byte ? 127 : hi)) goto store;
|
||||
char_spell((uint32_t)n, cs);
|
||||
if (byte)
|
||||
snprintf(why, sizeof why, ", and the char %s is more than one byte in "
|
||||
"UTF-8. Take its code point as an i32", cs);
|
||||
else
|
||||
snprintf(why, sizeof why, ", which holds %lld to %lld, and the char "
|
||||
"%s, code point %lld, does not fit", (long long)lo,
|
||||
(long long)hi, cs, (long long)n);
|
||||
if (field) field_refuse(loc, loclen, op, v, key, d, x, "DynRange", why);
|
||||
flan_say(loc, loclen, "dyn %s: this element is %s %s%s", op, an(ty), ty,
|
||||
why);
|
||||
dyn_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) {
|
||||
if (field) {
|
||||
value_is(why, sizeof why, x);
|
||||
@ -3868,6 +4124,7 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
(long long)hi);
|
||||
dyn_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
store:
|
||||
switch (*d) {
|
||||
case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; }
|
||||
case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; }
|
||||
@ -4309,6 +4566,23 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
|
||||
int64_t lo, hi;
|
||||
if (int_range(*d, &lo, &hi)) {
|
||||
int64_t n;
|
||||
/* A char goes in as its code point where it fits, as it does into a
|
||||
typed parameter ([flan_dyn_need_int]): into a byte only when ASCII,
|
||||
since a byte past ASCII is not that char in UTF-8. */
|
||||
if (flan_dyn_tag(x) == FLAN_DYN_TAG_CHAR) {
|
||||
char cs[16];
|
||||
n = (int64_t)dyn_payload(x);
|
||||
if (n <= ((*d == 'b' || *d == 'B') ? 127 : hi)) goto store;
|
||||
char_spell((uint32_t)n, cs);
|
||||
desc_spell(d, ty, sizeof ty);
|
||||
if (*d == 'b' || *d == 'B')
|
||||
into_trap(s, "DynRange", "%s is the char %s, which is more than one "
|
||||
"byte in UTF-8, so it is not %s %s. Take its code point as "
|
||||
"an i32", into_who(s), cs, an(ty), ty);
|
||||
into_trap(s, "DynRange", "%s is the char %s, code point %lld, and %s %s "
|
||||
"holds %lld to %lld", into_who(s), cs, (long long)n, an(ty),
|
||||
ty, (long long)lo, (long long)hi);
|
||||
}
|
||||
if (flan_dyn_tag(x) != FLAN_DYN_TAG_INT) {
|
||||
into_wanted(why, sizeof why, d);
|
||||
into_wrong(s, x, why);
|
||||
@ -4323,6 +4597,7 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
|
||||
into_who(s), (long long)n, an(ty), ty, (long long)lo,
|
||||
(long long)hi);
|
||||
}
|
||||
store:
|
||||
switch (*d) {
|
||||
case 'b': case 'B': { uint8_t b = (uint8_t)n; memcpy(p, &b, 1); return; }
|
||||
case 'h': case 'H': { uint16_t h = (uint16_t)n; memcpy(p, &h, 2); return; }
|
||||
@ -4585,7 +4860,7 @@ void flan_dyn_need_as(flan_dyn v, const uint8_t *want, int64_t wantlen,
|
||||
}
|
||||
|
||||
static flan_dyn len_walk(flan_dyn v) {
|
||||
if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->len);
|
||||
if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->u.i);
|
||||
/* A map's length is its slot count, so a stale instance would answer the
|
||||
count of a definition that no longer exists. Migrated first for the same
|
||||
reason [get] is. */
|
||||
@ -4614,10 +4889,10 @@ static int64_t need_index(const uint8_t *loc, int64_t loclen, const char *op,
|
||||
return dyn_int_value(i);
|
||||
}
|
||||
|
||||
/* A text answers a byte, as an int. That is what [(at s i)] on a
|
||||
* [(Slice u8)] does in the typed language, and a text is a run of bytes in
|
||||
* both. Codepoints are utf8's job and stay there. */
|
||||
/* [at]'s, and [get]'s over a text or a vec: one body, so the two always
|
||||
/* A text answers its [i]th char, counting code points: O(1) on an ASCII
|
||||
* text, a walk from the front on any other. A typed str counts bytes.
|
||||
*
|
||||
* [at]'s, and [get]'s over a text or a vec: one body, so the two always
|
||||
* count the same way. [soft] is [get]'s — an index out of range is nil
|
||||
* rather than a trap. */
|
||||
static flan_dyn at_core(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
@ -4648,11 +4923,21 @@ static flan_dyn at_core(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
}
|
||||
}
|
||||
}
|
||||
if (o->kind == OBJ_TEXT) {
|
||||
int64_t off;
|
||||
int w;
|
||||
if (k < 0 || k >= o->u.i) {
|
||||
if (soft) return flan_dyn_nil();
|
||||
trap_range(loc, loclen, "at", v, k, o->u.i);
|
||||
}
|
||||
off = text_offset(o, k);
|
||||
return dyn_make(BOX_CHAR,
|
||||
utf8_decode(obj_text_bytes(o) + off, o->len - off, &w));
|
||||
}
|
||||
if (k < 0 || k >= o->len) {
|
||||
if (soft) return flan_dyn_nil();
|
||||
trap_range(loc, loclen, "at", v, k, o->len);
|
||||
}
|
||||
if (o->kind == OBJ_TEXT) return flan_dyn_from_i64(obj_text_bytes(o)[k]);
|
||||
return o->u.v.items[k];
|
||||
}
|
||||
|
||||
@ -4673,7 +4958,8 @@ flan_dyn flan_dyn_slice(flan_dyn v, flan_dyn lo, flan_dyn hi,
|
||||
if (!is_text(v))
|
||||
trap2(loc, loclen, TYPE_TRAP, "slice", "only a text is sliced", v, lo);
|
||||
o = dyn_obj(v);
|
||||
len = o->len;
|
||||
/* The bounds count chars, as [length] and [at] do. */
|
||||
len = o->u.i;
|
||||
a = need_index(loc, loclen, "slice", v, lo);
|
||||
b = flan_dyn_tag(hi) == FLAN_DYN_TAG_NIL
|
||||
? len : need_index(loc, loclen, "slice", v, hi);
|
||||
@ -4685,9 +4971,67 @@ flan_dyn flan_dyn_slice(flan_dyn v, flan_dyn lo, flan_dyn hi,
|
||||
"— %s", (long long)a, (long long)b, (long long)len, sv);
|
||||
dyn_trap((const uint8_t *)"DynRange", 8);
|
||||
}
|
||||
a = text_offset(o, a);
|
||||
b = text_offset(o, b);
|
||||
return flan_dyn_from_bytes(obj_text_bytes(o) + a, b - a);
|
||||
}
|
||||
|
||||
/* (chars t): a text's chars, a fresh vec of them. */
|
||||
flan_dyn flan_dyn_chars(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
flan_obj *o;
|
||||
flan_dyn out;
|
||||
int64_t i = 0;
|
||||
int w;
|
||||
if (!is_text(v))
|
||||
trap1(loc, loclen, TYPE_TRAP, "chars", "only a text has chars", v);
|
||||
out = flan_dyn_vec_new();
|
||||
o = dyn_obj(v);
|
||||
while (i < o->len) {
|
||||
uint32_t cp = utf8_decode(obj_text_bytes(o) + i, o->len - i, &w);
|
||||
flan_dyn_push(out, dyn_make(BOX_CHAR, cp), loc, loclen);
|
||||
i += w;
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
/* (text x): a vec of chars, or one char, as a text — [chars] undone. */
|
||||
flan_dyn flan_dyn_text(flan_dyn v, const uint8_t *loc, int64_t loclen) {
|
||||
uint8_t u[4];
|
||||
int64_t i, n, total = 0;
|
||||
flan_obj *src, *o;
|
||||
if (flan_dyn_tag(v) == FLAN_DYN_TAG_CHAR) {
|
||||
int k = utf8_encode((uint32_t)dyn_payload(v), u);
|
||||
return flan_dyn_from_bytes(u, k);
|
||||
}
|
||||
if (!is_vec(v))
|
||||
trap1(loc, loclen, TYPE_TRAP, "text",
|
||||
"text is made from a vec of chars or from one char", v);
|
||||
src = dyn_obj(v);
|
||||
n = vecish_len(src);
|
||||
for (i = 0; i < n; i++) {
|
||||
flan_dyn c = vecish_at(src, i);
|
||||
if (flan_dyn_tag(c) != FLAN_DYN_TAG_CHAR) {
|
||||
char sc[SAY_MAX];
|
||||
say(sc, SAY_MAX, c);
|
||||
flan_say(loc, loclen,
|
||||
"dyn text: element %lld is %s %s, and text is made from chars "
|
||||
"only", (long long)i, an(tag_of(c)), sc);
|
||||
flan_trap((const uint8_t *)"DynType", 7);
|
||||
}
|
||||
total += utf8_encode((uint32_t)dyn_payload(c), u);
|
||||
}
|
||||
o = gc_alloc(OBJ_TEXT, total);
|
||||
o->len = total;
|
||||
total = 0;
|
||||
for (i = 0; i < n; i++) {
|
||||
int k = utf8_encode((uint32_t)dyn_payload(vecish_at(src, i)), u);
|
||||
memcpy(obj_text_bytes(o) + total, u, (size_t)k);
|
||||
total += k;
|
||||
}
|
||||
text_measure(o);
|
||||
return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o);
|
||||
}
|
||||
|
||||
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
int64_t k;
|
||||
@ -4845,7 +5189,7 @@ flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc,
|
||||
* still be an int — a wrong kind of key is a mistake, not an absence. */
|
||||
flan_dyn flan_dyn_get_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
int64_t loclen) {
|
||||
/* Through [at]'s own body, so however [at] counts a text — bytes now —
|
||||
/* Through [at]'s own body, so however [at] counts a text — by code point —
|
||||
* [get] counts the same. */
|
||||
if (!is_text(v) && !is_vec(v)) return flan_dyn_get(v, i, loc, loclen);
|
||||
return at_core(v, i, loc, loclen, 1);
|
||||
|
||||
@ -97,6 +97,9 @@ flan_dyn flan_dyn_from_bytes(const uint8_t *p, int64_t n);
|
||||
/* A String's (Vec u8), by address, copied into dyn text. */
|
||||
flan_dyn flan_dyn_from_string(const void *vec);
|
||||
|
||||
/* A char, by its code point. Anything but a Unicode scalar value traps. */
|
||||
flan_dyn flan_dyn_from_char(int32_t cp);
|
||||
|
||||
flan_dyn flan_dyn_vec_new(void);
|
||||
flan_dyn flan_dyn_map_new(void);
|
||||
|
||||
@ -136,7 +139,7 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
|
||||
flan_dyn flan_dyn_class_of(flan_dyn v);
|
||||
|
||||
/* The value's kind as a keyword — :nil :bool :int :float :text :vec :keyword
|
||||
* :map — or, for a class instance, its class name as [flan_dyn_class_of]
|
||||
* :map :char — or, for a class instance, its class name as [flan_dyn_class_of]
|
||||
* answers it. Never traps. */
|
||||
flan_dyn flan_dyn_type_of(flan_dyn v);
|
||||
|
||||
@ -221,8 +224,8 @@ flan_dyn flan_dyn_popcount(flan_dyn a, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_clz(flan_dyn a, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_ctz(flan_dyn a, const uint8_t *loc, int64_t loclen);
|
||||
|
||||
/* Answer a bool dyn. Numbers compare as numbers and text compares bytewise;
|
||||
* a mixture of the two, or anything else, traps. */
|
||||
/* Answer a bool dyn. Numbers compare as numbers and text compares bytewise,
|
||||
* chars by code point; a mixture, or anything else, traps. */
|
||||
flan_dyn flan_dyn_lt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_le(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_gt(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen);
|
||||
@ -232,20 +235,26 @@ flan_dyn flan_dyn_ge(flan_dyn a, flan_dyn b, const uint8_t *loc, int64_t loclen)
|
||||
* of unrelated tags are not an error, they are unequal. */
|
||||
flan_dyn flan_dyn_eq(flan_dyn a, flan_dyn b);
|
||||
|
||||
/* Bytes of a text, elements of a vec. Anything else traps. */
|
||||
/* Chars of a text, elements of a vec. Anything else traps. */
|
||||
flan_dyn flan_dyn_len(flan_dyn v);
|
||||
|
||||
/* Element of a vec, or the byte of a text as an int. Out of range traps.
|
||||
/* Element of a vec, or the char of a text. A text counts code points. Out of
|
||||
* range traps.
|
||||
* [loc] is where the call was written, printed ahead of a trap's sentence; NULL
|
||||
* prints none. The same pair [flan_dyn_add] takes. */
|
||||
flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc,
|
||||
int64_t loclen);
|
||||
|
||||
/* A copy of the text's bytes [lo, hi); nil for [hi] is the length. A vec, or
|
||||
/* A copy of the text's chars [lo, hi); nil for [hi] is the length. A vec, or
|
||||
* any other value, traps: see the definition. */
|
||||
flan_dyn flan_dyn_slice(flan_dyn v, flan_dyn lo, flan_dyn hi,
|
||||
const uint8_t *loc, int64_t loclen);
|
||||
|
||||
/* (chars t): a new vec of the text's chars. (text x): the text a vec of
|
||||
* chars, or one char, spells. Anything else traps at [loc]. */
|
||||
flan_dyn flan_dyn_chars(flan_dyn v, const uint8_t *loc, int64_t loclen);
|
||||
flan_dyn flan_dyn_text(flan_dyn v, const uint8_t *loc, int64_t loclen);
|
||||
|
||||
/* Vec only — a text is immutable and says so rather than being copied. */
|
||||
void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc,
|
||||
int64_t loclen);
|
||||
@ -290,6 +299,15 @@ void flan_dyn_emit_watch(flan_dyn v);
|
||||
int64_t flan_dyn_need_i64(flan_dyn v);
|
||||
double flan_dyn_need_f64(flan_dyn v);
|
||||
uint8_t flan_dyn_need_bool(flan_dyn v);
|
||||
/* For a typed integer of width [kind], 0..7 for i8 u8 i16 u16 i32 u32 i64
|
||||
* u64: an int in range, or a char's code point where it fits (ASCII only
|
||||
* into a byte), as an i64 the caller narrows. Anything else traps at [loc].
|
||||
* [flan_dyn_need_i32] is kind 4. */
|
||||
int64_t flan_dyn_need_int(flan_dyn v, int32_t kind, const uint8_t *loc,
|
||||
int64_t loclen);
|
||||
int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen);
|
||||
/* A numeric cast's int arm: an int's value or a char's code point. */
|
||||
int64_t flan_dyn_int_of(flan_dyn v);
|
||||
|
||||
/* A numeric cast written on a dyn — [(f64 d)], [(u32 d)] — TODO.org,
|
||||
* "A numeric cast opens a dyn box". Unlike the parameter boundary above this
|
||||
@ -522,6 +540,7 @@ void flan_dyn_root_globals_end(void);
|
||||
#define FLAN_DYN_TAG_VEC 5
|
||||
#define FLAN_DYN_TAG_KEYWORD 6
|
||||
#define FLAN_DYN_TAG_MAP 7
|
||||
#define FLAN_DYN_TAG_CHAR 8
|
||||
|
||||
int32_t flan_dyn_tag(flan_dyn v);
|
||||
const char *flan_dyn_tag_name(int32_t tag);
|
||||
|
||||
@ -139,6 +139,28 @@ static void ops(void) {
|
||||
check(flan_dyn_tag(flan_dyn_from_f64(1.5)) == FLAN_DYN_TAG_FLOAT, "tag float");
|
||||
check(flan_dyn_tag(text("x")) == FLAN_DYN_TAG_TEXT, "tag text");
|
||||
check(flan_dyn_tag(flan_dyn_vec_new()) == FLAN_DYN_TAG_VEC, "tag vec");
|
||||
check(flan_dyn_tag(flan_dyn_from_char(0x65E5)) == FLAN_DYN_TAG_CHAR, "tag char");
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_CHAR), "char") == 0, "word char");
|
||||
check(flan_dyn_need_i32(flan_dyn_from_char(0x1F600), NULL, 0) == 0x1F600,
|
||||
"need-i32 answers a char's code point");
|
||||
check(flan_dyn_need_i32(flan_dyn_from_i64(-7), NULL, 0) == -7,
|
||||
"need-i32 answers an int that fits");
|
||||
check(flan_dyn_int_of(flan_dyn_from_char('a')) == 97,
|
||||
"a cast's int arm reads a char's code point");
|
||||
{
|
||||
/* "é日😀" is 2 + 3 + 4 bytes and three chars, and chars/text round-trip. */
|
||||
flan_dyn t = text("\xC3\xA9\xE6\x97\xA5\xF0\x9F\x98\x80");
|
||||
check(num(flan_dyn_len(t)) == 3, "len counts chars");
|
||||
check(flan_dyn_need_i32(FDYN_at(t, flan_dyn_from_i64(1)), NULL, 0) == 0x65E5,
|
||||
"at answers a char");
|
||||
check(truth(flan_dyn_eq(flan_dyn_text(flan_dyn_chars(t, NULL, 0), NULL, 0), t)),
|
||||
"text undoes chars");
|
||||
check(truth(flan_dyn_lt(flan_dyn_from_char('a'), flan_dyn_from_char(0xE9),
|
||||
NULL, 0)),
|
||||
"chars order by code point");
|
||||
check(!truth(flan_dyn_eq(flan_dyn_from_char('a'), flan_dyn_from_i64('a'))),
|
||||
"a char is not an int");
|
||||
}
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_NIL), "nil") == 0, "word nil");
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_BOOL), "bool") == 0, "word bool");
|
||||
check(strcmp(flan_dyn_tag_name(FLAN_DYN_TAG_INT), "int") == 0, "word int");
|
||||
@ -249,14 +271,14 @@ static void ops(void) {
|
||||
check(!truth(flan_dyn_eq(a, c)), "= text sees the last byte");
|
||||
check(truth(flan_dyn_eq(a, a)), "= text against itself");
|
||||
check(num(flan_dyn_len(a)) == 5, "len text");
|
||||
check(num(FDYN_at(a, flan_dyn_from_i64(0))) == 'h', "at text");
|
||||
check(num(FDYN_at(a, flan_dyn_from_i64(4))) == 'o', "at text last");
|
||||
check(flan_dyn_need_i32(FDYN_at(a, flan_dyn_from_i64(0)), NULL, 0) == 'h', "at text");
|
||||
check(flan_dyn_need_i32(FDYN_at(a, flan_dyn_from_i64(4)), NULL, 0) == 'o', "at text last");
|
||||
{
|
||||
/* Embedded NUL, because a length-prefixed text is the claim and strlen is
|
||||
how that claim gets quietly broken. */
|
||||
flan_dyn z = flan_dyn_from_bytes((const uint8_t *)"a\0b", 3);
|
||||
check(num(flan_dyn_len(z)) == 3, "len counts past a NUL");
|
||||
check(num(FDYN_at(z, flan_dyn_from_i64(2))) == 'b', "at past a NUL");
|
||||
check(flan_dyn_need_i32(FDYN_at(z, flan_dyn_from_i64(2)), NULL, 0) == 'b', "at past a NUL");
|
||||
check(!truth(flan_dyn_eq(z, text("a"))), "= does not stop at a NUL");
|
||||
}
|
||||
{
|
||||
|
||||
25
test/programs/dyn-char-pinned.flan
Normal file
25
test/programs/dyn-char-pinned.flan
Normal file
@ -0,0 +1,25 @@
|
||||
;;;; A non-ASCII text that has crossed into a str still counts characters,
|
||||
;;;; however many times it crosses; and a char is written through a dyn view of
|
||||
;;;; typed storage as its code point where it fits. With an argument, \é
|
||||
;;;; written into a view of bytes traps.
|
||||
|
||||
(defn byte-len [s str] i32 (length s))
|
||||
|
||||
(defn main [args [str]] i32
|
||||
(let [t (the dyn "é日😀")]
|
||||
(dotimes [i 3] (println (byte-len t)))
|
||||
(println (length t))
|
||||
(println (at t 1))
|
||||
(println (slice t 0 2)))
|
||||
(let [a (the [3 i32] [1 2 3])
|
||||
v (the dyn a)]
|
||||
(set (at v 0) \z)
|
||||
(set (at v 1) \日)
|
||||
(println (at a 0) (at a 1) (at a 2)))
|
||||
(let [b (the [2 u8] [1 2])
|
||||
w (the dyn b)]
|
||||
(set (at w 0) \a)
|
||||
(println (at b 0) (at b 1))
|
||||
(when (> (length args) 1)
|
||||
(set (at w 1) \é)))
|
||||
0)
|
||||
19
test/programs/dyn-char-spell.flan
Normal file
19
test/programs/dyn-char-spell.flan
Normal file
@ -0,0 +1,19 @@
|
||||
;;;; Every ASCII code point, the C1 controls, and a few past them, as dyn chars printed one per
|
||||
;;;; line. The test reads each line back with the reader and wants the same
|
||||
;;;; code point, so what a char prints as is what reads as it.
|
||||
|
||||
(defn main [] i32
|
||||
(let [v (vec-new u8)]
|
||||
(dotimes [i 128] (push v (u8 i)))
|
||||
(let [t (the dyn (str (slice v)))]
|
||||
(dotimes [i (length t)] (println (at t i))))
|
||||
;; the C1 controls, U+0080 to U+009F, and U+00A0, each C2 then one byte
|
||||
(let [w (vec-new u8)]
|
||||
(dotimes [i 33] (push w (u8 0xC2)) (push w (u8 (+ 0x80 i))))
|
||||
(let [c1 (the dyn (str (slice w)))]
|
||||
(dotimes [i (length c1)] (println (at c1 i))))
|
||||
(free w))
|
||||
(let [u (the dyn "é日😀")]
|
||||
(dotimes [i (length u)] (println (at u i))))
|
||||
(free v))
|
||||
0)
|
||||
23
test/programs/dyn-char-string.flan
Normal file
23
test/programs/dyn-char-string.flan
Normal file
@ -0,0 +1,23 @@
|
||||
;;;; A String, and a str made from one, crossing into dyn: the dyn text counts
|
||||
;;;; characters and indexes by them, ASCII or not. A char literal appends to a
|
||||
;;;; String as its code point.
|
||||
|
||||
(defn as-dyn [d] dyn d)
|
||||
|
||||
(defn main [] i32
|
||||
(let [s (string-new "ab")
|
||||
u (string-new "é")]
|
||||
(append u \日)
|
||||
(append u \😀)
|
||||
(append u \!)
|
||||
(let [a (as-dyn s)
|
||||
d (as-dyn u)
|
||||
e (as-dyn (str u))]
|
||||
(println a (length a) (at a 1))
|
||||
(println d (length d) (at d 1) (at d 3))
|
||||
(println (slice d 1 3) (chars d))
|
||||
(println e (length e) (at e 2) (= d e)))
|
||||
(println (length u) (rune-count u))
|
||||
(free s)
|
||||
(free u))
|
||||
0)
|
||||
51
test/programs/dyn-char.flan
Normal file
51
test/programs/dyn-char.flan
Normal file
@ -0,0 +1,51 @@
|
||||
;;;; Dyn chars: a char literal that ends up dyn is a char and prints as its
|
||||
;;;; literal; a dyn text counts characters, not bytes; chars and text convert
|
||||
;;;; between a text and a vec of chars. With an argument, a dyn text handed to
|
||||
;;;; an i32 traps at the call, and with "big" an int past an i32's range does.
|
||||
|
||||
(defn show [x] () (println x))
|
||||
(defn code-point [c i32] i32 c)
|
||||
|
||||
(defn main [args [str]] i32
|
||||
(let [t (the dyn "é日😀 ok")
|
||||
cs (chars t)]
|
||||
;; literals, printed
|
||||
(show \I)
|
||||
(show \é)
|
||||
(show \日)
|
||||
(show \😀)
|
||||
(show [\a \space \( \newline])
|
||||
(show (type-of \é))
|
||||
;; length and indexing count characters
|
||||
(show (length t))
|
||||
(show (at t 0))
|
||||
(show (at t 1))
|
||||
(show (at t 2))
|
||||
(show (at t 4))
|
||||
(show (slice t 1 3))
|
||||
;; chars and text
|
||||
(show cs)
|
||||
(show (length cs))
|
||||
(show (text cs))
|
||||
(show (= (text cs) t))
|
||||
(show (text \日))
|
||||
(show (text [\o \k]))
|
||||
;; equality, ordering, and a char as a map key
|
||||
(show (= (at t 1) \日))
|
||||
(show (= (at t 0) \e))
|
||||
(show (= (at t 4) (the dyn "o")))
|
||||
(show (= (at t 4) (the dyn 111)))
|
||||
(show (< (at t 0) (at t 1)))
|
||||
(show (> (at t 1) (at t 2)))
|
||||
(show (< (at t 4) \é))
|
||||
(show (get {\é 1 \日 2} (at t 1)))
|
||||
;; into typed code: the code point
|
||||
(show (code-point (at t 2)))
|
||||
;; an int that fits goes in too, and a cast agrees with the crossing
|
||||
(show (code-point (the dyn 5)))
|
||||
(show (i32 (the dyn \a)))
|
||||
(when (> (length args) 1)
|
||||
(if (= (at args 1) "big")
|
||||
(show (code-point (the dyn 5000000000)))
|
||||
(show (code-point (the dyn "x"))))))
|
||||
0)
|
||||
66
test/programs/dyn-int-widths.flan
Normal file
66
test/programs/dyn-int-widths.flan
Normal file
@ -0,0 +1,66 @@
|
||||
;;;; A dyn into a typed integer of every width: an int in the width's range
|
||||
;;;; passes, and so does a char's code point where it fits (ASCII only into a
|
||||
;;;; byte). A cast on a dyn is the typed cast after an unbox, so it takes a
|
||||
;;;; char too and wraps as a typed cast does. With an argument, one crossing
|
||||
;;;; out of range traps at its call.
|
||||
|
||||
(defn to-i8 [x i8] i64 (i64 x))
|
||||
(defn to-u8 [x u8] i64 (i64 x))
|
||||
(defn to-i16 [x i16] i64 (i64 x))
|
||||
(defn to-u16 [x u16] i64 (i64 x))
|
||||
(defn to-i32 [x i32] i64 (i64 x))
|
||||
(defn to-u32 [x u32] i64 (i64 x))
|
||||
(defn to-i64 [x i64] i64 x)
|
||||
(defn to-u64 [x u64] u64 x)
|
||||
|
||||
(defn d [x] dyn x)
|
||||
|
||||
(defn main [args [str]] i32
|
||||
(do
|
||||
;; the edges of each width, both ends, and a char at each
|
||||
(println (to-i8 (d -128)) (to-i8 (d 127)) (to-i8 (d \a)))
|
||||
(println (to-u8 (d 0)) (to-u8 (d 255)) (to-u8 (d \a)))
|
||||
(println (to-i16 (d -32768)) (to-i16 (d 32767)) (to-i16 (d \é)))
|
||||
(println (to-u16 (d 0)) (to-u16 (d 65535)) (to-u16 (d \日)))
|
||||
(println (to-i32 (d -2147483648)) (to-i32 (d 2147483647)) (to-i32 (d \😀)))
|
||||
(println (to-u32 (d 0)) (to-u32 (d 4294967295)) (to-u32 (d \😀)))
|
||||
(println (to-i64 (d -9223372036854775807)) (to-i64 (d 9223372036854775807))
|
||||
(to-i64 (d \😀)))
|
||||
(println (to-u64 (d 0)) (to-u64 (d 9223372036854775807)) (to-u64 (d \😀)))
|
||||
;; casts: a char at every width, and the typed cast's wrap
|
||||
(println (i8 (d \a)) (u8 (d \a)) (i16 (d \a)) (u16 (d \a))
|
||||
(i32 (d \a)) (u32 (d \a)) (i64 (d \a)) (u64 (d \a)))
|
||||
(println (u32 (d -1)) (u32 (the i64 -1)) (u8 (d 256)) (u8 (the i64 256)))
|
||||
;; into a typed array and a struct, chars by the same rule
|
||||
(println (sum (d [\a \b])) (pair-sum (d {:a \a :b \日})))
|
||||
(when (> (length args) 1)
|
||||
(let [w (at args 1)]
|
||||
(cond
|
||||
(= w "u8-256") (println (to-u8 (d 256)))
|
||||
(= w "u8-neg") (println (to-u8 (d -1)))
|
||||
(= w "i8-128") (println (to-i8 (d 128)))
|
||||
(= w "i16-big") (println (to-i16 (d 32768)))
|
||||
(= w "u16-big") (println (to-u16 (d 65536)))
|
||||
(= w "i32-big") (println (to-i32 (d 2147483648)))
|
||||
(= w "u32-neg") (println (to-u32 (d -1)))
|
||||
(= w "u64-neg") (println (to-u64 (d -1)))
|
||||
(= w "u8-char") (println (to-u8 (d \é)))
|
||||
(= w "u16-char") (println (to-u16 (d \😀)))
|
||||
(= w "float") (println (to-i64 (d 2.0)))
|
||||
(= w "elem-char") (println (bytes-sum (d [\a \é])))
|
||||
(= w "field-char") (println (pair-sum (d {:a \é :b 1})))
|
||||
:else (println (to-i64 (d "x")))))))
|
||||
0)
|
||||
|
||||
(defn sum [xs [const i32]] i64
|
||||
(let [t (the i64 0)]
|
||||
(dotimes [i (length xs)] (set t (+ t (i64 (at xs i)))))
|
||||
t))
|
||||
|
||||
(defn bytes-sum [xs [const u8]] i64
|
||||
(let [t (the i64 0)]
|
||||
(dotimes [i (length xs)] (set t (+ t (i64 (at xs i)))))
|
||||
t))
|
||||
|
||||
(defstruct Pair [a u8 b i32])
|
||||
(defn pair-sum [p Pair] i64 (+ (i64 (.a p)) (i64 (.b p))))
|
||||
@ -10,7 +10,7 @@
|
||||
|
||||
(defn dvec [] dyn [10 [20 21] 30])
|
||||
(defn dmap [] dyn {:a 1 :b [5 6]})
|
||||
(defn dtext [] dyn "hey")
|
||||
(defn dtext [] dyn "héy")
|
||||
|
||||
(defn main [] ()
|
||||
(let [a [1 2 3]
|
||||
@ -62,6 +62,7 @@
|
||||
(println (get m :b 1))
|
||||
(println (get m :z 1))
|
||||
(println (.a m))
|
||||
;; Dyn text: get counts it as at does.
|
||||
;; Dyn text: get counts it as at does, by character.
|
||||
(println (get (dtext) 1))
|
||||
(println (get (dtext) 2))
|
||||
(println (get (dtext) 3))))
|
||||
|
||||
@ -2235,7 +2235,7 @@ let () =
|
||||
let get_checked_out =
|
||||
"none\n1\n3\nnone\n4\nnone\nnone\n6\nnone\n3\nnone\n\
|
||||
none\n10\n30\nnone\n20\n30\nnone\nnone\n101\nnone\n\
|
||||
nil\n10\n30\nnil\n21\nnil\nnil\n1\nnil\n6\nnil\n1\n101\nnil\n"
|
||||
nil\n10\n30\nnil\n21\nnil\nnil\n1\nnil\n6\nnil\n1\n\\\u{e9}\n\\y\nnil\n"
|
||||
in
|
||||
outputs "get as a checked lookup" "programs/get-checked.flan" get_checked_out;
|
||||
outputs ~opt:"-O0" "get as a checked lookup, -O0" "programs/get-checked.flan"
|
||||
@ -5536,6 +5536,167 @@ level "1"
|
||||
"programs/dyn-type-of.flan" dyn_type_of_out;
|
||||
outputs ~x86:true "dyn: type-of, --x86"
|
||||
"programs/dyn-type-of.flan" dyn_type_of_out;
|
||||
(* Dyn chars: literals printed as literals, non-ASCII included; a text's
|
||||
length, at and slice counting characters; chars and text round trips;
|
||||
equality and ordering by code point; a char as a map key; a char's
|
||||
code point in a typed i32. With an argument, a dyn int at the i32
|
||||
traps at the call. *)
|
||||
let dyn_char_out =
|
||||
"\\I\n\\é\n\\日\n\\😀\n[\\a \\space \\( \\newline]\n:char\n\
|
||||
6\n\\é\n\\日\n\\😀\n\\o\n日😀\n\
|
||||
[\\é \\日 \\😀 \\space \\o \\k]\n6\né日😀 ok\ntrue\n日\nok\n\
|
||||
true\nfalse\nfalse\nfalse\ntrue\nfalse\ntrue\n2\n128512\n5\n97\n"
|
||||
in
|
||||
outputs "dyn: chars" "programs/dyn-char.flan" dyn_char_out;
|
||||
outputs ~opt:"-O0" "dyn: chars, -O0" "programs/dyn-char.flan" dyn_char_out;
|
||||
outputs ~x86:true "dyn: chars, --x86" "programs/dyn-char.flan" dyn_char_out;
|
||||
(* A String, and a str made from one, cross into dyn as text measured
|
||||
like any other: characters counted, ASCII or not. *)
|
||||
let string_char_out =
|
||||
"ab 2 \\b\né日😀! 4 \\日 \\!\n日😀 [\\é \\日 \\😀 \\!]\n\
|
||||
é日😀! 4 \\😀 true\n10 4\n"
|
||||
in
|
||||
outputs "dyn: a String crossing counts chars"
|
||||
"programs/dyn-char-string.flan" string_char_out;
|
||||
outputs ~opt:"-O0" "dyn: a String crossing counts chars, -O0"
|
||||
"programs/dyn-char-string.flan" string_char_out;
|
||||
outputs ~x86:true "dyn: a String crossing counts chars, --x86"
|
||||
"programs/dyn-char-string.flan" string_char_out;
|
||||
(* A text pinned by crossing into a str keeps counting characters (the
|
||||
pin's stamp and the text's measure live in different header fields),
|
||||
and a char writes through a view of typed storage. *)
|
||||
let pinned_out = "9\n9\n9\n3\n\\日\né日\n122 26085 3\n97 2\n" in
|
||||
outputs "dyn: a pinned text counts chars" "programs/dyn-char-pinned.flan"
|
||||
pinned_out;
|
||||
outputs ~opt:"-O0" "dyn: a pinned text counts chars, -O0"
|
||||
"programs/dyn-char-pinned.flan" pinned_out;
|
||||
outputs ~x86:true "dyn: a pinned text counts chars, --x86"
|
||||
"programs/dyn-char-pinned.flan" pinned_out;
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-char-pinned.flan" in
|
||||
let code, text = run exe (Some "x") in
|
||||
let want = "programs/dyn-char-pinned.flan:24:7: dyn set-at: this \
|
||||
element is a u8, and the char \\é is more than one byte" in
|
||||
if code <> 134 || not (contains text want) then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL dyn: \\é into a byte view traps%s\n \
|
||||
got: %S (exit %d)\n"
|
||||
(if x86 then ", --x86" else "") text code
|
||||
end)
|
||||
[ false; true ];
|
||||
(* A dyn into every integer width: both edges pass, a char passes where
|
||||
it fits, a cast takes a char and wraps as the typed cast beside it
|
||||
does; then one trap per width past its range, a char too wide, and a
|
||||
text, each at its own call. *)
|
||||
let widths_out =
|
||||
"-128 127 97\n0 255 97\n-32768 32767 233\n0 65535 26085\n\
|
||||
-2147483648 2147483647 128512\n0 4294967295 128512\n\
|
||||
-9223372036854775807 9223372036854775807 128512\n\
|
||||
0 9223372036854775807 128512\n97 97 97 97 97 97 97 97\n\
|
||||
4294967295 4294967295 0 0\n195 26182\n"
|
||||
in
|
||||
outputs "dyn: every integer width" "programs/dyn-int-widths.flan" widths_out;
|
||||
outputs ~opt:"-O0" "dyn: every integer width, -O0"
|
||||
"programs/dyn-int-widths.flan" widths_out;
|
||||
outputs ~x86:true "dyn: every integer width, --x86"
|
||||
"programs/dyn-int-widths.flan" widths_out;
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-int-widths.flan" in
|
||||
List.iter
|
||||
(fun (arg, want) ->
|
||||
let want = "programs/dyn-int-widths.flan:" ^ want in
|
||||
let code, text = run exe (Some arg) in
|
||||
if code <> 134 || not (contains text want) then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL dyn: %s traps%s\n got: %S (exit %d)\n \
|
||||
wanted: %S (exit 134)\n"
|
||||
arg (if x86 then ", --x86" else "") text code want
|
||||
end)
|
||||
[ ("u8-256", "39:42: dyn: a u8 is wanted here, and the int 256 is \
|
||||
outside a u8's range");
|
||||
("u8-neg", "40:42: dyn: a u8 is wanted here, and the int -1 is \
|
||||
outside a u8's range");
|
||||
("i8-128", "41:42: dyn: an i8 is wanted here, and the int 128 is \
|
||||
outside an i8's range");
|
||||
("i16-big", "42:44: dyn: an i16 is wanted here, and the int 32768");
|
||||
("u16-big", "43:44: dyn: a u16 is wanted here, and the int 65536");
|
||||
("i32-big", "44:44: dyn: an i32 is wanted here, and the int \
|
||||
2147483648");
|
||||
("u32-neg", "45:44: dyn: a u32 is wanted here, and the int -1 is \
|
||||
outside a u32's range");
|
||||
("u64-neg", "46:44: dyn: a u64 is wanted here, and the int -1");
|
||||
("u8-char", "47:43: dyn: a u8 is wanted here, and the char \\é is \
|
||||
more than one byte in UTF-8");
|
||||
("u16-char", "48:45: dyn: a u16 is wanted here, and the char \
|
||||
\\😀, code point 128512, is outside a u16's range");
|
||||
("float", "49:42: dyn: an i64 is wanted here, and this is a \
|
||||
float, 2.0.");
|
||||
("elem-char", "50:49: dyn into [const u8]: element 1 is the \
|
||||
char \\é, which is more than one byte in UTF-8");
|
||||
("field-char", "51:49: dyn into Pair: field :a is the char \\é, \
|
||||
which is more than one byte in UTF-8");
|
||||
("x", "52:34: dyn: an i64 is wanted here, and this is a text, \
|
||||
\"x\". An i64 takes an int or a char's code point") ])
|
||||
[ false; true ];
|
||||
(* Print, then read: each char dyn-char-spell.flan prints — every ASCII
|
||||
code point, the C1 controls, then four past them — reads back as the code point it was,
|
||||
and so does the compiler's own spelling of the same literal, which is
|
||||
what flan convert writes. *)
|
||||
let spelled =
|
||||
List.init 128 Fun.id @ List.init 32 (fun i -> 0x80 + i)
|
||||
@ [ 0xA0; 0xE9; 0x65E5; 0x1F600 ]
|
||||
in
|
||||
let read_char s =
|
||||
match Reader.read_all ~file:"<char>" s with
|
||||
| [ { Form.v = Form.Byte b; _ } ] -> Some b
|
||||
| _ | (exception Loc.Error _) -> None
|
||||
in
|
||||
List.iter
|
||||
(fun cp ->
|
||||
let s = Form.byte_repr cp in
|
||||
if read_char s <> Some cp then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL char %d is written %S, which does not read \
|
||||
back as it\n" cp s
|
||||
end)
|
||||
spelled;
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-char-spell.flan" in
|
||||
let code, text = run exe None in
|
||||
let lines = String.split_on_char '\n' text in
|
||||
let lines = List.filteri (fun i _ -> i < List.length spelled) lines in
|
||||
let got = List.map read_char lines in
|
||||
if code <> 0 || got <> List.map Option.some spelled then begin
|
||||
incr failures;
|
||||
Printf.printf "FAIL dyn chars read back as printed%s\n \
|
||||
got: %S (exit %d)\n"
|
||||
(if x86 then ", --x86" else "") text code
|
||||
end)
|
||||
[ false; true ];
|
||||
List.iter
|
||||
(fun x86 ->
|
||||
let exe = compile ~x86 "programs/dyn-char.flan" in
|
||||
List.iter
|
||||
(fun (arg, want) ->
|
||||
let code, text = run exe (Some arg) in
|
||||
if code <> 134 || not (contains text want) then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
"FAIL dyn: a dyn %s at an i32 traps%s\n got: %S \
|
||||
(exit %d)\n wanted: %S (exit 134)\n"
|
||||
arg (if x86 then ", --x86" else "") text code want
|
||||
end)
|
||||
[ ("x", "programs/dyn-char.flan:50:27: dyn: an i32 is wanted \
|
||||
here, and this is a text, \"x\". An i32 takes an int or \
|
||||
a char's code point");
|
||||
("big", "programs/dyn-char.flan:49:27: dyn: an i32 is wanted \
|
||||
here, and the int 5000000000 is outside an i32's \
|
||||
range") ])
|
||||
[ false; true ];
|
||||
(* (watch "name" v) with nothing arming the table: a struct, an array, a
|
||||
slice, a dyn map and a string all compile against flan_dev.c's watch
|
||||
entry points on both backends, write nothing, and evaluate the value
|
||||
@ -5687,7 +5848,7 @@ level "1"
|
||||
Matched on the half that carries the meaning rather than on the
|
||||
whole sentence, so the row is about the trap being reached with
|
||||
the right two things in hand and not about punctuation. *)
|
||||
|| not (contains text "float, and an int was wanted")
|
||||
|| not (contains text "an i64 is wanted here, and this is a float, 1.5")
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
@ -5735,7 +5896,7 @@ level "1"
|
||||
in
|
||||
if code <> 134
|
||||
|| not (contains text nil_option_out)
|
||||
|| not (contains text "int was wanted")
|
||||
|| not (contains text "an i64 is wanted here, and this is nil.")
|
||||
then begin
|
||||
incr failures;
|
||||
Printf.printf
|
||||
|
||||
@ -253,6 +253,9 @@ let eval_in_frame_checks ~backend ask =
|
||||
expect "(+ n 1)" "4";
|
||||
expect "(.y p)" "2.5";
|
||||
expect "label" "\"inner\"";
|
||||
(* A dyn char answers as the literal that reads back as it. *)
|
||||
expect "(at (chars \"a b\") 1)" "\\space";
|
||||
expect "[\\x (at (chars \"hi\") 1)]" "[\\x \\i]";
|
||||
expect "(do (set flag false) flag)" "false";
|
||||
(match
|
||||
Wire.field (ask "(:op \"locals\" :frame 0)") "locals"
|
||||
|
||||
@ -113,6 +113,10 @@ let () =
|
||||
reads "byte named" "\\space" "\\space";
|
||||
reads "byte digit" "\\0" "\\0";
|
||||
reads "byte paren" "\\(" "\\(";
|
||||
reads "char by \\uXXXX" "\\u0041" "\\A";
|
||||
reads "control char" "\\u0007" "\\u0007";
|
||||
reads "char named" "\\backspace" "\\backspace";
|
||||
reads "non-ASCII char" "\\日" "\\日";
|
||||
reads "byte dot" "\\." "\\.";
|
||||
|
||||
(* ── Sequences ─────────────────────────────────────────────────── *)
|
||||
@ -3178,6 +3182,22 @@ let () =
|
||||
accepts "the fix a class-named-kind refusal offers compiles"
|
||||
"(defclass map-value [a])\n\
|
||||
(defn main [] i32 (if (= (type-of (map-value 1)) :map-value) 0 1))";
|
||||
(* A char literal past ASCII is not a byte: it is refused by its name at a
|
||||
u8, whichever operand of = it is, and pushing it into bytes too. *)
|
||||
rejects_check "a non-ASCII char is not a u8"
|
||||
"(defn main [] i32 (let [b (the u8 1)] (if (= b \\é) 1 0)))"
|
||||
~needle:"\\é is 2 bytes in UTF-8, not one, so it is not a u8";
|
||||
rejects_check "and not on the left of = either"
|
||||
"(defn main [] i32 (let [b (the u8 1)] (if (= \\日 b) 1 0)))"
|
||||
~needle:"\\日 is 3 bytes in UTF-8";
|
||||
rejects_check "nor pushed into bytes"
|
||||
"(defn main [] i32 (let [v (vec-new u8)] (push v \\é) 0))"
|
||||
~needle:"Write the str \"é\" for its bytes";
|
||||
rejects_check "a code point past a u16"
|
||||
"(defn main [] i32 (let [b (the u16 1)] (if (= b \\😀) 1 0)))"
|
||||
~needle:"\\😀 is code point 128512, which does not fit in a u16";
|
||||
accepts "an ASCII char is a u8"
|
||||
"(defn main [] i32 (let [b (the u8 97)] (if (= b \\a) 0 1)))";
|
||||
rejects_check "type-of takes one argument"
|
||||
"(defn main [] i32 (let [k (type-of 1 2)] 0))" ~needle:"type-of";
|
||||
(* The constructor is an ordinary function, so its arity is the ordinary
|
||||
|
||||
@ -495,6 +495,9 @@ let () =
|
||||
(* Characters, lexed before brackets and separators. *)
|
||||
reads "character literals" "x = [\\( \\, \\space \\)]" "(set x [\\( \\, \\space \\)])";
|
||||
reads "character arguments" "f(\\,, \\))" "(f \\, \\))";
|
||||
reads "character spellings"
|
||||
"x = [\\u0041 \\u0007 \\backspace \\formfeed \\日]"
|
||||
"(set x [\\A \\u0007 \\backspace \\formfeed \\日])";
|
||||
(* Keywords and annotations. *)
|
||||
reads "keyword" "let k = :else" "(def k dyn :else)";
|
||||
reads "annotation" "once grid: [4 [8 u32]]" "(defonce grid [4 [8 u32]])";
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user