Merge master into the .fln optionals lane.

This commit is contained in:
Joseph Ferano 2026-09-26 15:52:00 +07:00
commit 8afa054349
23 changed files with 951 additions and 112 deletions

View File

@ -10,6 +10,12 @@ pointing at it. A CANCELLED entry carries the one-line reason, because an idea
rejected without a record is an idea that gets re-proposed. rejected without a record is an idea that gets re-proposed.
* Language surface * Language surface
** DONE A literal's reading is fixed where it is bound
CLOSED: [2026-09-26]
Decision 132, clarifying 117: a vector, map or text literal is typed only when its own
binding is annotated or it is passed straight to a typed parameter; a later typed use
converts the dyn value at that site. Rules out a later line changing what an earlier
line prints.
** NEXT .fln is the only source language ** NEXT .fln is the only source language
Decided 2026-09-26 (130): the .flan syntax is retired. .fln names carry no =?= or =!=; Decided 2026-09-26 (130): the .flan syntax is retired. .fln names carry no =?= or =!=;
predicates are =is-=/=has-=, and the raylib generator emits =is-key-pressed=. Swift predicates are =is-=/=has-=, and the raylib generator emits =is-key-pressed=. Swift
@ -36,12 +42,6 @@ Decided 2026-09-26 (128) to pause: dyn vectors are mutable, so taking from the f
shifts every element. Options were a linked list (cons/first/rest) or storing the dyn shifts every element. Options were a linked list (cons/first/rest) or storing the dyn
vector as a ring buffer with a cheap read-only rest view; the ring buffer was vector as a ring buffer with a cheap read-only rest view; the ring buffer was
recommended. Waits on a program that needs it. recommended. Waits on a program that needs it.
** NEXT A typed char
Decided 2026-09-26 (127): =char= is a typed code point. A char literal is typed by local
inference like a number literal: u8 or i32 where typed code wants a number (a literal
above 127 is refused as a u8), =char= otherwise; a =char= crossing into dyn stays a char.
Rules out the fork where =f(\a)= printed =\a= and =let c = \a= then =f(c)= printed 97.
Waits on the dyn char lane and the literal inference lane.
** DONE if let ** DONE if let
CLOSED: [2026-09-26] CLOSED: [2026-09-26]
=(if-let [P v] then else)= in paren syntax; an elif chain is the else. With no else it =(if-let [P v] then else)= in paren syntax; an elif chain is the else. With no else it
@ -61,15 +61,29 @@ builders return =String=; =(Vec u8)= stays for raw bytes. Text is UTF-8 everywhe
a character is a code point; length and indexing count bytes on str. Waits on the a character is a code point; length and indexing count bytes on str. Waits on the
dyn-unless-annotated design. dyn-unless-annotated design.
** DONE A typed char
CLOSED: [2026-09-26]
Decision 127: a char literal is the number typed code wants there, and a =char= otherwise,
an untyped array of char literals included; a =char= crosses into dyn as a dyn char, and
only a dyn char unboxes into one. =(i32 c)= and =(char n)= convert, the latter checked.
Decision 131, Kotlin's: char ± int and int + char are a char, trapping off a scalar value
(refused when constant); char - char is an i32; anything else, and comparing with an int,
is refused; dyn does the same. A let-bound char beside an integer literal stays a char.
An untyped defconst of one is that literal where a number is wanted.
Printed as dyn prints one (129a). =runes-next= and =rune-at= give a char; the
UTF-8 codec (=decode-rune=, =encode-rune=) stays on i32. Rules out the f(\a) fork.
** DONE Dyn has a char, and dyn text counts characters ** DONE Dyn has a char, and dyn text counts characters
CLOSED: [2026-09-26] CLOSED: [2026-09-26]
Only a char literal, =at= on a text and =chars= make one, and it prints as its Only a char literal, =at= on a text and =chars= make one. =println= prints it as the
literal, bare too, a control character as \\uXXXX. Into any integer width it gives its character itself (129a); inside a value, in the inspector and the REPL it is its
literal, 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 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 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 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 literal defaults to i32 and is refused where a byte is wanted. Rules out a typed code
arithmetic, a typed code point turning into a char, and byte offsets on dyn text. point turning into a char unless =(char n)= says so, and byte offsets on dyn text. Char
arithmetic is decision 131's, under "A typed char".
** DONE String is a prelude struct over (Vec u8), kept valid by the checker ** DONE String is a prelude struct over (Vec u8), kept valid by the checker
CLOSED: [2026-09-26] CLOSED: [2026-09-26]
@ -786,6 +800,9 @@ One spelling for one operation; != stays, and not= is refused with a suggestion
of !=. of !=.
* Checker * Checker
** TODO A dyn operand past the second in a + fold is converted to the running type
=(+ 1 2 d)= with d a dyn char prints 100: the dyn is unboxed to i32 before adding, where
rule 117 says typed beside dyn gives dyn (=(+ 3 d)= gives =\d=). Predates the char lane.
** WAIT Checking a wide fold of let operands is slow ** WAIT Checking a wide fold of let operands is slow
Parked 2026-09-26: design first; remeasure on a quiet machine, it was timed under load 20. Parked 2026-09-26: design first; remeasure on a quiet machine, it was timed under load 20.
A 2000-operand (bit-and (let …) …) takes 32 s to check (37 s before the bit operators); A 2000-operand (bit-and (let …) …) takes 32 s to check (37 s before the bit operators);

View File

@ -1902,7 +1902,7 @@ lambda or a `Fn(...)' type, and not after a match arm's."
(flan-fln--return-type-matcher 1 font-lock-type-face) (flan-fln--return-type-matcher 1 font-lock-type-face)
;; The package half of a qualified name, as `flan-mode' draws it. ;; The package half of a qualified name, as `flan-mode' draws it.
("\\_<\\([a-zA-Z][a-zA-Z0-9!?*+=<>._-]*/\\)" 1 font-lock-type-face) ("\\_<\\([a-zA-Z][a-zA-Z0-9!?*+=<>._-]*/\\)" 1 font-lock-type-face)
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|str\\|dyn\\|Never\\|Allocator\\|String\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>" ("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|char\\|str\\|dyn\\|Never\\|Allocator\\|String\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
. font-lock-type-face) . font-lock-type-face)
("\\_<\\$[^][ \t\n(){},;\":]*" . font-lock-type-face) ("\\_<\\$[^][ \t\n(){},;\":]*" . font-lock-type-face)
;; A character literal, `\c' or `\space'. ;; A character literal, `\c' or `\space'.

View File

@ -179,15 +179,15 @@ face says.")
;; containers and memory ;; containers and memory
"length" "at" "slice" "slice-from" "addr" "deref" "length" "at" "slice" "slice-from" "addr" "deref"
;; options, bytes, the host ;; options, bytes, the host
"Some" "bytes" "bytes-view" "str" "Some" "bytes" "bytes-view" "str" "char"
"bytes->f64" "bytes->i64" "f64->bytes" "i64->bytes" "bytes->f64" "bytes->i64" "f64->bytes" "i64->bytes"
"write-stdout" "print" "println" "exit" "argv") "write-stdout" "print" "println" "exit" "argv")
"The functions the compiler provides, from `lib/check.ml''s `builtins' table. "The functions the compiler provides, from `lib/check.ml''s `builtins' table.
Ordinary calls — nothing here is special to the parser — so they are drawn as Ordinary calls — nothing here is special to the parser — so they are drawn as
builtins and not as keywords. `str' is in this list and in the type rule builtins and not as keywords. `str' and `char' are in this list and in the
below and means a different thing in each: `(str b)' converts and a bare type rule below and mean a different thing in each: `(str b)' converts and a
`str' names a type, which the rules tell apart by the paren. bare `str' names a type, which the rules tell apart by the paren.
`destructure~nth' is in the table and not here: the compiler writes it into a `destructure~nth' is in the table and not here: the compiler writes it into a
destructuring `let' and nobody types it. destructuring `let' and nobody types it.
@ -257,7 +257,7 @@ reason and is the odd one — it is legal only as the last item of a `def' or a
;; word outright — unit is spelled `()'. Drawing it as a valid type would ;; word outright — unit is spelled `()'. Drawing it as a valid type would
;; advertise a spelling the parser rejects, which is the same reason ;; advertise a spelling the parser rejects, which is the same reason
;; `find-restart' and `await' are left out of `flan--special'. ;; `find-restart' and `await' are left out of `flan--special'.
("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|str\\|dyn\\|const\\|int\\|float\\|Never\\|Allocator\\|String\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>" ("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|char\\|str\\|dyn\\|const\\|int\\|float\\|Never\\|Allocator\\|String\\|Ptr\\|Option\\|Vec\\|Map\\|C?Fn\\)\\_>"
. font-lock-type-face) . font-lock-type-face)
;; A type variable, `$t', which is what a generic `defn' names its ;; A type variable, `$t', which is what a generic `defn' names its
;; parameter types with and what `{:where (is-ordered $t)}' constrains. ;; parameter types with and what `{:where (is-ordered $t)}' constrains.

View File

@ -571,9 +571,7 @@ let nearest cands n = List.find_opt (fun c -> c <> n && one_edit n c) cands
spelling is still a name this language does not have. spelling is still a name this language does not have.
Short on purpose, and only names with one honest answer. [char] is not Short on purpose, and only names with one honest answer. [char] is not
here: C's is a byte, Java's is a UTF-16 unit and Rust's is a scalar value, here: it is this language's own code point type. Nor [void]: it is a return type and the
and this language has [u8] and rune functions, so there is nothing to
translate it to in three words. Nor [void]: it is a return type and the
answer there is the shape [()], which is [parse]'s message to give and not answer there is the shape [()], which is [parse]'s message to give and not
this one's. Nor [usize] and [size_t]: the honest answer is "as wide as a this one's. Nor [usize] and [size_t]: the honest answer is "as wide as a
pointer on this target", which is [u64] on x86-64 and [u32] on wasm32, and pointer on this target", which is [u64] on x86-64 and [u32] on wasm32, and
@ -2075,6 +2073,7 @@ and resolve_name env ~seen loc n =
| None -> | None ->
match n with match n with
| "bool" -> Types.Bool | "bool" -> Types.Bool
| "char" -> Types.Char
| "str" -> Types.String | "str" -> Types.String
(* Lowercase and concrete, which the rule three screens down says is a (* Lowercase and concrete, which the rule three screens down says is a
type variable. It is spelled this way because it is a primitive and type variable. It is spelled this way because it is a primitive and
@ -2206,7 +2205,7 @@ and array_len env loc = function
let is_type_name env n = let is_type_name env n =
Types.ikind_of_name n <> None Types.ikind_of_name n <> None
|| Types.fkind_of_name n <> None || Types.fkind_of_name n <> None
|| List.mem n [ "bool"; "str"; "dyn"; "Unit"; "Never"; "Allocator" ] || List.mem n [ "bool"; "char"; "str"; "dyn"; "Unit"; "Never"; "Allocator" ]
|| Hashtbl.mem env.aliases n || Hashtbl.mem env.aliases n
|| Hashtbl.mem env.structs n || Hashtbl.mem env.structs n
|| Hashtbl.mem env.gstructs n || Hashtbl.mem env.gstructs n
@ -3132,6 +3131,17 @@ let check_fn_ref : (env -> Ast.fn -> Tast.fn) ref =
(* ── Small helpers over the AST ────────────────────────────────────── *) (* ── Small helpers over the AST ────────────────────────────────────── *)
(* The untyped defconsts whose value is a char literal, by name, with the
code point. A use where typed code wants a number is that literal at the
number's type, as the literal written there would be, so a byte constant
such as (defconst sep \,) still compares with a u8 (decision 127). Filled
by the declaration pass of the program being checked. *)
let char_consts : (string, int) Hashtbl.t = Hashtbl.create 8
(* A [+] or [-] pair found to be char arithmetic after the ordinary join
refused it, with both operands checked on their own terms. *)
exception Char_pair of Tast.expr * Tast.expr
(* Untyped literals: their machine type comes from context, so when one is an (* Untyped literals: their machine type comes from context, so when one is an
operand of a binary operator we look at the *other* operand first. *) operand of a binary operator we look at the *other* operand first. *)
let is_literal (e : Ast.expr) = let is_literal (e : Ast.expr) =
@ -3764,19 +3774,20 @@ let lit_kind (e : Ast.expr) =
reading is the literal's own and not one a use names. *) reading is the literal's own and not one a use names. *)
let lit_default (_ : Ast.expr) = function let lit_default (_ : Ast.expr) = function
| `Int -> Types.Int Types.I32 | `Int -> Types.Int Types.I32
| `Char -> Types.Int Types.U8 | `Char -> Types.Char
| `Float -> Types.Float (float_default ()) | `Float -> Types.Float (float_default ())
| `Box -> Types.Dyn | `Box -> Types.Dyn
(* The types a use can give it: any number for an integer or a character, (* The types a use can give it: any number for an integer or a character,
since an untyped integer constant is usable where a float is wanted, and since an untyped integer constant is usable where a float is wanted, and
only a float for a float. A type variable is admitted and left to only a float for a float. A character may also be a char, its own type. A type variable is admitted and left to
[int_literal] to judge against its bound. Anything else — dyn, a struct — [int_literal] to judge against its bound. Anything else — dyn, a struct —
says nothing about the literal's type; the local keeps its guess and the says nothing about the literal's type; the local keeps its guess and the
use is checked as it always was. *) use is checked as it always was. *)
let lit_admits kind (t : Types.t) = let lit_admits kind (t : Types.t) =
match kind, t with match kind, t with
| (`Int | `Char), (Types.Int _ | Types.Float _ | Types.Var _) -> true | (`Int | `Char), (Types.Int _ | Types.Float _ | Types.Var _) -> true
| `Char, Types.Char -> true
| `Float, (Types.Float _ | Types.Var _) -> true | `Float, (Types.Float _ | Types.Var _) -> true
| `Box, t -> not (Types.equal t Types.Dyn) | `Box, t -> not (Types.equal t Types.Dyn)
| _ -> false | _ -> false
@ -3854,7 +3865,10 @@ let lit_solve (s : lit_session) =
let cons = let cons =
List.concat_map (fun m -> List.rev (Hashtbl.find_all s.cons m)) ms List.concat_map (fun m -> List.rev (Hashtbl.find_all s.cons m)) ms
|> List.filter_map (fun (c, t, l) -> |> List.filter_map (fun (c, t, l) ->
if kind <> `Box && Types.equal t Types.Dyn then Some (Hint, dyn_width, l) (* A character meeting dyn stays a char, which crosses as
a dyn char; a number takes the dyn width. *)
if kind = `Char && Types.equal t Types.Dyn then None
else if kind <> `Box && Types.equal t Types.Dyn then Some (Hint, dyn_width, l)
else if lit_admits kind t then Some (c, t, l) else if lit_admits kind t then Some (c, t, l)
else None) else None)
in in
@ -3928,8 +3942,8 @@ let no_dyn_yet loc ~into t extra =
(* A typed container crossing into dyn is a view, and the runtime needs to (* A typed container crossing into dyn is a view, and the runtime needs to
know what one element is: its descriptor, a prefix code runtime/flan_dyn.c know what one element is: its descriptor, a prefix code runtime/flan_dyn.c
documents beside [desc_lay] and reads offsets out of by C's layout rule. documents beside [desc_lay] and reads offsets out of by C's layout rule.
Every number, bool, str, struct of those, and fixed array, slice or Vec of Every number, bool, char, str, struct of those, and fixed array, slice or
those can be described. [Error t] names the first type inside that cannot: Vec of those can be described. [Error t] names the first type inside that cannot:
a dyn, a pointer, a function, an Option, a map, an enum or a data type. a dyn, a pointer, a function, an Option, a map, an enum or a data type.
None of those is refused for want of a descriptor letter — each is one a None of those is refused for want of a descriptor letter — each is one a
dyn value cannot be read out of or written into without a meaning dyn value cannot be read out of or written into without a meaning
@ -3949,6 +3963,7 @@ let rec view_desc ?(into = false) structs (t : Types.t)
| Types.Float Types.F32 -> Ok "f" | Types.Float Types.F32 -> Ok "f"
| Types.Float Types.F64 -> Ok "d" | Types.Float Types.F64 -> Ok "d"
| Types.Bool -> Ok "?" | Types.Bool -> Ok "?"
| Types.Char -> Ok "C"
| Types.String -> Ok "t" | Types.String -> Ok "t"
| Types.Array (n, e) -> | Types.Array (n, e) ->
let* d = view_desc structs e in let* d = view_desc structs e in
@ -4386,6 +4401,8 @@ let box ?ctx loc (e : Tast.expr) : Tast.expr =
(* The ABI takes an [int32_t], because a C signature that says [_Bool] is a (* The ABI takes an [int32_t], because a C signature that says [_Bool] is a
width argument nobody wants to have. *) width argument nobody wants to have. *)
| Types.Bool -> dyn "flan_dyn_from_bool" [ widen loc (Types.Int Types.I32) e ] | Types.Bool -> dyn "flan_dyn_from_bool" [ widen loc (Types.Int Types.I32) e ]
(* A typed char stays a char on the dyn side (decision 127). *)
| Types.Char -> dyn "flan_dyn_from_char" [ widen loc (Types.Int Types.I32) e ]
(* A string is ptr+len and arrives as two arguments, the way every other (* A string is ptr+len and arrives as two arguments, the way every other
(ptr, len) entry point in the runtime takes one. The runtime copies: the (ptr, len) entry point in the runtime takes one. The runtime copies: the
bytes may be a literal or a slice of a buffer the program goes on to bytes may be a literal or a slice of a buffer the program goes on to
@ -4519,6 +4536,8 @@ let unbox loc (want : Types.t) (e : Tast.expr) : Tast.expr =
language's own cast and cannot fail — the runtime already decided 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. *) 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)) widen loc Types.Bool (need "flan_dyn_need_bool" (Types.Int Types.I32))
(* Only a dyn char: an int is a number until (char n) converts it. *)
| Types.Char -> rt loc Types.Char "flan_dyn_need_char" [ e; here loc ]
(* Any integer width, checked at run time at this site (TODO.org, "Dyn (* 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 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 where it fits — ASCII only into a byte, since a byte past ASCII is not
@ -5054,7 +5073,7 @@ let barrier ctx what f =
is the only case that does. *) is the only case that does. *)
let rec bytewise_key = function let rec bytewise_key = function
| Types.Int _ | Types.Enum _ | Types.Bool -> true | Types.Int _ | Types.Enum _ | Types.Bool | Types.Char -> true
| Types.Array (_, t) -> bytewise_key t | Types.Array (_, t) -> bytewise_key t
| _ -> false | _ -> false
@ -5206,7 +5225,8 @@ let condition_desc ctx loc name =
ei64 = (fun x -> emit (to_bytes hctx loc Tast.I64ToBytes x)); ei64 = (fun x -> emit (to_bytes hctx loc Tast.I64ToBytes x));
eu64 = (fun x -> emit (to_bytes hctx loc Tast.U64ToBytes x)); eu64 = (fun x -> emit (to_bytes hctx loc Tast.U64ToBytes x));
ef64 = (fun x -> emit (to_bytes hctx loc Tast.F64ToBytes x)); ef64 = (fun x -> emit (to_bytes hctx loc Tast.F64ToBytes x));
edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_emit_msg", [ x ]))) } edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_emit_msg", [ x ])));
enested = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_emit_msg", [ x ]))) }
in in
let value = let value =
mk loc ty (Tast.Deref (mk loc (Types.Ptr (Types.Mut, ty)) (Tast.Local pslot))) mk loc ty (Tast.Deref (mk loc (Types.Ptr (Types.Mut, ty)) (Tast.Local pslot)))
@ -6080,8 +6100,7 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr =
n (tyname loc t) gname var (Int64.neg n) n n (tyname loc t) gname var (Int64.neg n) n
| Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n | Ast.Int n -> int_literal loc ~want ~preds:ctx.env.tvpreds n
| Ast.UInt (n, s) -> wide_literal loc ~want n s | 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 (* A char literal that ends up dyn is a dyn char, never an int. *)
point that crosses later is an int, because only the literal says char. *)
| Ast.Byte b when want = Some Types.Dyn -> | Ast.Byte b when want = Some Types.Dyn ->
rt loc Types.Dyn "flan_dyn_from_char" rt loc Types.Dyn "flan_dyn_from_char"
[ mk loc (Types.Int Types.I32) (Tast.Int (Int64.of_int b, Types.I32)) ] [ mk loc (Types.Int Types.I32) (Tast.Int (Int64.of_int b, Types.I32)) ]
@ -6108,12 +6127,16 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr =
Loc.failk literal_at_want loc Loc.failk literal_at_want loc
"%s is code point %d, which does not fit in a %s. Take its code point \ "%s is code point %d, which does not fit in a %s. Take its code point \
as an i32" c b t as an i32" c b t
(* A non-ASCII literal is a code point, which a u8 cannot hold as itself: (* Where typed code wants a number the literal is that number, as an integer
its default is the prelude's rune, an i32. *) literal would be; everywhere else it is a char (decision 127). *)
| Ast.Byte b
when (match want with
| Some (Types.Int _ | Types.Float _) -> true
| Some (Types.Var v) -> declares ctx.env.tvpreds v "is-numeric"
| _ -> false) ->
int_literal loc ~want ~preds:ctx.env.tvpreds (Int64.of_int b)
| Ast.Byte b -> | Ast.Byte b ->
int_literal loc ~want ~preds:ctx.env.tvpreds expect ctx loc ~want (mk loc Types.Char (Tast.Int (Int64.of_int b, Types.U32)))
~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 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 the ABI carries one width and the literal is built at it. f64 is already
what an unconstrained float literal defaults to, so this only has to stop what an unconstrained float literal defaults to, so this only has to stop
@ -6738,6 +6761,13 @@ and int_literal loc ~want ?(preds = []) ?(default = Types.I32) n =
declares $%s numeric. Write {:where (is-numeric $%s)} at the head of \ declares $%s numeric. Write {:where (is-numeric $%s)} at the head of \
the body" the body"
n v v v n v v v
| Some Types.Char ->
Loc.failk literal_at_want loc
"the integer literal %Ld is not a char, and a char compares only with \
a char. Take its code point with %s, or make a char with %s"
n (if Source.indented_at loc then "i32(c)" else "(i32 c)")
(if Source.indented_at loc then Printf.sprintf "char(%Ld)" n
else Printf.sprintf "(char %Ld)" n)
| Some other when other <> Types.Never -> | Some other when other <> Types.Never ->
Loc.failk literal_at_want loc "expected %s, found the integer literal %Ld" Loc.failk literal_at_want loc "expected %s, found the integer literal %Ld"
(tyname loc other) n (tyname loc other) n
@ -6922,6 +6952,12 @@ and var ctx ?(qualified = false) loc ~want name =
expect ctx loc ~want (mk loc b.bty (Tast.Local b.slot)) expect ctx loc ~want (mk loc b.bty (Tast.Local b.slot))
| None -> | None ->
match Hashtbl.find_opt ctx.env.globals name with match Hashtbl.find_opt ctx.env.globals name with
| Some _
when Hashtbl.mem char_consts name
&& (match want with
| Some (Types.Int _ | Types.Float _) -> true
| _ -> false) ->
check ctx ?want { Ast.e = Ast.Byte (Hashtbl.find char_consts name); loc }
| Some (ty, _) -> | Some (ty, _) ->
expect ctx loc ~want (mk loc ty (Tast.Global name)) expect ctx loc ~want (mk loc ty (Tast.Global name))
| None -> | None ->
@ -9866,7 +9902,7 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = fals
two lowerings for the test, so a match over a dyn means what [=] over two lowerings for the test, so a match over a dyn means what [=] over
it means. [is_equatable]'s set minus the enums, which are above, and it means. [is_equatable]'s set minus the enums, which are above, and
minus bool, below. *) minus bool, below. *)
| (Types.Int _ | Types.Float _ | Types.String | Types.Dyn) as t -> `Lit t | (Types.Int _ | Types.Float _ | Types.Char | Types.String | Types.Dyn) as t -> `Lit t
(* A bool is a two-member enum spelled true and false: the same chain, (* A bool is a two-member enum spelled true and false: the same chain,
and exhaustive without a [_] once both are named. *) and exhaustive without a [_] once both are named. *)
| Types.Bool -> `Bool | Types.Bool -> `Bool
@ -9946,6 +9982,7 @@ and check_match ctx ?(tail = false) ?(used = false) ?(stmt = false) ?(opt = fals
match e.Ast.e, t with match e.Ast.e, t with
| Ast.Str _, _ -> "is a string" | Ast.Str _, _ -> "is a string"
| _, Types.String -> "is a number" | _, Types.String -> "is a number"
| (Ast.Int _ | Ast.UInt _ | Ast.Float _), Types.Char -> "is a number"
| Ast.Float x, Types.Int _ when not (Float.is_integer x) -> | Ast.Float x, Types.Int _ when not (Float.is_integer x) ->
"is not a whole number" "is not a whole number"
| Ast.Float _, Types.Int _ -> "is a float" | Ast.Float _, Types.Int _ -> "is a float"
@ -11470,6 +11507,7 @@ and not_numeric name what (a : Tast.expr) =
let where = a.Tast.loc in let where = a.Tast.loc in
if a.Tast.ty = Types.Bool && String.equal what "integers" then if a.Tast.ty = Types.Bool && String.equal what "integers" then
bool_bits where name bool_bits where name
else if a.Tast.ty = Types.Char then char_arith where name
else if text then else if text then
fail where fail where
"%s takes %s, and this is %s — there is no %s on text. The prelude \ "%s takes %s, and this is %s — there is no %s on text. The prelude \
@ -11478,6 +11516,102 @@ and not_numeric name what (a : Tast.expr) =
else else
fail where "%s takes %s, found %s" name what (tyname where a.Tast.ty) fail where "%s takes %s, found %s" name what (tyname where a.Tast.ty)
(* What a char refuses: every operator but [+] and [-] with an integer and
[-] with a char ([char_step], decision 131). The refusal names the two
conversions. *)
and char_arith loc name =
let fln = fln_source loc in
Loc.failk "check/char-arithmetic" loc
"%s. Take its code point with %s, and make a char of one with %s"
(match name with
| "+" -> "+ adds an integer to a char, and not a char to a char"
| "-" -> "- takes an integer or a char from a char, and not a char from \
an integer"
| _ -> name ^ " does no arithmetic on a char")
(if fln then "i32(c)" else "(i32 c)")
(if fln then "char(n)" else "(char n)")
(* One step of char arithmetic (decision 131, Kotlin's rules): a char plus or
minus an integer is a char, checked to be a scalar value — at compile time
when both sides are constants, at run time otherwise — and a char minus a
char is the distance between them, an integer at the width the site wants
(i32 when it wants none), as any integer expression is. A step with no char
in it is the ordinary one. Anything else with a char in it is refused. *)
and char_step ~want loc name (a : Tast.expr) (b : Tast.expr) : Tast.expr =
let i64 e = widen loc dyn_i64 e in
let const (e : Tast.expr) =
match e.Tast.e with Tast.Int (n, _) -> Some n | _ -> None
in
let op = if String.equal name "+" then Tast.Add else Tast.Sub in
let scalar n =
Int64.compare n 0L >= 0 && Int64.compare n 0x10ffffL <= 0
&& not (Int64.compare n 0xd800L >= 0 && Int64.compare n 0xdfffL <= 0)
in
let not_scalar n =
Loc.failk "check/char-range" loc
"this is %s, which is not a Unicode scalar value, so it is not a \
char. A char is a code point from 0 to 0x10FFFF, outside 0xD800 \
to 0xDFFF" n
in
let kind = match want with Some (Types.Int k) -> k | _ -> Types.I32 in
match a.Tast.ty, b.Tast.ty with
| Types.Char, Types.Char when String.equal name "-" ->
let t = Types.Int kind in
(match const a, const b with
| Some x, Some y -> int_literal loc ~want:(Some t) (Int64.sub x y)
| _ -> mk loc t (Tast.Prim (Tast.Sub, [ widen loc t a; widen loc t b ])))
| Types.Char, Types.Int k | Types.Int k, Types.Char
when not (String.equal name "-" && b.Tast.ty = Types.Char) ->
let c, n = if a.Tast.ty = Types.Char then a, b else b, a in
(match const c, const n with
(* A u64 past the largest i64 is held as a negative i64: no char. *)
| Some _, Some v when k = Types.U64 && Int64.compare v 0L < 0 ->
not_scalar (Printf.sprintf "past 0x10FFFF")
| Some x, Some y ->
let r = if op = Tast.Add then Int64.add x y else Int64.sub x y in
if scalar r then mk loc Types.Char (Tast.Int (r, Types.U32))
else not_scalar (Int64.to_string r)
(* The runtime takes the integer as itself — a u64 unsigned, anything
else as an i64 — and checks the sum for overflow, so no large one
wraps round to a char or to a wrong number in the trap. *)
| _ ->
rt loc Types.Char
(if k = Types.U64 then "flan_char_step_u64" else "flan_char_step_i64")
[ widen loc (Types.Int Types.I32) c;
(if k = Types.U64 then n else i64 n);
mk loc (Types.Int Types.I32)
(Tast.Int ((if op = Tast.Sub then 1L else 0L), Types.I32));
here loc ])
| _ ->
char_arith (if a.Tast.ty = Types.Char then a.Tast.loc else b.Tast.loc) name;
assert false
(* Whether [e] may be a char, read off its form without checking it: a name
bound to one, a (char n), a function returning one, or [+]/[-] over any
of those. What decides whether a [+] or [-] is checked as char
arithmetic before the want of its site reaches its operands. A char
literal is not on the list: beside a number it is that number. *)
and maybe_char ctx (e : Ast.expr) =
match e.Ast.e with
| Ast.Var n ->
(match lookup ctx n with
| Some b -> b.bty = Types.Char
| None ->
match peek_outer ctx n with
| Some b -> b.bty = Types.Char
| None ->
(match Hashtbl.find_opt ctx.env.globals n with
| Some (t, _) -> t = Types.Char
| None -> false))
| Ast.Call ({ Ast.e = Ast.Var "char"; _ }, [ _ ]) -> true
| Ast.Call ({ Ast.e = Ast.Var ("+" | "-"); _ }, args) ->
List.exists (maybe_char ctx) args
| Ast.Call ({ Ast.e = Ast.Var f; _ }, _) ->
(match Hashtbl.find_opt ctx.env.fns f with
| Some (_, r) -> r = Types.Char
| None -> false)
| _ -> false
(* ── A conversion whose operand is a type variable ───────────────────── (* ── A conversion whose operand is a type variable ─────────────────────
[(i32 x)] where [x] is a [$t]. The concrete question — is this a number — [(i32 x)] where [x] is a [$t]. The concrete question — is this a number —
has no answer during the abstract pass, and asking it anyway is what has no answer during the abstract pass, and asking it anyway is what
@ -11555,11 +11689,63 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args =
let x, y, rest = let x, y, rest =
match args with x :: y :: rest -> x, y, rest | _ -> assert false match args with x :: y :: rest -> x, y, rest | _ -> assert false
in in
let a, b = binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) [ x; y ] in let charish = String.equal name "+" || String.equal name "-" in
let nwant = numeric_want want in
(* A char literal is a char here, not the number, when no number is
wanted; one that may be a char by its form keeps the want off the pair,
which a char minus a char answers at the want's width itself. *)
let int_lit (e : Ast.expr) = match e.Ast.e with Ast.Int _ -> true | _ -> false in
(* A char literal later in the chain is a char only while everything
before it is an integer literal too; beside a typed number it is that
number, as in (+ b c \0) over bytes. *)
let untyped = ref (int_lit x && int_lit y) in
let char_lit (e : Ast.expr) =
match e.Ast.e with Ast.Byte _ -> nwant = None && !untyped | _ -> false
in
let a, b =
try
(match x.Ast.e, y.Ast.e with
| Ast.Int _, Ast.Byte _ when charish && nwant = None ->
raise_notrace (Char_pair (check ctx x, check ctx y))
| _ -> ());
let pwant = if charish && (maybe_char ctx x || maybe_char ctx y) then None else nwant in
char_operands ctx ~charish name [ x; y ] (fun () ->
binary ctx ~dyn_ok:true ~char_ok:charish name loc ~want:pwant [ x; y ])
with Char_pair (a, b) -> a, b
in
(* One dyn operand makes the whole fold dyn, whichever side it is on. The (* One dyn operand makes the whole fold dyn, whichever side it is on. The
typed side is boxed by [dyn_fold]; a literal was already built at dyn by typed side is boxed by [dyn_fold]; a literal was already built at dyn by
[binary], so [(+ x 1)] over a dyn x folds an i64 one. *) [binary], so [(+ x 1)] over a dyn x folds an i64 one. *)
if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then let is_char (e : Tast.expr) = e.Tast.ty = Types.Char in
if charish && a.Tast.ty <> Types.Dyn && b.Tast.ty <> Types.Dyn
&& (is_char a || is_char b
|| List.exists (maybe_char ctx) rest
|| (let rec any = function
| [] -> false
| r :: tl -> char_lit r || (untyped := !untyped && int_lit r; any tl)
in
let was = !untyped in
let r = any rest in
untyped := was; r)) then
(* Left to right, each step char arithmetic when a char is in it and the
ordinary join when none is: (- \z \a 1) is 25 - 1, and (+ 1 2 \a) is
3 + \a. *)
let step acc (arg : Ast.expr) =
let lit = char_lit arg in
untyped := !untyped && int_lit arg;
if is_char acc || maybe_char ctx arg || lit then
let v = check ctx arg in
if is_char acc || is_char v then char_step ~want:nwant loc name acc v
else mk loc acc.Tast.ty (Tast.Prim (p, [ acc; expect ctx arg.Ast.loc ~want:(Some acc.Tast.ty) v ]))
else
mk loc acc.Tast.ty (Tast.Prim (p, [ acc; check ctx ~want:acc.Tast.ty arg ]))
in
let first =
if is_char a || is_char b then char_step ~want:nwant loc name a b
else mk loc a.Tast.ty (Tast.Prim (p, [ a; b ]))
in
expect ctx loc ~want (List.fold_left step first rest)
else if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
dyn_fold ctx ~want loc name [ a; b ] rest dyn_fold ctx ~want loc name [ a; b ] rest
else begin else begin
(* [~needs] is the operator's own bound: [is-numeric] for the arithmetic, (* [~needs] is the operator's own bound: [is-numeric] for the arithmetic,
@ -11584,6 +11770,40 @@ and fold_left_prim ctx ~want loc name p ~needs ok what args =
expect ctx loc ~want acc expect ctx loc ~want acc
end end
(* A pair an arithmetic operator refused, when one operand is a char: that
is the refusal to give, rather than the mismatch between the two. Asked
only after the refusal, so a pair that checks costs nothing more. *)
and char_operands ctx ?(charish = false) name (args : Ast.expr list) f =
try f ()
with Loc.Error _ as ex ->
(* [+] and [-] take a char beside an integer (decision 131): the pair is
read again on its own terms, and [char_step] decides. *)
let own () =
List.map (fun a -> trial ctx (fun () -> check ctx a)) args
in
(match charish, args with
| true, [ x; y ] ->
(match own () with
| [ Ok a; Ok b ]
when (a.Tast.ty = Types.Char
&& (Types.is_integer b.Tast.ty || b.Tast.ty = Types.Char))
|| (b.Tast.ty = Types.Char && Types.is_integer a.Tast.ty) ->
raise_notrace (Char_pair (check ctx x, check ctx y))
| _ -> ())
| _ -> ());
(* A char literal beside a number is that number, so it says nothing
unless every operand is a literal. *)
let all_lit = List.for_all is_literal args in
List.iter
(fun (a : Ast.expr) ->
let lit = match a.Ast.e with Ast.Byte _ -> true | _ -> false in
if all_lit || not lit then
match trial ctx (fun () -> check ctx a) with
| Ok e when e.Tast.ty = Types.Char -> char_arith a.Ast.loc name
| _ -> ())
args;
raise ex
(* An operand is kept, so a form with no else at its end — a [when], a (* An operand is kept, so a form with no else at its end — a [when], a
[cond] or an [if]/[if let] chain with no final else, or a [do] or [let] [cond] or an [if]/[if let] chain with no final else, or a [do] or [let]
ending in one — answers an Option there. Beside a number that is refused ending in one — answers an Option there. Beside a number that is refused
@ -11697,6 +11917,7 @@ and bits_operand ctx loc name (v : Tast.expr) =
| Types.Int _ -> () | Types.Int _ -> ()
| t when generic_ty t -> unconstrained ctx.env loc name ~needs:"is-integer" t | t when generic_ty t -> unconstrained ctx.env loc name ~needs:"is-integer" t
| Types.Bool -> bool_bits v.Tast.loc name | Types.Bool -> bool_bits v.Tast.loc name
| Types.Char -> char_arith v.Tast.loc name
| other -> fail loc "%s takes integers, found %s" name (tyname loc other) | other -> fail loc "%s takes integers, found %s" name (tyname loc other)
(* A bool operand is refused before the operands are joined, and not left to (* A bool operand is refused before the operands are joined, and not left to
@ -12599,6 +12820,7 @@ and string_piece ctx what (x : Ast.expr) =
false) false)
| t when string_or_ptr t -> `Text (string_bytes ctx loc e, true) | t when string_or_ptr t -> `Text (string_bytes ctx loc e, true)
| Types.Int Types.I32 -> rune e | Types.Int Types.I32 -> rune e
| Types.Char -> rune (widen loc (Types.Int Types.I32) e)
| Types.Int k when Types.widens_to ~from:(Types.Int k) ~into:(Types.Int Types.I32) -> | Types.Int k when Types.widens_to ~from:(Types.Int k) ~into:(Types.Int Types.I32) ->
rune (widen loc (Types.Int Types.I32) e) rune (widen loc (Types.Int Types.I32) e)
| Types.Int _ -> | Types.Int _ ->
@ -12612,7 +12834,7 @@ and string_piece ctx what (x : Ast.expr) =
Write %s, which is checked when it is stored" Write %s, which is checked when it is stored"
what (if fln_source loc then "str(b)" else "(str b)") what (if fln_source loc then "str(b)" else "(str b)")
| other -> | other ->
fail loc "%s takes a str, a String or a code point, found %s" what fail loc "%s takes a str, a String, a char or a code point, found %s" what
(tyname loc other) (tyname loc other)
(* One allocating store into a String's Vec, under the retry guard, with the (* One allocating store into a String's Vec, under the retry guard, with the
@ -13009,6 +13231,12 @@ and named_call ?(qualified = false) ctx ~want loc name args =
| Ast.Float v, _ -> check ctx ?want { Ast.e = Ast.Float (-.v); loc } | Ast.Float v, _ -> check ctx ?want { Ast.e = Ast.Float (-.v); loc }
| _ -> | _ ->
let v = check ctx ?want:(numeric_want want) x in let v = check ctx ?want:(numeric_want want) x in
if v.Tast.ty = Types.Char then
Loc.failk "check/char-arithmetic" x.Ast.loc
"- does not negate a char. Take its code point with %s, and make a \
char of one with %s"
(if fln_source loc then "i32(c)" else "(i32 c)")
(if fln_source loc then "char(n)" else "(char n)");
if v.Tast.ty = Types.Dyn then if v.Tast.ty = Types.Dyn then
expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_neg" [ v; here loc ]) expect ctx loc ~want (rt loc Types.Dyn "flan_dyn_neg" [ v; here loc ])
else begin else begin
@ -13035,7 +13263,10 @@ and named_call ?(qualified = false) ctx ~want loc name args =
| "%" -> | "%" ->
arity ctx loc name 2 args; arity ctx loc name 2 args;
refuse_kept_when ctx name args; refuse_kept_when ctx name args;
let a, b = binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) args in let a, b =
char_operands ctx name args (fun () ->
binary ctx ~dyn_ok:true name loc ~want:(numeric_want want) args)
in
if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then if a.Tast.ty = Types.Dyn || b.Tast.ty = Types.Dyn then
dyn_fold ctx ~want loc name [ a; b ] [] dyn_fold ctx ~want loc name [ a; b ] []
else begin else begin
@ -13062,7 +13293,28 @@ and named_call ?(qualified = false) ctx ~want loc name args =
the two, and every operand after them is checked against the answer. the two, and every operand after them is checked against the answer.
Past the first pair nothing widens, which is [fold_left_prim]'s rule Past the first pair nothing widens, which is [fold_left_prim]'s rule
and not a second one. *) and not a second one. *)
let a, b = binary ctx ~dyn_ok:true name loc ~want:None [ x; y ] in let a, b =
try binary ctx ~dyn_ok:true name loc ~want:None [ x; y ]
with Loc.Error _ as ex ->
(* A char beside an integer: said as the char's rule, not as the
mismatch (decision 131). *)
(* Neither a literal, whose own refusal already says what it is. *)
(match
if is_literal x || is_literal y then []
else List.map (fun a -> trial ctx (fun () -> check ctx a)) [ x; y ]
with
| [ Ok a; Ok b ]
when (a.Tast.ty = Types.Char && Types.is_integer b.Tast.ty)
|| (b.Tast.ty = Types.Char && Types.is_integer a.Tast.ty) ->
let fln = fln_source loc in
Loc.failk "check/char-compare" loc
"%s compares a char only with a char, and this is %s beside it. \
Take its code point with %s, or make a char with %s" name
(tyname loc (if a.Tast.ty = Types.Char then b.Tast.ty else a.Tast.ty))
(if fln then "i32(c)" else "(i32 c)")
(if fln then "char(n)" else "(char n)")
| _ -> raise ex)
in
(* Which pairs this operator asks about. Every one but [!=] chains, and (* Which pairs this operator asks about. Every one but [!=] chains, and
[!=] asks about all of them — see [all_pairs]. At two operands the two [!=] asks about all of them — see [all_pairs]. At two operands the two
readings are one pair and the same answer, which is why the two-operand readings are one pair and the same answer, which is why the two-operand
@ -13139,11 +13391,12 @@ and named_call ?(qualified = false) ctx ~want loc name args =
(match name with (match name with
| "=" | "!=" -> | "=" | "!=" ->
fail loc fail loc
"%s compares numbers, enums, strings and bools, and %s is none \ "%s compares numbers, chars, enums, strings and bools, and %s \
of those" name (tyname loc a.Tast.ty) is none of those" name (tyname loc a.Tast.ty)
| _ -> | _ ->
fail loc fail loc
"%s orders machine numbers and enums, and %s is neither" name "%s orders machine numbers, chars and enums, and %s is none of \
those" name
(tyname loc a.Tast.ty)); (tyname loc a.Tast.ty));
match rest with match rest with
| [] -> prim p Types.Bool [ a; b ] | [] -> prim p Types.Bool [ a; b ]
@ -13276,7 +13529,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
body that declares it — so collapsing them would cost the arity and body that declares it — so collapsing them would cost the arity and
the evaluation rule and buy nothing. *) the evaluation rule and buy nothing. *)
unconstrained ctx.env loc name ~needs:"is-ordered" a.Tast.ty; unconstrained ctx.env loc name ~needs:"is-ordered" a.Tast.ty;
if not (Types.is_numeric a.Tast.ty || generic_ty a.Tast.ty) then (* A char orders, so it has a least and a greatest too. *)
if not (Types.is_numeric a.Tast.ty || a.Tast.ty = Types.Char
|| generic_ty a.Tast.ty) then
not_numeric name "numbers" a; not_numeric name "numbers" a;
let ty = a.Tast.ty in let ty = a.Tast.ty in
let cmp = if String.equal name "min" then Tast.Lt else Tast.Gt in let cmp = if String.equal name "min" then Tast.Lt else Tast.Gt in
@ -15238,13 +15493,19 @@ and named_call ?(qualified = false) ctx ~want loc name args =
ei64 = (fun x -> write (conv Tast.I64ToBytes x)); ei64 = (fun x -> write (conv Tast.I64ToBytes x));
eu64 = (fun x -> write (conv Tast.U64ToBytes x)); eu64 = (fun x -> write (conv Tast.U64ToBytes x));
ef64 = (fun x -> write (conv Tast.F64ToBytes x)); ef64 = (fun x -> write (conv Tast.F64ToBytes x));
edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print_at", [ x; here loc ]))) } edyn = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print_at", [ x; here loc ])));
enested = (fun x -> mk loc Types.Unit (Tast.Prim (Tast.Rt "flan_dyn_print_nested_at", [ x; here loc ]))) }
in in
let rc = render_ctx ctx emitter in let rc = render_ctx ctx emitter in
let c_top = emitter.Render.edyn in
let render_one a = let render_one a =
match a.Tast.ty with match a.Tast.ty with
| Types.String | Types.Slice (_, (Types.Int Types.U8)) -> | Types.String | Types.Slice (_, (Types.Int Types.U8)) ->
[ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ] [ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ a ]))) ]
(* A char at the top prints as the character itself (129a), through the
runtime's dyn printer so the two sides agree. *)
| Types.Char ->
[ c_top (box loc a) ]
(* A String prints as its text, raw at the top as a str does. *) (* A String prints as its text, raw at the top as a str does. *)
| t when is_string_ty t -> | t when is_string_ty t ->
[ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ string_bytes ctx loc a ]))) ] [ write (mk loc bslice (Tast.Prim (Tast.Bytes, [ string_bytes ctx loc a ]))) ]
@ -15314,7 +15575,8 @@ and named_call ?(qualified = false) ctx ~want loc name args =
ei64 = (fun x -> unit_rt "flan_dev_watch_emit_i64" [ x ]); ei64 = (fun x -> unit_rt "flan_dev_watch_emit_i64" [ x ]);
eu64 = (fun x -> unit_rt "flan_dev_watch_emit_u64" [ x ]); eu64 = (fun x -> unit_rt "flan_dev_watch_emit_u64" [ x ]);
ef64 = (fun x -> unit_rt "flan_dev_watch_emit_f64" [ x ]); ef64 = (fun x -> unit_rt "flan_dev_watch_emit_f64" [ x ]);
edyn = (fun x -> unit_rt "flan_dyn_emit_watch" [ x ]) } edyn = (fun x -> unit_rt "flan_dyn_emit_watch" [ x ]);
enested = (fun x -> unit_rt "flan_dyn_emit_watch" [ x ]) }
in in
(* A place is read where it stands; anything else is bound to a slot of (* A place is read where it stands; anything else is bound to a slot of
this frame first, so the walk — which names its argument once per this frame first, so the walk — which names its argument once per
@ -15471,6 +15733,49 @@ and named_call ?(qualified = false) ctx ~want loc name args =
~what:"a number or an enum" ~is:"a number" v ~what:"a number or an enum" ~is:"a number" v
| t -> fail loc "%s converts a number, found %s" name (tyname loc t)); | t -> fail loc "%s converts a number, found %s" name (tyname loc t));
prim (Tast.Cast target) target [ a ] prim (Tast.Cast target) target [ a ]
(* (char n): a code point made a char. Only a Unicode scalar value is one,
so a literal is checked here and anything else at run time. *)
| "char" when List.length args = 1 ->
let x = List.hd args in
let char_lit n = mk loc Types.Char (Tast.Int (n, Types.U32)) in
let fln = fln_source loc in
let not_scalar n =
Loc.failk literal_at_want loc
"%Ld is not a Unicode scalar value, so it is not a char. A char is a \
code point from 0 to 0x10FFFF, outside 0xD800 to 0xDFFF" n
in
(match x.Ast.e, literal_arith x with
| Ast.Byte b, _ -> expect ctx loc ~want (char_lit (Int64.of_int b))
| _, Some n ->
if Int64.compare n 0L >= 0 && Int64.compare n 0x10ffffL <= 0
&& not (Int64.compare n 0xd800L >= 0 && Int64.compare n 0xdfffL <= 0)
then expect ctx loc ~want (char_lit n)
else not_scalar n
| _ ->
let a = check ctx x in
let checked i64 =
rt loc Types.Char "flan_char_of" [ i64; here loc ]
in
(match a.Tast.ty with
| Types.Char -> expect ctx loc ~want a
(* A u64 goes as itself, so one past 2^63 is named as the number
it is and not as the negative i64 with its bits. *)
| Types.Int Types.U64 ->
expect ctx loc ~want
(rt loc Types.Char "flan_char_of_u64" [ a; here loc ])
| Types.Int _ -> expect ctx loc ~want (checked (widen loc dyn_i64 a))
(* Explicit, so a dyn int converts as a typed one does. *)
| Types.Dyn ->
expect ctx loc ~want
(checked (rt loc dyn_i64 "flan_dyn_int_of" [ a ]))
| t ->
fail loc "char makes a char from an integer code point, found %s%s"
(tyname loc t)
(match t with
| Types.Float _ ->
if fln then " — convert it with i32(x) first"
else " — convert it with (i32 x) first"
| _ -> "")))
| _ when is_cast name && List.length args = 1 -> | _ when is_cast name && List.length args = 1 ->
let target = resolve_name ctx.env ~seen:[] loc name in let target = resolve_name ctx.env ~seen:[] loc name in
(* An integer literal too wide for the i32 it would default to is checked (* An integer literal too wide for the i32 it would default to is checked
@ -15483,6 +15788,9 @@ and named_call ?(qualified = false) ctx ~want loc name args =
when Int64.compare n (-2147483648L) < 0 when Int64.compare n (-2147483648L) < 0
|| Int64.compare n 2147483647L > 0 -> Some target || Int64.compare n 2147483647L > 0 -> Some target
| Ast.UInt _, (Types.Int _ | Types.Float _) -> Some target | Ast.UInt _, (Types.Int _ | Types.Float _) -> Some target
(* A char literal is the number at the target, so (u8 \é) is refused
as a u8 literal is. *)
| Ast.Byte _, (Types.Int _ | Types.Float _) -> Some target
(* A float literal likewise: (f64 0.1) is the f64 nearest 0.1 and not (* A float literal likewise: (f64 0.1) is the f64 nearest 0.1 and not
the f32 one widened, and (u64 1.8e19) converts the f64 it says. *) the f32 one widened, and (u64 1.8e19) converts the f64 it says. *)
| _, Types.Float _ when lit_kind (List.hd args) = Some `Float -> Some target | _, Types.Float _ when lit_kind (List.hd args) = Some `Float -> Some target
@ -15500,6 +15808,12 @@ and named_call ?(qualified = false) ctx ~want loc name args =
admits. *) admits. *)
| Types.Dyn -> () | Types.Dyn -> ()
| t when Types.is_numeric t -> () | t when Types.is_numeric t -> ()
(* A char's code point, into any integer width. *)
| Types.Char when Types.is_integer target -> ()
| Types.Char ->
fail loc "%s converts a number, and a char converts only to an integer, \
as %s" name
(if fln_source loc then "i32(c)" else "(i32 c)")
(* The operand of a conversion inside a generic body. The target is a (* The operand of a conversion inside a generic body. The target is a
machine type, so what is in question is only the operand, and the machine type, so what is in question is only the operand, and the
[where] clause is what answers it. *) [where] clause is what answers it. *)
@ -16577,9 +16891,10 @@ and trial_at ctx (y : Ast.expr) (w : Types.t) =
if !lit_recording = 0 then Hashtbl.add arm_failed y.Ast.loc (y, (ctx.scope, ctx.ret), w, d); if !lit_recording = 0 then Hashtbl.add arm_failed y.Ast.loc (y, (ctx.scope, ctx.ret), w, d);
Error d) Error d)
and binary ctx ?(dyn_ok = false) ?(join = true) name loc ~want args = and binary ctx ?(dyn_ok = false) ?(join = true) ?(char_ok = false) name loc ~want args =
match args with match args with
| [ x; y ] -> lit_operands ctx x y (fun () -> binary_pair ctx ~dyn_ok ~join loc ~want x y) | [ x; y ] ->
lit_operands ctx x y (fun () -> binary_pair ctx ~dyn_ok ~join ~char_ok loc ~want x y)
| _ -> fail loc "%s takes two arguments" name | _ -> fail loc "%s takes two arguments" name
(* An operator's two operands, while literal locals' uses are recorded: one (* An operator's two operands, while literal locals' uses are recorded: one
@ -16593,11 +16908,19 @@ and lit_operands ctx (x : Ast.expr) (y : Ast.expr) f =
match ctx.lits, key x, key y with match ctx.lits, key x, key y with
| Some s, kx, ky when kx <> None || ky <> None -> | Some s, kx, ky when kx <> None || ky <> None ->
let float_lit (e : Ast.expr) = lit_kind e = Some `Float in let float_lit (e : Ast.expr) = lit_kind e = Some `Float in
(* A char local beside an integer literal stays a char: the pair is char
arithmetic, or a comparison the checker refuses (decision 131). Only
typed code that wants a particular integer makes it a number. *)
let lit_add s k ((_, _, _) as c) (other : Ast.expr) =
match lit_kind k, lit_kind other with
| Some `Char, Some `Int -> ()
| _ -> lit_add s k c
in
(* Before the check, which refuses a float literal beside an integer (* Before the check, which refuses a float literal beside an integer
guess. *) guess. *)
(match kx, ky with (match kx, ky with
| Some k, _ when float_lit y -> lit_add s k (Hint, Types.Float (float_default ()), y.Ast.loc) | Some k, _ when float_lit y -> lit_add s k (Hint, Types.Float (float_default ()), y.Ast.loc) y
| _, Some k when float_lit x -> lit_add s k (Hint, Types.Float (float_default ()), x.Ast.loc) | _, Some k when float_lit x -> lit_add s k (Hint, Types.Float (float_default ()), x.Ast.loc) x
| _ -> ()); | _ -> ());
let saved = !lit_operand_locs in let saved = !lit_operand_locs in
lit_operand_locs := x.Ast.loc :: y.Ast.loc :: saved; lit_operand_locs := x.Ast.loc :: y.Ast.loc :: saved;
@ -16608,7 +16931,7 @@ and lit_operands ctx (x : Ast.expr) (y : Ast.expr) f =
i64 x: what the other operand is on its own terms is the use. *) i64 x: what the other operand is on its own terms is the use. *)
let own (k, (other : Ast.expr)) = let own (k, (other : Ast.expr)) =
match trial ctx (fun () -> check ctx other) with match trial ctx (fun () -> check ctx other) with
| Ok e -> lit_add s k (Hint, e.Tast.ty, other.Ast.loc) | Ok e -> lit_add s k (Hint, e.Tast.ty, other.Ast.loc) other
| Error _ -> () | Error _ -> ()
in in
(match kx, ky with (match kx, ky with
@ -16619,13 +16942,22 @@ and lit_operands ctx (x : Ast.expr) (y : Ast.expr) f =
in in
(match kx, ky with (match kx, ky with
| Some k1, Some k2 -> lit_union s k1 k2 | Some k1, Some k2 -> lit_union s k1 k2
| Some k, None -> lit_add s k (Hint, b.Tast.ty, y.Ast.loc) | Some k, None -> lit_add s k (Hint, b.Tast.ty, y.Ast.loc) y
| None, Some k -> lit_add s k (Hint, a.Tast.ty, x.Ast.loc) | None, Some k -> lit_add s k (Hint, a.Tast.ty, x.Ast.loc) x
| None, None -> ()); | None, None -> ());
a, b a, b
| _ -> f () | _ -> f ()
and binary_pair ctx ~dyn_ok ~join loc ~want (x : Ast.expr) (y : Ast.expr) = and binary_pair ctx ~dyn_ok ~join ~char_ok loc ~want (x : Ast.expr) (y : Ast.expr) =
(* A char defconst no local shadows reads as the literal it names. *)
let is_literal (e : Ast.expr) =
is_literal e
|| (match e.Ast.e with
| Ast.Var n ->
Hashtbl.mem char_consts n && lookup ctx n = None
&& peek_outer ctx n = None
| _ -> false)
in
let y_decides = let y_decides =
(is_literal x && not (is_literal y)) (is_literal x && not (is_literal y))
|| (match x.Ast.e, y.Ast.e with || (match x.Ast.e, y.Ast.e with
@ -16642,7 +16974,14 @@ and binary_pair ctx ~dyn_ok ~join loc ~want (x : Ast.expr) (y : Ast.expr) =
in in
if y_decides then begin if y_decides then begin
let b = check ctx ?want y in let b = check ctx ?want y in
let a = check ctx ~want:b.Tast.ty x in (* An integer literal before a char, under [+] or [-], is an integer:
the pair is char arithmetic ([char_step]). *)
let a =
match x.Ast.e with
| (Ast.Int _ | Ast.UInt _) when char_ok && b.Tast.ty = Types.Char ->
check ctx x
| _ -> check ctx ~want:b.Tast.ty x
in
a, b a, b
end end
(* [dyn_ok] is set by the operators that have a dyn lowering, and it exists (* [dyn_ok] is set by the operators that have a dyn lowering, and it exists
@ -16971,7 +17310,7 @@ let builtins : (string * string * string) list =
"Takes out the character at position i, counting characters, and \ "Takes out the character at position i, counting characters, and \
answers its code point. A position past the end signals BoundsError."); answers its code point. A position past the end signals BoundsError.");
("runes", "runes [str|String|[const u8]] Runes", ("runes", "runes [str|String|[const u8]] Runes",
"A cursor over the text's code points: (runes-next (addr it)) answers \ "A cursor over the text's chars: (runes-next (addr it)) answers \
the next one, or None at the end. A malformed byte in a str comes back \ the next one, or None at the end. A malformed byte in a str comes back \
as U+FFFD."); as U+FFFD.");
("rune-count", "rune-count [str|String|[const u8]] i32", ("rune-count", "rune-count [str|String|[const u8]] i32",
@ -17121,6 +17460,10 @@ let builtins : (string * string * string) list =
A String's str lasts until the String next changes. It does not check \ A String's str lasts until the String next changes. It does not check \
UTF-8, because `str` does not claim UTF-8 — is-valid-utf8 is an \ UTF-8, because `str` does not claim UTF-8 — is-valid-utf8 is an \
ordinary function you call when you care."); ordinary function you call when you care.");
("char", "char [int|char|dyn] char",
"A code point as a char. Only a Unicode scalar value is one — 0 to \
0x10FFFF, outside 0xD800 to 0xDFFF: a literal is checked when it \
compiles and any other value when it runs. (i32 c) is the way back.");
("bytes->f64", "bytes->f64 [[const u8]] f64", "Parses a float out of the bytes."); ("bytes->f64", "bytes->f64 [[const u8]] f64", "Parses a float out of the bytes.");
("bytes->i64", "bytes->i64 [[const u8]] i64", ("bytes->i64", "bytes->i64 [[const u8]] i64",
"Parses an integer out of the bytes."); "Parses an integer out of the bytes.");
@ -17541,6 +17884,7 @@ let collect env (decls : Ast.decl list) =
every other signature in hand — so they are deferred to a pass of their every other signature in hand — so they are deferred to a pass of their
own below. *) own below. *)
let untyped = ref [] in let untyped = ref [] in
Hashtbl.reset char_consts;
(* Enums come first, in a pass of their own: a signature below may name one, (* Enums come first, in a pass of their own: a signature below may name one,
and [resolve] has to find it before it resolves that signature. *) and [resolve] has to find it before it resolves that signature. *)
List.iter List.iter
@ -17880,6 +18224,9 @@ let collect env (decls : Ast.decl list) =
Hashtbl.replace env.globals n (resolve env t, true); Hashtbl.replace env.globals n (resolve env t, true);
Hashtbl.replace env.global_locs n loc Hashtbl.replace env.global_locs n loc
| Ast.Defconst (n, None, v) -> | Ast.Defconst (n, None, v) ->
(match v.Ast.e with
| Ast.Byte b -> Hashtbl.replace char_consts n b
| _ -> ());
defconst_type_shaped env n v; defconst_type_shaped env n v;
Hashtbl.replace env.global_locs n loc; Hashtbl.replace env.global_locs n loc;
untyped := (n, v) :: !untyped untyped := (n, v) :: !untyped

View File

@ -338,6 +338,8 @@ let rec ll (t : Types.t) =
| Types.Named n -> sname n | Types.Named n -> sname n
(* A C enum is an i32 — its own type in the checker, nothing at all here. *) (* A C enum is an i32 — its own type in the checker, nothing at all here. *)
| Types.Enum _ -> "i32" | Types.Enum _ -> "i32"
(* A char is a u32 code point; only the checker tells it from one. *)
| Types.Char -> "i32"
| Types.Array (n, e) -> Printf.sprintf "[%Ld x %s]" n (ll e) | Types.Array (n, e) -> Printf.sprintf "[%Ld x %s]" n (ll e)
| Types.Ptr _ -> "ptr" | Types.Ptr _ -> "ptr"
(* An [Allocator] is the runtime's [flan_allocator] record and the (* An [Allocator] is the runtime's [flan_allocator] record and the
@ -611,7 +613,7 @@ let rec lay m (t : Types.t) : int * int =
| Types.Bool -> 1, 1 | Types.Bool -> 1, 1
| Types.String | Types.Slice _ -> 16, 8 | Types.String | Types.Slice _ -> 16, 8
| Types.Unit | Types.Never -> 0, 1 | Types.Unit | Types.Never -> 0, 1
| Types.Enum _ -> 4, 4 | Types.Enum _ | Types.Char -> 4, 4
| Types.Ptr _ -> 8, 8 | Types.Ptr _ -> 8, 8
| Types.Alloc -> 16, 8 | Types.Alloc -> 16, 8
| Types.Fn _ -> 16, 8 | Types.Fn _ -> 16, 8
@ -1067,6 +1069,7 @@ let rec dty m d (t : Types.t) : int =
| Types.Float k -> basic (Types.to_string t) (Types.bits_f k) "DW_ATE_float" | Types.Float k -> basic (Types.to_string t) (Types.bits_f k) "DW_ATE_float"
| Types.Bool -> basic "bool" 8 "DW_ATE_boolean" | Types.Bool -> basic "bool" 8 "DW_ATE_boolean"
| Types.Enum e -> basic e 32 "DW_ATE_signed" | Types.Enum e -> basic e 32 "DW_ATE_signed"
| Types.Char -> basic "char" 32 "DW_ATE_UTF"
| Types.Unit | Types.Never -> composite (Types.to_string t) [] | Types.Unit | Types.Never -> composite (Types.to_string t) []
| Types.Ptr (_, e) -> | Types.Ptr (_, e) ->
let id = dalloc d in let id = dalloc d in
@ -1497,7 +1500,10 @@ let settled_prim (p : Tast.prim) =
ordinary aggregate literal there is pay for a copy. *) ordinary aggregate literal there is pay for a copy. *)
let cast_checks (src : Types.t) (target : Types.t) = let cast_checks (src : Types.t) (target : Types.t) =
let concrete (t : Types.t) = let concrete (t : Types.t) =
match t with Types.Enum _ -> Types.Int Types.I32 | t -> t match t with
| Types.Enum _ -> Types.Int Types.I32
| Types.Char -> Types.Int Types.U32
| t -> t
in in
match concrete src, concrete target with match concrete src, concrete target with
| Types.Float _, Types.Int _ -> true | Types.Float _, Types.Int _ -> true
@ -3816,6 +3822,9 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) =
location. Signed, because a member may be declared negative. *) location. Signed, because a member may be declared negative. *)
| Types.Enum _ -> | Types.Enum _ ->
ins f "%s = icmp %s %s %s, %s" t (icmp_op true p) (ll x.Tast.ty) a b ins f "%s = icmp %s %s %s, %s" t (icmp_op true p) (ll x.Tast.ty) a b
(* A code point orders as the unsigned number it is. *)
| Types.Char ->
ins f "%s = icmp %s i32 %s, %s" t (icmp_op false p) a b
(* A bool is an i1 here, and only [=]/[!=] reach it: [<] on a bool is (* A bool is an i1 here, and only [=]/[!=] reach it: [<] on a bool is
refused in check.ml. *) refused in check.ml. *)
| Types.Bool -> | Types.Bool ->
@ -4164,6 +4173,7 @@ and cast f ~guard (x : Tast.expr) target =
let concrete (t : Types.t) = let concrete (t : Types.t) =
match t with match t with
| Types.Enum _ -> Types.Int Types.I32 | Types.Enum _ -> Types.Int Types.I32
| Types.Char -> Types.Int Types.U32
| t -> t | t -> t
in in
let src = concrete x.Tast.ty and target = concrete target in let src = concrete x.Tast.ty and target = concrete target in
@ -5117,6 +5127,7 @@ declare void @flan_dyn_set_at(i64, i64, i64, ptr, i64)
declare void @flan_dyn_push(i64, i64, ptr, i64) declare void @flan_dyn_push(i64, i64, ptr, i64)
declare void @flan_dyn_print(i64) declare void @flan_dyn_print(i64)
declare void @flan_dyn_print_at(i64, ptr, i64) declare void @flan_dyn_print_at(i64, ptr, i64)
declare void @flan_dyn_print_nested_at(i64, ptr, i64)
declare void @flan_dyn_emit_dev(i64) declare void @flan_dyn_emit_dev(i64)
declare void @flan_dyn_emit_watch(i64) declare void @flan_dyn_emit_watch(i64)
; The watch table, which (watch "name" v) renders into. flan_dev.c is linked ; The watch table, which (watch "name" v) renders into. flan_dev.c is linked
@ -5138,6 +5149,11 @@ declare i32 @flan_dyn_need_bool(i64)
declare i32 @flan_dyn_need_i32(i64, ptr, i64) declare i32 @flan_dyn_need_i32(i64, ptr, i64)
declare i64 @flan_dyn_need_int(i64, i32, ptr, i64) declare i64 @flan_dyn_need_int(i64, i32, ptr, i64)
declare i64 @flan_dyn_int_of(i64) declare i64 @flan_dyn_int_of(i64)
declare i32 @flan_dyn_need_char(i64, ptr, i64)
declare i32 @flan_char_of(i64, ptr, i64)
declare i32 @flan_char_of_u64(i64, ptr, i64)
declare i32 @flan_char_step_u64(i32, i64, i32, ptr, i64)
declare i32 @flan_char_step_i64(i32, i64, i32, ptr, i64)
; A numeric cast written on a dyn answers which numeric tag the box holds; ; 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 ; 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 ; the ordinary cast. The two slices are the site's location and the target's

View File

@ -166,7 +166,7 @@ let refusal c (ty : Types.t) : string option =
{ Render.structs = c.structs; datas = c.datas; unions = c.unions; { Render.structs = c.structs; datas = c.datas; unions = c.unions;
enums = c.enums; enums = c.enums;
emit = { Render.ebytes = emit; estr = emit; ei64 = emit; eu64 = emit; emit = { Render.ebytes = emit; estr = emit; ei64 = emit; eu64 = emit;
ef64 = emit; edyn = emit }; ef64 = emit; edyn = emit; enested = emit };
ptrs = Some { Render.live = (fun _ -> { unit_ with ty = Types.Bool }); ptrs = Some { Render.live = (fun _ -> { unit_ with ty = Types.Bool });
bytechar = emit; epitaph = emit }; bytechar = emit; epitaph = emit };
alloc = (fun _ -> 0) } alloc = (fun _ -> 0) }
@ -221,6 +221,8 @@ let rec walk c b depth addr (ty : Types.t) =
(* An [i1] in memory is a byte, and a load keeps its low bit. *) (* An [i1] in memory is a byte, and a load keeps its low bit. *)
| Types.Bool -> put b (if u8 c addr land 1 <> 0 then "true" else "false") | Types.Bool -> put b (if u8 c addr land 1 <> 0 then "true" else "false")
| Types.Unit -> put b "()" | Types.Unit -> put b "()"
(* As the runtime spells a dyn char, which [Form.byte_repr] mirrors. *)
| Types.Char -> put b (Form.byte_repr (Int32.to_int (i32 c addr) land 0x1fffff))
(* The prelude's String is a (Vec u8), whose header starts with the same (* The prelude's String is a (Vec u8), whose header starts with the same
pointer and length a str is. *) pointer and length a str is. *)
| Types.String | Types.Slice (_, Types.Int Types.U8) | Types.Named "String" -> | Types.String | Types.Slice (_, Types.Int Types.U8) | Types.Named "String" ->

View File

@ -247,6 +247,8 @@ let rec refuse_ty loc (t : Types.t) =
"dyn is not in the JS dialect yet — every JavaScript value is already \ "dyn is not in the JS dialect yet — every JavaScript value is already \
dynamic, so this is a matter of lowering the dyn operations onto the \ dynamic, so this is a matter of lowering the dyn operations onto the \
host's own, and that work has not been done" host's own, and that work has not been done"
| Types.Char ->
at loc "char is not in the JS dialect yet — take its code point as an i32"
| Types.Var n -> | Types.Var n ->
at loc "a type variable (%s) reached the backend, which cannot happen" n at loc "a type variable (%s) reached the backend, which cannot happen" n
| Types.Len _ | Types.LArray _ -> | Types.Len _ | Types.LArray _ ->

View File

@ -1421,10 +1421,10 @@ let source = {flan|
;; 0xf0, 0xf4 second byte 0x90..0xbf and 0x80..0x8f: overlong below, ;; 0xf0, 0xf4 second byte 0x90..0xbf and 0x80..0x8f: overlong below,
;; and past U+10FFFF above. 0xf5..0xff lead nothing at all. ;; and past U+10FFFF above. 0xf5..0xff lead nothing at all.
;; ;;
;; A rune is an i32 and not a type of its own. That is Odin's answer too — ;; The codec works on a code point as an i32, the number it is built from
;; its `rune` is a four-byte integer distinguished only by a flag on the ;; with shifts. What hands a character to a caller — rune-at and runes-next —
;; basic-type row (src/types.cpp, the Basic_rune entry) — so nothing in the ;; hands back a char, converted once decoding has made it a scalar value,
;; checker has to learn a new type for any of this. ;; so nothing that walks text has to treat a number as a character.
;; One deliberate divergence from Odin, and it is the parse-i64 argument over ;; One deliberate divergence from Odin, and it is the parse-i64 argument over
;; again. Odin's decode_rune answers RUNE_ERROR — U+FFFD — for malformed ;; again. Odin's decode_rune answers RUNE_ERROR — U+FFFD — for malformed
@ -1498,11 +1498,11 @@ let source = {flan|
;; Decode at a byte offset. None when the offset is not on a rune boundary or ;; Decode at a byte offset. None when the offset is not on a rune boundary or
;; the bytes there are malformed, which is stricter than Odin's rune_at — that ;; the bytes there are malformed, which is stricter than Odin's rune_at — that
;; one hands back RUNE_ERROR and the caller carries on with a wrong character. ;; one hands back RUNE_ERROR and the caller carries on with a wrong character.
(defn rune-at [s [const u8] i i32] (Option i32) (defn rune-at [s [const u8] i i32] (Option char)
(if (or (< i 0) (>= i (length s))) (if (or (< i 0) (>= i (length s)))
None None
(let [r (decode-rune (slice s i (length s)))] (let [r (decode-rune (slice s i (length s)))]
(if (.ok r) (Some (.code r)) None)))) (if (.ok r) (Some (char (.code r))) None))))
;; Counted through decode-rune rather than through a second walk of its own. ;; Counted through decode-rune rather than through a second walk of its own.
;; Odin keeps a separate rune_count_in_bytes that re-implements the size ;; Odin keeps a separate rune_count_in_bytes that re-implements the size
@ -1743,17 +1743,17 @@ let source = {flan|
;; A cursor over the code points of some UTF-8 bytes, which owns nothing: the ;; A cursor over the code points of some UTF-8 bytes, which owns nothing: the
;; shape split-on-byte has. (runes s) makes one over a str, a String or a ;; shape split-on-byte has. (runes s) makes one over a str, a String or a
;; [const u8], and runes-next hands back one code point at a time. A ;; [const u8], and runes-next hands back one char at a time. A
;; malformed byte in a str or a [const u8] comes back as U+FFFD and counts ;; malformed byte in a str or a [const u8] comes back as U+FFFD and counts
;; as one, as rune-count counts it; a String has none. ;; as one, as rune-count counts it; a String has none.
(defstruct Runes [rest [const u8]]) (defstruct Runes [rest [const u8]])
(defn runes-next [it (Ptr Runes)] (Option i32) (defn runes-next [it (Ptr Runes)] (Option char)
(if (= (length (.rest it)) 0) (if (= (length (.rest it)) 0)
None None
(let [r (decode-rune (.rest it))] (let [r (decode-rune (.rest it))]
(set (.rest it) (slice (.rest it) (.width r) (length (.rest it)))) (set (.rest it) (slice (.rest it) (.width r) (length (.rest it))))
(Some (if (.ok r) (.code r) 0xfffd))))) (Some (char (if (.ok r) (.code r) 0xfffd))))))
;; append — onto a String, or a run of bytes onto a (Vec u8) — is the ;; append — onto a String, or a run of bytes onto a (Vec u8) — is the
;; checker's (check.ml, "append"), because what it takes decides what it ;; checker's (check.ml, "append"), because what it takes decides what it

View File

@ -35,6 +35,10 @@ type emitter = {
runtime's to read — so the runtime renders it, into the same place the runtime's to read — so the runtime renders it, into the same place the
other four write to. *) other four write to. *)
edyn : Tast.expr -> Tast.expr; edyn : Tast.expr -> Tast.expr;
(* The same, for a dyn inside a larger value: a text quoted and a char as
its literal. The same as [edyn] on the inspecting side, which quotes at
the top too; [println]'s differs, since its top level is raw. *)
enested : Tast.expr -> Tast.expr;
} }
(* What a walk is allowed to do with a pointer, and it is exactly two (* What a walk is allowed to do with a pointer, and it is exactly two
@ -155,6 +159,14 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
| Types.Float _ -> [ c.emit.ef64 (cast (Types.Float Types.F64) e) ] | Types.Float _ -> [ c.emit.ef64 (cast (Types.Float Types.F64) e) ]
| Types.Bool -> | Types.Bool ->
[ unit_ (Tast.If (e, lit "true", lit "false")) ] [ unit_ (Tast.If (e, lit "true", lit "false")) ]
(* A char inside a value, or in the inspector, prints as its literal, by
the runtime's one spelling so the typed and dyn sides cannot drift
apart. [println]'s top level is the character itself, and check.ml's
print arm takes that case before the walk. *)
| Types.Char ->
[ c.emit.enested
{ Tast.e = Tast.Prim (Tast.Rt "flan_dyn_from_char", [ cast (Types.Int Types.I32) e ]);
ty = Types.Dyn; loc } ]
(* Evaluated *and then* reported. A Unit expression is almost always a call (* Evaluated *and then* reported. A Unit expression is almost always a call
made for its effect — (println "x") is the REPL's most ordinary made for its effect — (println "x") is the REPL's most ordinary
input — so emitting the literal without running it would make the prompt input — so emitting the literal without running it would make the prompt
@ -437,7 +449,7 @@ let rec render ?(refuse = print_refusal) c depth (e : Tast.expr) : Tast.expr lis
does not — so the printing belongs on the side that can see the tag, and does not — so the printing belongs on the side that can see the tag, and
the walk hands the whole value to [c.emit.edyn], which names the runtime the walk hands the whole value to [c.emit.edyn], which names the runtime
entry point that renders into this emitter's sink. *) entry point that renders into this emitter's sink. *)
| Types.Dyn -> [ c.emit.edyn e ] | Types.Dyn -> [ (if depth = 0 then c.emit.edyn else c.emit.enested) e ]
(* Reachable: [(println m)] on a Map. Everything else in [Types.t] has an (* Reachable: [(println m)] on a Map. Everything else in [Types.t] has an
arm above, and a [Var] never reaches a backend. So this names the fix arm above, and a [Var] never reaches a backend. So this names the fix
rather than only the refusal. *) rather than only the refusal. *)

View File

@ -1556,6 +1556,10 @@ let dev_emitter : Render.emitter =
(* Into the value buffer, not stdout: a dyn expression's value belongs in (* Into the value buffer, not stdout: a dyn expression's value belongs in
the reply's value like any other. *) the reply's value like any other. *)
edyn = edyn =
(fun x ->
{ Tast.e = Tast.Prim (Tast.Rt "flan_dyn_emit_dev", [ x ]);
ty = Types.Unit; loc = x.Tast.loc });
enested =
(fun x -> (fun x ->
{ Tast.e = Tast.Prim (Tast.Rt "flan_dyn_emit_dev", [ x ]); { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_emit_dev", [ x ]);
ty = Types.Unit; loc = x.Tast.loc }) } ty = Types.Unit; loc = x.Tast.loc }) }

View File

@ -33,6 +33,10 @@ type t =
| Int of ikind | Int of ikind
| Float of fkind | Float of fkind
| Bool | Bool
(* [char]: a Unicode scalar value, a u32 at run time and its own type here,
so a code point is never mistaken for a number. It compares, orders and
hashes; it does no arithmetic, and [i32 c] / [char n] convert. *)
| Char
| String | String
| Unit (* the zero-sized type, not C's void *) | Unit (* the zero-sized type, not C's void *)
| Never (* return, exit, error: no value at all *) | Never (* return, exit, error: no value at all *)
@ -175,7 +179,7 @@ let fkind_of_name = function
and the identity is a half one. *) and the identity is a half one. *)
let primitive_names = let primitive_names =
[ "i8"; "i16"; "i32"; "i64"; "u8"; "u16"; "u32"; "u64"; [ "i8"; "i16"; "i32"; "i64"; "u8"; "u16"; "u32"; "u64";
"f32"; "f64"; "bool"; "str"; "dyn"; "Unit"; "Never"; "Allocator"; "f32"; "f64"; "bool"; "char"; "str"; "dyn"; "Unit"; "Never"; "Allocator";
"int"; "float" ] "int"; "float" ]
let ikind_name k = let ikind_name k =
@ -198,7 +202,7 @@ let rec equal a b =
different things at run time, which is the point of the type and is not different things at run time, which is the point of the type and is not
this function's question: this is identity of *static* types, and there is this function's question: this is identity of *static* types, and there is
one dyn type the way there is one string type. *) one dyn type the way there is one string type. *)
| Bool, Bool | String, String | Unit, Unit | Never, Never | Dyn, Dyn -> true | Bool, Bool | Char, Char | String, String | Unit, Unit | Never, Never | Dyn, Dyn -> true
| Named x, Named y | Enum x, Enum y -> String.equal x y | Named x, Named y | Enum x, Enum y -> String.equal x y
| Slice (a, x), Slice (b, y) -> a = b && equal x y | Slice (a, x), Slice (b, y) -> a = b && equal x y
| Array (n, x), Array (m, y) -> Int64.equal n m && equal x y | Array (n, x), Array (m, y) -> Int64.equal n m && equal x y
@ -272,6 +276,7 @@ and to_string = function
| Int k -> ikind_name k | Int k -> ikind_name k
| Float k -> fkind_name k | Float k -> fkind_name k
| Bool -> "bool" | Bool -> "bool"
| Char -> "char"
| String -> "str" | String -> "str"
| Unit -> "()" | Unit -> "()"
| Never -> "Never" | Never -> "Never"
@ -320,7 +325,7 @@ let is_integer = function Int _ -> true | _ -> false
key would hash an address, and hashing an address is a different operation key would hash an address, and hashing an address is a different operation
from hashing what it points at. *) from hashing what it points at. *)
let rec keyable = function let rec keyable = function
| Int _ | Enum _ | Bool | String -> true | Int _ | Enum _ | Bool | Char | String -> true
| Float _ -> false (* NaN /= NaN, and 0.0 and -0.0 differ bytewise *) | Float _ -> false (* NaN /= NaN, and 0.0 and -0.0 differ bytewise *)
| Array (_, t) -> keyable t | Array (_, t) -> keyable t
| Named _ -> true (* [Check] decides, by walking the fields *) | Named _ -> true (* [Check] decides, by walking the fields *)
@ -331,7 +336,7 @@ let rec keyable = function
what every type supports (plan.org, Types). A string has no ordering what every type supports (plan.org, Types). A string has no ordering
either: there is no true answer to whether one string is less than another either: there is no true answer to whether one string is less than another
until the language picks a collation, and byte order is not it. *) until the language picks a collation, and byte order is not it. *)
let is_comparable = function Enum _ -> true | t -> is_numeric t let is_comparable = function Enum _ | Char -> true | t -> is_numeric t
(* Equality admits one type ordering does not: a string, grown in by the M2 (* Equality admits one type ordering does not: a string, grown in by the M2
queue's item 5 — bytewise, by content and not by address, so two queue's item 5 — bytewise, by content and not by address, so two

View File

@ -537,8 +537,8 @@ let is_agg (t : Types.t) =
match t with match t with
(* A [(CFn ...)] is one word and crosses exactly as a pointer does, which (* A [(CFn ...)] is one word and crosses exactly as a pointer does, which
is the whole of its reason for existing. *) is the whole of its reason for existing. *)
| Types.Int _ | Types.Float _ | Types.Bool | Types.Ptr _ | Types.Enum _ | Types.Int _ | Types.Float _ | Types.Bool | Types.Char | Types.Ptr _
| Types.CFn _ -> false | Types.Enum _ | Types.CFn _ -> false
(* The record and its incarnation — see [Emit]'s %alloc. *) (* The record and its incarnation — see [Emit]'s %alloc. *)
| Types.Alloc -> true | Types.Alloc -> true
| Types.Unit | Types.Never -> false | Types.Unit | Types.Never -> false
@ -3673,7 +3673,10 @@ and slice_in_out f sym (src : loc) dst =
width, so one pair covers all sixty-four pairings. *) width, so one pair covers all sixty-four pairings. *)
and cast f (a : Tast.expr) (target : Types.t) dst = and cast f (a : Tast.expr) (target : Types.t) dst =
let concrete (t : Types.t) = let concrete (t : Types.t) =
match t with Types.Enum _ -> Types.Int Types.I32 | t -> t match t with
| Types.Enum _ -> Types.Int Types.I32
| Types.Char -> Types.Int Types.U32
| t -> t
in in
let src_t = concrete a.Tast.ty and dst_t = concrete target in let src_t = concrete a.Tast.ty and dst_t = concrete target in
let l = eval f a in let l = eval f a in

View File

@ -855,9 +855,12 @@ static void render(dyn_sink w, flan_dyn v, int depth, int nested) {
else emit_n(w, obj_text_bytes(o), o->len); else emit_n(w, obj_text_bytes(o), o->len);
return; return;
} }
/* A char prints as the literal that reads back as it, at every depth. */ /* A char at the top of a println is the character itself, and anywhere a
* reader must tell it apart — inside a value, in the inspector — the
* literal that reads back as it: Clojure's println against its pr. */
case FLAN_DYN_TAG_CHAR: case FLAN_DYN_TAG_CHAR:
char_spell((uint32_t)dyn_payload(v), buf); if (nested) char_spell((uint32_t)dyn_payload(v), buf);
else buf[utf8_encode((uint32_t)dyn_payload(v), (uint8_t *)buf)] = '\0';
emit(w, buf); emit(w, buf);
return; return;
/* A keyword prints with its colon, bare, at every depth: :a is its own /* A keyword prints with its colon, bare, at every depth: :a is its own
@ -2875,6 +2878,22 @@ int64_t flan_dyn_int_of(flan_dyn v) {
return flan_dyn_need_i64(v); return flan_dyn_need_i64(v);
} }
/* A typed char wanted: only a char. An int is refused rather than taken as a
* code point, because a number is not a character until (char n) says so. */
uint32_t flan_dyn_need_char(flan_dyn v, const uint8_t *loc, int64_t loclen) {
int32_t t = flan_dyn_tag(v);
char sv[SAY_MAX];
if (t == FLAN_DYN_TAG_CHAR) return (uint32_t)dyn_payload(v);
if (t == FLAN_DYN_TAG_NIL) sv[0] = '\0';
else say(sv, SAY_MAX, v);
flan_say(loc, loclen, "dyn: a char is wanted here, and this is %s%s%s%s%s%s",
t == FLAN_DYN_TAG_NIL ? "" : an(tag_of(v)),
t == FLAN_DYN_TAG_NIL ? "" : " ", tag_of(v),
t == FLAN_DYN_TAG_NIL ? "" : ", ", sv,
t == FLAN_DYN_TAG_INT ? ". Convert a code point with (char n)" : "");
flan_trap((const uint8_t *)"DynType", 7);
}
uint8_t flan_dyn_need_bool(flan_dyn v) { uint8_t flan_dyn_need_bool(flan_dyn v) {
if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL) if (flan_dyn_tag(v) != FLAN_DYN_TAG_BOOL)
trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v); trap1(NULL, 0, TYPE_TRAP, "bool", "a bool was wanted", v);
@ -3059,9 +3078,52 @@ static void want_nums(const uint8_t *loc, int64_t loclen, const char *op,
#define ARITH_NUM "it takes two numbers" #define ARITH_NUM "it takes two numbers"
/* Char arithmetic, the typed side's rule (decision 131): a char plus or
* minus an int, or an int plus a char, is a char, trapping where the result
* is not a scalar value; a char minus a char is the int distance. 0 when the
* pair is none of those, for [arith] to refuse as it refuses any non-number. */
static int char_arith(const uint8_t *loc, int64_t loclen, const char *op,
flan_dyn a, flan_dyn b, flan_dyn *out) {
int ca = flan_dyn_tag(a) == FLAN_DYN_TAG_CHAR;
int cb = flan_dyn_tag(b) == FLAN_DYN_TAG_CHAR;
int64_t n;
if (op[0] == '-' && ca && cb) {
*out = flan_dyn_from_i64((int64_t)dyn_payload(a) - (int64_t)dyn_payload(b));
return 1;
}
int64_t cp, m;
int sub = op[0] == '-';
if (ca && flan_dyn_tag(b) == FLAN_DYN_TAG_INT) {
cp = (int64_t)dyn_payload(a);
m = dyn_int_value(b);
} else if (!sub && cb && flan_dyn_tag(a) == FLAN_DYN_TAG_INT) {
cp = (int64_t)dyn_payload(b);
m = dyn_int_value(a);
} else
return 0;
/* Checked, so a trap names the true sum or which side it left. */
if (sub ? __builtin_sub_overflow(cp, m, &n) : __builtin_add_overflow(cp, m, &n)) {
flan_say(loc, loclen, "dyn %s: %lld %s %lld is %s, so it is not a char",
op, (long long)cp, sub ? "minus" : "plus", (long long)m,
(sub ? m < 0 : m > 0) ? "past 0x10FFFF" : "below zero");
dyn_trap((const uint8_t *)"InvalidChar", 11);
}
if (!is_scalar(n)) {
flan_say(loc, loclen,
"dyn %s: %lld is not a Unicode scalar value, so it is not a char",
op, (long long)n);
dyn_trap((const uint8_t *)"InvalidChar", 11);
}
*out = flan_dyn_from_char((int32_t)n);
return 1;
}
static flan_dyn arith(const uint8_t *loc, int64_t loclen, const char *op, static flan_dyn arith(const uint8_t *loc, int64_t loclen, const char *op,
flan_dyn a, flan_dyn b) { flan_dyn a, flan_dyn b) {
int64_t x, y; int64_t x, y;
flan_dyn c;
if ((op[0] == '+' || op[0] == '-') && char_arith(loc, loclen, op, a, b, &c))
return c;
want_nums(loc, loclen, op, ARITH_NUM, a, b); want_nums(loc, loclen, op, ARITH_NUM, a, b);
if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT && if (flan_dyn_tag(a) == FLAN_DYN_TAG_INT &&
flan_dyn_tag(b) == FLAN_DYN_TAG_INT) { flan_dyn_tag(b) == FLAN_DYN_TAG_INT) {
@ -3560,6 +3622,7 @@ static inline int is_map(flan_dyn v) {
* *
* b B h H i I l L i8 u8 i16 u16 i32 u32 i64 u64 * b B h H i I l L i8 u8 i16 u16 i32 u32 i64 u64
* f d ? f32 f64 bool * f d ? f32 f64 bool
* C char, a u32 code point
* t str (read as a copy; never written from here) * t str (read as a copy; never written from here)
* a<n>;T a fixed [n T] * a<n>;T a fixed [n T]
* sT a slice [T] * sT a slice [T]
@ -3611,7 +3674,7 @@ static void desc_lay(const uint8_t *d, int64_t *size, int64_t *align) {
switch (*d) { switch (*d) {
case 'b': case 'B': case '?': *size = 1; *align = 1; return; case 'b': case 'B': case '?': *size = 1; *align = 1; return;
case 'h': case 'H': *size = 2; *align = 2; return; case 'h': case 'H': *size = 2; *align = 2; return;
case 'i': case 'I': case 'f': *size = 4; *align = 4; return; case 'i': case 'I': case 'f': case 'C': *size = 4; *align = 4; return;
case 't': case 's': case 'c': *size = 16; *align = 8; return; case 't': case 's': case 'c': *size = 16; *align = 8; return;
case 'v': *size = 40; *align = 8; return; case 'v': *size = 40; *align = 8; return;
case 'a': { case 'a': {
@ -3647,7 +3710,7 @@ static inline int64_t desc_size(const uint8_t *d) {
switch (*d) { /* the scalars, without the walk */ switch (*d) { /* the scalars, without the walk */
case 'b': case 'B': case '?': return 1; case 'b': case 'B': case '?': return 1;
case 'h': case 'H': return 2; case 'h': case 'H': return 2;
case 'i': case 'I': case 'f': return 4; case 'i': case 'I': case 'f': case 'C': return 4;
case 'l': case 'L': case 'd': return 8; case 'l': case 'L': case 'd': return 8;
default: break; default: break;
} }
@ -3706,10 +3769,10 @@ static int64_t desc_nfields(const uint8_t *d) {
/* The Flan spelling of a descriptor's type, for a sentence. */ /* The Flan spelling of a descriptor's type, for a sentence. */
static void desc_spell(const uint8_t *d, char *buf, size_t cap) { static void desc_spell(const uint8_t *d, char *buf, size_t cap) {
static const char scalars[] = "bBhHiIlLfd?t"; static const char scalars[] = "bBhHiIlLfd?tC";
static const char *const words[] = { "i8", "u8", "i16", "u16", "i32", "u32", static const char *const words[] = { "i8", "u8", "i16", "u16", "i32", "u32",
"i64", "u64", "f32", "f64", "bool", "i64", "u64", "f32", "f64", "bool",
"str" }; "str", "char" };
const char *w; const char *w;
char inner[96]; char inner[96];
if (cap == 0) return; if (cap == 0) return;
@ -3971,6 +4034,7 @@ static flan_dyn view_read(const uint8_t *loc, int64_t loclen, const char *op,
case 'f': { float x; memcpy(&x, p, 4); return flan_dyn_from_f64((double)x); } case 'f': { float x; memcpy(&x, p, 4); return flan_dyn_from_f64((double)x); }
case 'd': { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); } case 'd': { double x; memcpy(&x, p, 8); return flan_dyn_from_f64(x); }
case '?': return flan_dyn_from_bool(*p ? 1 : 0); case '?': return flan_dyn_from_bool(*p ? 1 : 0);
case 'C': { uint32_t x; memcpy(&x, p, 4); return flan_dyn_from_char((int32_t)x); }
case 't': { case 't': {
const uint8_t *s; const uint8_t *s;
int64_t n; int64_t n;
@ -4177,6 +4241,17 @@ static void view_write(const uint8_t *loc, int64_t loclen, const char *op,
} }
*p = dyn_payload(x) ? 1 : 0; *p = dyn_payload(x) ? 1 : 0;
return; return;
/* Only a char: an int is a number until (char n) converts it. */
case 'C':
if (flan_dyn_tag(x) != FLAN_DYN_TAG_CHAR) {
if (field) {
value_is(why, sizeof why, x);
field_refuse(loc, loclen, op, v, key, d, x, "DynType", why);
}
trap2(loc, loclen, TYPE_TRAP, op, "this view's elements are char", v, x);
}
{ uint32_t w = (uint32_t)dyn_payload(x); memcpy(p, &w, 4); }
return;
case 't': case 't':
if (field) if (field)
field_refuse(loc, loclen, op, v, key, d, x, "DynType", field_refuse(loc, loclen, op, v, key, d, x, "DynType",
@ -4355,6 +4430,15 @@ void flan_dyn_print_at(flan_dyn v, const uint8_t *loc, int64_t loclen) {
void flan_dyn_print(flan_dyn v) { flan_dyn_print_at(v, NULL, 0); } void flan_dyn_print(flan_dyn v) { flan_dyn_print_at(v, NULL, 0); }
/* The same onto stdout, as a value inside a larger one prints: a text
* quoted and a char as its literal. println's walk calls it for a dyn or a
* char inside a typed struct, array or slice. */
void flan_dyn_print_nested_at(flan_dyn v, const uint8_t *loc, int64_t loclen) {
walk_site was = walk_enter(loc, loclen, "print");
render(flan_write_stdout, v, 0, 1);
walk_leave(was);
}
flan_dyn flan_dyn_eq_at(flan_dyn a, flan_dyn b, const uint8_t *loc, flan_dyn flan_dyn_eq_at(flan_dyn a, flan_dyn b, const uint8_t *loc,
int64_t loclen) { int64_t loclen) {
walk_site was = walk_enter(loc, loclen, "="); walk_site was = walk_enter(loc, loclen, "=");
@ -4644,6 +4728,13 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
} }
*p = dyn_payload(x) ? 1 : 0; *p = dyn_payload(x) ? 1 : 0;
return; return;
case 'C':
if (flan_dyn_tag(x) != FLAN_DYN_TAG_CHAR) {
into_wanted(why, sizeof why, d);
into_wrong(s, x, why);
}
{ uint32_t w = (uint32_t)dyn_payload(x); memcpy(p, &w, 4); }
return;
case 't': case 't':
if (!is_text(x)) if (!is_text(x))
into_wrong(s, x, "a str is wanted there, which only a text becomes"); into_wrong(s, x, "a str is wanted there, which only a text becomes");
@ -4767,10 +4858,10 @@ static void into_put(into_site *s, const uint8_t *d, flan_dyn x, uint8_t *p) {
/* The copy a [const T] reads, of a plain vec or a view of other elements. */ /* The copy a [const T] reads, of a plain vec or a view of other elements. */
static void into_copy(into_site *s, const uint8_t *e, flan_obj *o, static void into_copy(into_site *s, const uint8_t *e, flan_obj *o,
uint8_t *out) { uint8_t *out) {
static const char scalars[] = "bBhHiIlLfd?t"; static const char scalars[] = "bBhHiIlLfd?tC";
static const char *const words[] = { "i8", "u8", "i16", "u16", "i32", "u32", static const char *const words[] = { "i8", "u8", "i16", "u16", "i32", "u32",
"i64", "u64", "f32", "f64", "bool", "i64", "u64", "f32", "f64", "bool",
"str" }; "str", "char" };
const char *w = *e != '\0' ? strchr(scalars, *e) : NULL; const char *w = *e != '\0' ? strchr(scalars, *e) : NULL;
/* The registry keeps the name by pointer, so it is static text. */ /* The registry keeps the name by pointer, so it is static text. */
const char *type = w != NULL ? words[w - scalars] : "element"; const char *type = w != NULL ? words[w - scalars] : "element";

View File

@ -306,6 +306,8 @@ uint8_t flan_dyn_need_bool(flan_dyn v);
int64_t flan_dyn_need_int(flan_dyn v, int32_t kind, const uint8_t *loc, int64_t flan_dyn_need_int(flan_dyn v, int32_t kind, const uint8_t *loc,
int64_t loclen); int64_t loclen);
int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen); int32_t flan_dyn_need_i32(flan_dyn v, const uint8_t *loc, int64_t loclen);
/* For a typed char: a char's code point. An int traps; (char n) converts. */
uint32_t flan_dyn_need_char(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. */ /* 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); int64_t flan_dyn_int_of(flan_dyn v);
@ -401,6 +403,8 @@ void flan_dyn_need_as(flan_dyn v, const uint8_t *want, int64_t wantlen,
/* print, =, length and has-key with the site they were written at: a view /* print, =, length and has-key with the site they were written at: a view
* that traps inside one names it. */ * that traps inside one names it. */
void flan_dyn_print_at(flan_dyn v, const uint8_t *loc, int64_t loclen); void flan_dyn_print_at(flan_dyn v, const uint8_t *loc, int64_t loclen);
void flan_dyn_print_nested_at(flan_dyn v, const uint8_t *loc,
int64_t loclen);
flan_dyn flan_dyn_eq_at(flan_dyn a, flan_dyn b, const uint8_t *loc, flan_dyn flan_dyn_eq_at(flan_dyn a, flan_dyn b, const uint8_t *loc,
int64_t loclen); int64_t loclen);
flan_dyn flan_dyn_len_at(flan_dyn v, const uint8_t *loc, int64_t loclen); flan_dyn flan_dyn_len_at(flan_dyn v, const uint8_t *loc, int64_t loclen);

View File

@ -2985,6 +2985,56 @@ void flan_rune_check(int32_t c, const uint8_t *loc, int64_t loclen) {
rt_trap((const uint8_t *)"InvalidRune", 11); rt_trap((const uint8_t *)"InvalidRune", 11);
} }
/* (char n) on a value only known at run time: n itself when it is a Unicode
* scalar value. Taken as an i64 so every integer width arrives unchanged. */
uint32_t flan_char_of(int64_t n, const uint8_t *loc, int64_t loclen) {
if (n >= 0 && n <= 0x10ffff && !(n >= 0xd800 && n <= 0xdfff))
return (uint32_t)n;
flan_say(loc, loclen, "%lld is not a Unicode scalar value, so it is not a char",
(long long)n);
rt_trap((const uint8_t *)"InvalidChar", 11);
}
/* The same for a u64, which past 2^63 has no i64 to arrive as. */
uint32_t flan_char_of_u64(uint64_t n, const uint8_t *loc, int64_t loclen) {
if (n <= 0x10ffff && !(n >= 0xd800 && n <= 0xdfff)) return (uint32_t)n;
flan_say(loc, loclen, "%llu is not a Unicode scalar value, so it is not a char",
(unsigned long long)n);
rt_trap((const uint8_t *)"InvalidChar", 11);
}
/* A char plus or minus a u64 ([sub] 1 for minus), taken unsigned so no u64
* past the largest i64 wraps round to a char. */
uint32_t flan_char_step_u64(int32_t cp, uint64_t n, int32_t sub,
const uint8_t *loc, int64_t loclen) {
uint64_t r;
if (sub ? n > (uint64_t)cp : n > 0x10ffff) {
flan_say(loc, loclen, "%lld %s %llu is %s, so it is not a char",
(long long)cp, sub ? "minus" : "plus", (unsigned long long)n,
sub ? "below zero" : "past 0x10FFFF");
rt_trap((const uint8_t *)"InvalidChar", 11);
}
r = sub ? (uint64_t)cp - n : (uint64_t)cp + n;
return flan_char_of_u64(r, loc, loclen);
}
/* A char plus or minus any other integer, as an i64 ([sub] 1 for minus).
* The sum is checked for overflow first, so a trap names the true result or
* says which side of the range it left, never a wrapped number. */
uint32_t flan_char_step_i64(int32_t cp, int64_t n, int32_t sub,
const uint8_t *loc, int64_t loclen) {
int64_t r;
int over = sub ? __builtin_sub_overflow((int64_t)cp, n, &r)
: __builtin_add_overflow((int64_t)cp, n, &r);
if (over) {
flan_say(loc, loclen, "%lld %s %lld is %s, so it is not a char",
(long long)cp, sub ? "minus" : "plus", (long long)n,
(sub ? n < 0 : n > 0) ? "past 0x10FFFF" : "below zero");
rt_trap((const uint8_t *)"InvalidChar", 11);
}
return flan_char_of(r, loc, loclen);
}
/* [n] elements from [src] onto the end of a Vec, growing it once. [src] may /* [n] elements from [src] onto the end of a Vec, growing it once. [src] may
* point into the Vec's own block — (append s (str s)) — so where it lies is * point into the Vec's own block — (append s (str s)) — so where it lies is
* found before the grow and read again after it: the grow frees the old * found before the grow and read again after it: the grow frees the old

View File

@ -0,0 +1,63 @@
;;;; Char arithmetic (decision 131, Kotlin's rules): a char plus or minus an
;;;; integer is a char, an integer plus a char is too, and a char minus a char
;;;; is the distance, an i32. Dyn chars do the same. Byte code beside it is
;;;; unchanged. With "past" a char past U+10FFFF traps, with "surrogate" one
;;;; landing on a surrogate does, with "dyn" a dyn char below zero does, and
;;;; with "u64" a char plus the largest u64 does rather than wrapping round,
;;;; and with "i64" and "dyn-i64" a char plus the largest i64 does, naming it.
(defn show [x] () (println x))
(defn add [a b] dyn (+ a b))
(defn sub [a b] dyn (- a b))
(defn upper [c char] char (if (and (>= c \a) (<= c \z)) (- c 32) c))
;; A char minus a char where an integer is wanted is that integer.
(defn digit [c char] i32 (- c \0))
(defn gap [a char b char] u8 (- a b))
(defn gaps [a char b char] i32
(let [v (vec-new i32)]
(push v (- a b))
(+ (- a b) (at v 0) 1)))
(defn plus-u64 [c char n u64] char (+ c n))
(defn plus-i64 [c char n i64] char (+ c n))
(defn main [args [str]] i32
;; The fork case with arithmetic: a let-bound char stays a char.
(let [c \a]
(show c)
(show (+ c 1)))
;; Each rule, typed.
(let [c (char 100)
n 3]
(println (+ c n) (+ n c) (- c n) (- c \a) (- \a \A) (+ \a 1 1)))
(println (upper \q) (upper \Q) (upper \é))
(println (digit \7) (gap \c \a) (gaps \c \a) (plus-u64 \a (u64 2)))
;; Longer chains fold left, each step by its own operands.
(println (- \z \a 1) (+ 1 2 \a) (- \z 1 \a))
;; += and -= on a char local.
(let [c \a]
(set c (+ c 2))
(set c (- c 1))
(println c))
;; Dyn chars follow the same rules.
(println (add \a 1) (add 1 \a) (sub \z 1) (sub \a \A) (add (char 120) (the dyn 2)))
;; Byte code: a char difference where a byte is wanted is a byte.
(let [b (u8 65)
v (vec-new u8)]
(push v (+ b (- \a \A)))
(println (at v 0) (= (at v 0) \a)))
(when (> (length args) 1)
(let [k (length args)]
(cond
(= (at args 1) "past")
(println (+ (char 0x10FFFF) (- k 1)))
(= (at args 1) "surrogate")
(println (+ (char 0xD7FF) (- k 1)))
(= (at args 1) "u64")
(println (plus-u64 \a (- (u64 0) (u64 (- k 1)))))
(= (at args 1) "i64")
(println (plus-i64 \a (- (max-value i64) (i64 (- k 2)))))
(= (at args 1) "dyn-i64")
(println (add \a (- (max-value i64) (i64 (- k 2)))))
:else
(println (sub \a (* k 100))))))
0)

58
test/programs/char.flan Normal file
View File

@ -0,0 +1,58 @@
;;;; A typed char (decision 127): a char literal is a char unless typed code
;;;; wants a number, and a char crossing into dyn stays a char. It compares,
;;;; orders and hashes; (i32 c) and (char n) convert. With "dyn-int" a dyn
;;;; int at a char parameter traps, with "surrogate" (char n) does, and with
;;;; "u64" (char n) on a u64 past 2^63 does, naming the u64.
(defn show [x] () (println x))
(defn take-char [c char] char c)
(defn next-char [c char] char (char (+ (i32 c) 1)))
(defn a-dyn [x] dyn x)
(defn main [args [str]] i32
;; A direct literal and a let-bound one print alike through dyn.
(show \a)
(let [c \a] (show c))
;; Printed as its literal, as a dyn char is, alone and inside a value.
(let [e \é]
(println e [e \z \space])
(println (i32 e) (u32 e)))
;; Equality and ordering by code point.
(println (< \a \b) (= \a \a) (!= \a \b) (>= \é \z) (min \q \c) (max \q \c))
;; Conversions both ways.
(println (char 65) (char 0x1F600) (i32 \A) (u8 \A) (next-char \y))
(let [n 66] (println (char n)))
;; A map keyed by char.
(let [m (map-new char i32)]
(put m \x 1)
(put m \é 2)
(println (get m \x) (get m \é) (has-key m \y)))
;; A match over a char.
(let [k \b]
(println (match k \a 1 \b 2 _ 0)))
;; Byte code is unchanged: a literal beside a byte is the byte.
(let [b (u8 97)
v (vec-new u8)
s (string-new)]
(println (= b \a) (= \a b))
(push v \z)
(println (at v 0))
;; And a char appends to a String as its UTF-8.
(append s \é)
(append s (char 0x65E5))
(println s))
;; A dyn char into a typed char, and typed chars viewed from dyn.
(println (take-char (a-dyn \q)))
(let [cs [\x \y]]
(show cs)
(show (at (a-dyn cs) 1)))
(when (> (length args) 1)
(cond
(= (at args 1) "dyn-int") (println (take-char (a-dyn 97)))
(= (at args 1) "u64")
(let [n (+ (u64 9223372036854775807) (u64 (length args)))]
(println (char n)))
:else
(let [n (+ 0xD800 (length args))]
(println (char n)))))
0)

View File

@ -1,19 +1,20 @@
;;;; Every ASCII code point, the C1 controls, and a few past them, as dyn chars printed one per ;;;; 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 ;;;; line, each inside a vector, where a char prints as its literal. The test
;;;; code point, so what a char prints as is what reads as it. ;;;; reads each back with the reader and wants the same code point, so what a
;;;; char prints as there is what reads as it.
(defn main [] i32 (defn main [] i32
(let [v (vec-new u8)] (let [v (vec-new u8)]
(dotimes [i 128] (push v (u8 i))) (dotimes [i 128] (push v (u8 i)))
(let [t (the dyn (str (slice v)))] (let [t (the dyn (str (slice v)))]
(dotimes [i (length t)] (println (at t i)))) (dotimes [i (length t)] (println [(at t i)])))
;; the C1 controls, U+0080 to U+009F, and U+00A0, each C2 then one byte ;; the C1 controls, U+0080 to U+009F, and U+00A0, each C2 then one byte
(let [w (vec-new u8)] (let [w (vec-new u8)]
(dotimes [i 33] (push w (u8 0xC2)) (push w (u8 (+ 0x80 i)))) (dotimes [i 33] (push w (u8 0xC2)) (push w (u8 (+ 0x80 i))))
(let [c1 (the dyn (str (slice w)))] (let [c1 (the dyn (str (slice w)))]
(dotimes [i (length c1)] (println (at c1 i)))) (dotimes [i (length c1)] (println [(at c1 i)])))
(free w)) (free w))
(let [u (the dyn "é日😀")] (let [u (the dyn "é日😀")]
(dotimes [i (length u)] (println (at u i)))) (dotimes [i (length u)] (println [(at u i)])))
(free v)) (free v))
0) 0)

View File

@ -102,7 +102,7 @@
(let [a [6 2 4 9 1 9 4 5]] (let [a [6 2 4 9 1 9 4 5]]
(sort (slice a)) (sort (slice a))
(show (slice a))) ; 1 2 4 4 5 6 9 9 (show (slice a))) ; 1 2 4 4 5 6 9 9
(let [cs [\I \N \S \E \R \T \I \O \N \S \O \R \T]] (let [cs [(u8 \I) \N \S \E \R \T \I \O \N \S \O \R \T]]
(sort (slice cs)) (sort (slice cs))
(println (str (slice cs)))) ; EIINNOORRSSTT (println (str (slice cs)))) ; EIINNOORRSSTT

View File

@ -33,7 +33,7 @@
n 0] n 0]
(while going (while going
(match (runes-next (addr it)) (match (runes-next (addr it))
(Some c) (do (when (> c 127) (print c "")) (set n (+ n 1))) (Some c) (do (when (> (i32 c) 127) (print (i32 c) "")) (set n (+ n 1)))
None (set going false))) None (set going false)))
(println n)) (println n))
;; A copy is independent of the original. ;; A copy is independent of the original.

View File

@ -64,6 +64,10 @@
(print (match o (Some v) v None -1)) (print (match o (Some v) v None -1))
(print " ")) (print " "))
(defn show-char-opt [o (Option char)] ()
(print (match o (Some c) (i32 c) None -1))
(print " "))
;; Encode into the scratch buffer and decode straight back out of it. A round ;; Encode into the scratch buffer and decode straight back out of it. A round
;; trip is the only check that catches an encoder and a decoder that are ;; trip is the only check that catches an encoder and a decoder that are
;; wrong in the same direction — printing the bytes would not. ;; wrong in the same direction — printing the bytes would not.
@ -145,11 +149,11 @@
;; rune-at: on a boundary, off a boundary, and out of range. Off a boundary ;; rune-at: on a boundary, off a boundary, and out of range. Off a boundary
;; is None rather than a replacement character, which is where this is ;; is None rather than a replacement character, which is where this is
;; stricter than Odin's rune_at. ;; stricter than Odin's rune_at.
(show-opt (rune-at (bytes-view "日本") 0)) ; 26085 (show-char-opt (rune-at (bytes-view "日本") 0)) ; 26085
(show-opt (rune-at (bytes-view "日本") 3)) ; 26412 (show-char-opt (rune-at (bytes-view "日本") 3)) ; 26412
(show-opt (rune-at (bytes-view "日本") 1)) ; -1, mid-character (show-char-opt (rune-at (bytes-view "日本") 1)) ; -1, mid-character
(show-opt (rune-at (bytes-view "日本") 6)) ; -1, past the end (show-char-opt (rune-at (bytes-view "日本") 6)) ; -1, past the end
(show-opt (rune-at (bytes-view "") 0)) ; -1 (show-char-opt (rune-at (bytes-view "") 0)) ; -1
(println "") (println "")
;; rune-size, at every boundary and on both sides of it. ;; rune-size, at every boundary and on both sides of it.

View File

@ -2235,7 +2235,7 @@ let () =
let get_checked_out = let get_checked_out =
"none\n1\n3\nnone\n4\nnone\nnone\n6\nnone\n3\nnone\n\ "none\n1\n3\nnone\n4\nnone\nnone\n6\nnone\n3\nnone\n\
none\n10\n30\nnone\n20\n30\nnone\nnone\n101\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\n\\\u{e9}\n\\y\nnil\n" nil\n10\n30\nnil\n21\nnil\nnil\n1\nnil\n6\nnil\n1\n\u{e9}\ny\nnil\n"
in in
outputs "get as a checked lookup" "programs/get-checked.flan" get_checked_out; 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" outputs ~opt:"-O0" "get as a checked lookup, -O0" "programs/get-checked.flan"
@ -5586,19 +5586,92 @@ level "1"
code point in a typed i32. With an argument, a dyn int at the i32 code point in a typed i32. With an argument, a dyn int at the i32
traps at the call. *) traps at the call. *)
let dyn_char_out = let dyn_char_out =
"\\I\n\\é\n\\日\n\\😀\n[\\a \\space \\( \\newline]\n:char\n\ "I\né\n日\n😀\n[\\a \\space \\( \\newline]\n:char\n\
6\n\\é\n\\日\n\\😀\n\\o\n日😀\n\ 6\né\n日\n😀\no\n日😀\n\
[\\é \\日 \\😀 \\space \\o \\k]\n6\né日😀 ok\ntrue\n日\nok\n\ [\\é \\日 \\😀 \\space \\o \\k]\n6\né日😀 ok\ntrue\n日\nok\n\
true\nfalse\nfalse\nfalse\ntrue\nfalse\ntrue\n2\n128512\n5\n97\n" true\nfalse\nfalse\nfalse\ntrue\nfalse\ntrue\n2\n128512\n5\n97\n"
in in
outputs "dyn: chars" "programs/dyn-char.flan" dyn_char_out; outputs "dyn: chars" "programs/dyn-char.flan" dyn_char_out;
outputs ~opt:"-O0" "dyn: chars, -O0" "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; outputs ~x86:true "dyn: chars, --x86" "programs/dyn-char.flan" dyn_char_out;
(* A typed char: the fork case, printing, ordering, conversions, a map
key, a match, byte code beside it, a String append, and the crossings
both ways. Then a dyn int at a char parameter and (char n) on a
surrogate, each trapping at its own form. *)
let char_out =
"a\na\né [\\é \\z \\space]\n233 233\n\
true true true true c q\nA 😀 65 65 z\nB\n\
(some 1) (some 2) false\n2\ntrue true\n122\né日\nq\n[\\x \\y]\ny\n"
in
outputs "char: a typed char" "programs/char.flan" char_out;
outputs ~opt:"-O0" "char: a typed char, -O0" "programs/char.flan" char_out;
outputs ~x86:true "char: a typed char, --x86" "programs/char.flan" char_out;
List.iter
(fun x86 ->
let exe = compile ~x86 "programs/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 char: %s traps%s\n got: %S (exit %d)\n \
wanted: %S (exit 134)\n"
arg (if x86 then ", --x86" else "") text code want
end)
[ ("dyn-int", "programs/char.flan:51:53: dyn: a char is wanted \
here, and this is an int, 97. Convert a code point \
with (char n)");
("surrogate", "programs/char.flan:57:18: 55298 is not a Unicode \
scalar value, so it is not a char");
("u64", "programs/char.flan:54:18: 9223372036854775809 is not a \
Unicode scalar value, so it is not a char") ])
[ false; true ];
(* Char arithmetic, decision 131: every rule typed and dyn, the fork case
with arithmetic, and a byte beside it; then a char past U+10FFFF, one
on a surrogate, and a dyn one below zero, each trapping at its form. *)
let char_arith_out =
"a\nb\ng g a 3 32 c\nQ Q é\n7 2 5 c\n24 d 24\nb\nb b y 32 z\n97 true\n"
in
outputs "char: arithmetic" "programs/char-arith.flan" char_arith_out;
outputs ~opt:"-O0" "char: arithmetic, -O0" "programs/char-arith.flan"
char_arith_out;
outputs ~x86:true "char: arithmetic, --x86" "programs/char-arith.flan"
char_arith_out;
List.iter
(fun x86 ->
let exe = compile ~x86 "programs/char-arith.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 char arithmetic: %s traps%s\n got: %S (exit \
%d)\n wanted: %S (exit 134)\n"
arg (if x86 then ", --x86" else "") text code want
end)
[ ("past", "programs/char-arith.flan:52:18: 1114112 is not a \
Unicode scalar value, so it is not a char");
("surrogate", "programs/char-arith.flan:54:18: 55296 is not a \
Unicode scalar value, so it is not a char");
("u64", "programs/char-arith.flan:20:36: 97 plus \
18446744073709551615 is past 0x10FFFF, so it is not a \
char");
("i64", "programs/char-arith.flan:21:36: 97 plus \
9223372036854775807 is past 0x10FFFF, so it is not a \
char");
("dyn-i64", "programs/char-arith.flan:10:21: dyn +: 97 plus \
9223372036854775807 is past 0x10FFFF, so it is not \
a char");
("dyn", "programs/char-arith.flan:11:21: dyn -: -103 is not a \
Unicode scalar value, so it is not a char") ])
[ false; true ];
(* A String, and a str made from one, cross into dyn as text measured (* A String, and a str made from one, cross into dyn as text measured
like any other: characters counted, ASCII or not. *) like any other: characters counted, ASCII or not. *)
let string_char_out = let string_char_out =
"ab 2 \\b\né日😀! 4 \\日 \\!\n日😀 [\\é \\日 \\😀 \\!]\n\ "ab 2 b\né日😀! 4 日 !\n日😀 [\\é \\日 \\😀 \\!]\n\
é日😀! 4 \\😀 true\n10 4\n" é日😀! 4 😀 true\n10 4\n"
in in
outputs "dyn: a String crossing counts chars" outputs "dyn: a String crossing counts chars"
"programs/dyn-char-string.flan" string_char_out; "programs/dyn-char-string.flan" string_char_out;
@ -5609,7 +5682,7 @@ level "1"
(* A text pinned by crossing into a str keeps counting characters (the (* 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), pin's stamp and the text's measure live in different header fields),
and a char writes through a view of typed storage. *) 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 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" outputs "dyn: a pinned text counts chars" "programs/dyn-char-pinned.flan"
pinned_out; pinned_out;
outputs ~opt:"-O0" "dyn: a pinned text counts chars, -O0" outputs ~opt:"-O0" "dyn: a pinned text counts chars, -O0"
@ -5685,7 +5758,8 @@ level "1"
("x", "52:34: dyn: an i64 is wanted here, and this is a text, \ ("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") ]) \"x\". An i64 takes an int or a char's code point") ])
[ false; true ]; [ false; true ];
(* Print, then read: each char dyn-char-spell.flan prints — every ASCII (* Print, then read: each char dyn-char-spell.flan prints inside a vector,
where a char shows its literal — every ASCII
code point, the C1 controls, then four past them — reads back as the code point it was, 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 and so does the compiler's own spelling of the same literal, which is
what flan convert writes. *) what flan convert writes. *)
@ -5713,7 +5787,12 @@ level "1"
let code, text = run exe None in let code, text = run exe None in
let lines = String.split_on_char '\n' text in let lines = String.split_on_char '\n' text in
let lines = List.filteri (fun i _ -> i < List.length spelled) lines in let lines = List.filteri (fun i _ -> i < List.length spelled) lines in
let got = List.map read_char lines in let unwrap l =
let n = String.length l in
if n >= 2 && l.[0] = '[' && l.[n - 1] = ']' then String.sub l 1 (n - 2)
else l
in
let got = List.map (fun l -> read_char (unwrap l)) lines in
if code <> 0 || got <> List.map Option.some spelled then begin if code <> 0 || got <> List.map Option.some spelled then begin
incr failures; incr failures;
Printf.printf "FAIL dyn chars read back as printed%s\n \ Printf.printf "FAIL dyn chars read back as printed%s\n \

View File

@ -1076,7 +1076,7 @@ let () =
(* ── Literal defaulting and inference ──────────────────────────── *) (* ── Literal defaulting and inference ──────────────────────────── *)
infers "int defaults to i32" "42" "i32"; infers "int defaults to i32" "42" "i32";
infers "float defaults to f64" "0.5" "f64"; infers "float defaults to f64" "0.5" "f64";
infers "byte is u8" "\\space" "u8"; infers "a char literal is a char" "\\space" "char";
infers "string" "\"hi\"" "str"; infers "string" "\"hi\"" "str";
infers "bool" "true" "bool"; infers "bool" "true" "bool";
infers "arithmetic keeps kind" "(+ 1 2)" "i32"; infers "arithmetic keeps kind" "(+ 1 2)" "i32";
@ -3198,6 +3198,87 @@ let () =
~needle:"\\😀 is code point 128512, which does not fit in a u16"; ~needle:"\\😀 is code point 128512, which does not fit in a u16";
accepts "an ASCII char is a u8" accepts "an ASCII char is a u8"
"(defn main [] i32 (let [b (the u8 97)] (if (= b \\a) 0 1)))"; "(defn main [] i32 (let [b (the u8 97)] (if (= b \\a) 0 1)))";
(* Decision 127: a char literal is a char unless typed code wants a
number, and a char is a character: it compares, orders and hashes. *)
accepts "a let-bound char literal beside a u8 is the u8"
"(defn main [] i32 (let [b (the u8 97) c \\a] (if (= b c) 0 1)))";
accepts "a char literal pushed into bytes is a byte"
"(defn main [] i32 (let [v (vec-new u8)] (push v \\a) 0))";
accepts "a char parameter, compared and ordered"
"(defn f [c char] bool (and (= c \\a) (< c \\z) (!= c (char 98))))";
accepts "a char defconst beside a byte is the byte, either side of ="
"(defconst sep \\,)\n\
(defn main [] i32 (let [b (the u8 44)] (if (and (= b sep) (= sep b)) 0 1)))";
accepts "a char as a map key"
"(defn main [] i32 (let [m (map-new char i32)] (put m \\a 1) 0))";
accepts "a char converts to an integer and back"
"(defn f [c char] char (char (+ (i32 c) 1)))";
(* Decision 131, Kotlin's rules: a char plus or minus an integer is a char,
a char minus a char is an i32, and nothing else computes with one. *)
accepts "a char plus an integer is a char"
"(defn f [c char n i32] char (+ c n))";
accepts "an integer plus a char is a char"
"(defn f [c char] char (+ 1 c))";
accepts "a char minus an integer is a char"
"(defn f [c char] char (- c 1))";
accepts "a char minus a char is an i32"
"(defn f [c char] i32 (- c \\a))";
accepts "a let-bound char plus a literal stays a char"
"(defn f [] char (let [c \\a] (+ c 1)))";
accepts "a char difference is a byte where a byte is wanted"
"(defn f [b u8] u8 (+ b (- \\a \\A)))";
rejects_check "a char does not add to a char"
"(defn f [c char] char (+ c c))"
~needle:"+ adds an integer to a char, and not a char to a char. Take its \
code point with (i32 c)";
rejects_check "nor multiply"
"(defn f [c char] i32 (let [n 3] (* n c)))"
~needle:"* does no arithmetic on a char";
rejects_check "nor come off an integer"
"(defn f [c char] i32 (- 1 c))"
~needle:"- takes an integer or a char from a char, and not a char from an \
integer";
rejects_check "nor take a remainder"
"(defn f [c char] char (% c 2))" ~needle:"% does no arithmetic on a char";
rejects_check "an integer literal is not a char"
"(defn f [c char] bool (= c 97))"
~needle:"the integer literal 97 is not a char, and a char compares only \
with a char. Take its code point with (i32 c)";
rejects_check "nor is an integer"
"(defn f [c char n i32] bool (< c n))"
~needle:"< compares a char only with a char, and this is i32 beside it";
rejects_check "a constant char past the last code point"
"(defn f [] char (- \\a 200))"
~needle:"this is -103, which is not a Unicode scalar value";
rejects_check "nor negated"
"(defn f [c char] char (- c))" ~needle:"- does not negate a char";
accepts "a char minus a char where an i32 is wanted"
"(defn f [c char] i32 (- c \\0))";
accepts "a char minus a char where a u8 is wanted"
"(defn f [a char b char] u8 (- a b))";
accepts "a char distance in arithmetic"
"(defn f [a char b char] i32 (+ (- a b) 1))";
rejects_check "nor bitwise"
"(defn f [c char] char (bit-and c c))"
~needle:"bit-and does no arithmetic on a char";
rejects_check "a surrogate is not a char"
"(defn main [] i32 (let [c (char 0xD800)] 0))"
~needle:"55296 is not a Unicode scalar value, so it is not a char";
rejects_check "nor is a negative number"
"(defn main [] i32 (let [c (char -1)] 0))"
~needle:"-1 is not a Unicode scalar value";
rejects_check "nor anything past U+10FFFF"
"(defn main [] i32 (let [c (char 0x110000)] 0))"
~needle:"1114112 is not a Unicode scalar value";
rejects_check "a char converts to an integer, not a float"
"(defn f [c char] f64 (f64 c))"
~needle:"a char converts only to an integer";
rejects_check "char takes an integer"
"(defn f [x f64] char (char x))"
~needle:"char makes a char from an integer code point, found f64";
rejects_check "a non-ASCII char literal cast to a byte"
"(defn main [] i32 (let [b (u8 \\é)] 0))"
~needle:"\\é is 2 bytes in UTF-8, not one, so it is not a u8";
rejects_check "type-of takes one argument" rejects_check "type-of takes one argument"
"(defn main [] i32 (let [k (type-of 1 2)] 0))" ~needle:"type-of"; "(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 (* The constructor is an ordinary function, so its arity is the ordinary
@ -3358,13 +3439,13 @@ let () =
accepts "typed = on strings" "(defn f [] bool (= \"a\" \"b\"))"; accepts "typed = on strings" "(defn f [] bool (= \"a\" \"b\"))";
accepts "typed != on strings" "(defn f [] bool (!= \"a\" \"b\"))"; accepts "typed != on strings" "(defn f [] bool (!= \"a\" \"b\"))";
rejects_check "no built-in < on strings" rejects_check "no built-in < on strings"
"(defn f [] bool (< \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; "(defn f [] bool (< \"a\" \"b\"))" ~needle:"orders machine numbers, chars and enums";
rejects_check "no built-in <= on strings" rejects_check "no built-in <= on strings"
"(defn f [] bool (<= \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; "(defn f [] bool (<= \"a\" \"b\"))" ~needle:"orders machine numbers, chars and enums";
rejects_check "no built-in > on strings" rejects_check "no built-in > on strings"
"(defn f [] bool (> \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; "(defn f [] bool (> \"a\" \"b\"))" ~needle:"orders machine numbers, chars and enums";
rejects_check "no built-in >= on strings" rejects_check "no built-in >= on strings"
"(defn f [] bool (>= \"a\" \"b\"))" ~needle:"orders machine numbers and enums"; "(defn f [] bool (>= \"a\" \"b\"))" ~needle:"orders machine numbers, chars and enums";
(* (Vec T) is built. What is still refused is the arity: one element type, (* (Vec T) is built. What is still refused is the arity: one element type,
and a near-miss there would otherwise resolve to a type variable and come and a near-miss there would otherwise resolve to a type variable and come
back as generics. *) back as generics. *)
@ -5050,11 +5131,11 @@ let () =
accepts "!= on bools, chained" "(defn f [a bool b bool] bool (!= a b true))"; accepts "!= on bools, chained" "(defn f [a bool b bool] bool (!= a b true))";
rejects_check "< on bools" rejects_check "< on bools"
"(defn f [a bool b bool] bool (< a b))" "(defn f [a bool b bool] bool (< a b))"
~needle:"< orders machine numbers and enums, and bool is neither"; ~needle:"< orders machine numbers, chars and enums, and bool is none of those";
rejects_check "= on a struct names what it compares" rejects_check "= on a struct names what it compares"
"(defstruct P [x i32])\n(defn f [a P b P] bool (= a b))" "(defstruct P [x i32])\n(defn f [a P b P] bool (= a b))"
~needle:"= compares numbers, enums, strings and bools, and P is none of \ ~needle:"= compares numbers, chars, enums, strings and bools, and P is \
those"; none of those";
(* A destructuring pattern in an arm's binds is a name position like any (* A destructuring pattern in an arm's binds is a name position like any
other. *) other. *)
rejects_check "a pattern inside a match arm's binds" rejects_check "a pattern inside a match arm's binds"