From e81191d7706ff04fd7469b9b3ef9b9889111b643 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 21:50:56 +0700 Subject: [PATCH] A bool returned from C reads as its low bit on --x86 as on LLVM, and the where-and fix and the x-1 hint follow the code's own syntax rather than its file name --- lib/check.ml | 2 +- lib/indent_reader.ml | 16 ++++++++++++++++ lib/parse.ml | 25 ++++++------------------- lib/source.ml | 15 +++++++++++++-- lib/x86.ml | 5 +++++ test/programs/ffi-bool.flan | 24 ++++++++++++++++++++++++ test/test_acceptance.ml | 6 ++++++ test/test_syntax.ml | 16 +++++----------- 8 files changed, 76 insertions(+), 33 deletions(-) create mode 100644 test/programs/ffi-bool.flan diff --git a/lib/check.ml b/lib/check.ml index c673442f..a3065a85 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -8868,7 +8868,7 @@ and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a = and [x/2] are one name each. When the parts either side of an operator character are a value in scope and a number or another value, that is almost certainly the arithmetic, and the sentence says how to spell it. *) - (if Filename.check_suffix loc.Loc.file ".fln" then begin + (if Source.indented_at loc then begin let known s = s <> "" && (String.for_all (fun c -> (c >= '0' && c <= '9') || c = '.') s diff --git a/lib/indent_reader.ml b/lib/indent_reader.ml index 2f8ad73f..fd719c39 100644 --- a/lib/indent_reader.ml +++ b/lib/indent_reader.ml @@ -1209,6 +1209,22 @@ and header (s : st) w : Form.t = let wt = advance p in let rec preds acc = let e, _ = expr p in + (* [and] is how a condition joins tests, so it is what gets written + for several predicates; the clause separates them with commas. *) + (match e.Form.v with + | Form.List ({ Form.v = Form.Sym "and"; _ } :: (_ :: _ as ps)) -> + let spell (q : Form.t) = + match q.Form.v with + | Form.List [ { Form.v = Form.Sym n; _ }; + { Form.v = Form.Sym v; _ } ] -> + Printf.sprintf "%s(%s)" n v + | _ -> Form.to_string q + in + failk "where-and" e.Form.loc + "a where clause separates its predicates with commas, not and \ + — write where %s" + (String.concat ", " (List.map spell ps)) + | _ -> ()); match (peek p).tok with | COMMA -> ignore (advance p); preds (e :: acc) | _ -> List.rev (e :: acc) diff --git a/lib/parse.ml b/lib/parse.ml index bf36a4bc..5a76c9ab 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -374,26 +374,13 @@ let constraints (body : Form.t list) : Ast.pred list * Form.t list = { Ast.pname = name; pvar = String.sub v 1 (String.length v - 1); ploc = p.Form.loc } (* [and] is how a condition joins tests, so it is what gets written - for several predicates. The fix is spelled in the file's own syntax, - which only the location's file name tells apart here. *) + for several predicates. The .fln reader refuses its own spelling of + this with its own fix; what reaches here is paren code. *) | Form.List ({ Form.v = Form.Sym "and"; _ } :: (_ :: _ as ps)) -> - let fln = Filename.check_suffix p.Form.loc.Loc.file ".fln" in - let fln_pred (q : Form.t) = - match q.Form.v with - | Form.List [ { Form.v = Form.Sym n; _ }; { Form.v = Form.Sym v; _ } ] - -> Printf.sprintf "%s(%s)" n v - | _ -> Form.to_string q - in - if fln then - Loc.fail p.Form.loc - "a where clause separates its predicates with commas, not and — \ - write where %s" - (String.concat ", " (List.map fln_pred ps)) - else - Loc.fail p.Form.loc - "a where clause puts several predicates in a vector, not in an \ - and — write {:where [%s]}" - (String.concat " " (List.map Form.to_string ps)) + Loc.fail p.Form.loc + "a where clause puts several predicates in a vector, not in an and \ + — write {:where [%s]}" + (String.concat " " (List.map Form.to_string ps)) | _ -> Loc.fail p.Form.loc "a where predicate is (name? $t), one predicate about one type \ diff --git a/lib/source.ml b/lib/source.ml index d6429e19..48966744 100644 --- a/lib/source.ml +++ b/lib/source.ml @@ -41,13 +41,24 @@ let syntax_of_field = function | Some ("indented" | "fln") -> Indented | _ -> Paren +let in_request = ref false + let with_code ?indent ~syntax ~at f = - let s = !code_syntax and a = !code_at and i = !code_indent in + let s = !code_syntax and a = !code_at and i = !code_indent + and r = !in_request in code_syntax := syntax; code_at := at; code_indent := indent; + in_request := true; Fun.protect - ~finally:(fun () -> code_syntax := s; code_at := a; code_indent := i) f + ~finally:(fun () -> + code_syntax := s; code_at := a; code_indent := i; in_request := r) f + +(* Was the code at [loc] written in the indented syntax? Inside an editor + request the request says; outside one a file's name does, as + [read_file] decides. *) +let indented_at (loc : Loc.t) = + if !in_request then !code_syntax = Indented else is_indented loc.Loc.file (* The paren reader started at a line and column: [Reader.read_all] always starts at 1:1. *) diff --git a/lib/x86.ml b/lib/x86.ml index 6b409272..7e557646 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -3244,6 +3244,11 @@ and call_native ?at f ~sym ?(chan = false) ~(args : Tast.expr list) ~rty dst = unsupported "%s returns %s by value, which needs SysV return classification this \ backend does not have" sym (Types.to_string rty); + (* A C bool is 0 or 1 only by the callee's good faith: [(declare f [..] + bool "abs")] hands back whatever byte abs left. LLVM declares the + return [i1] and reads its low bit, so this does too, and every bool + past this point is 0 or 1 — which [=], [not] and [match] assume. *) + if Types.equal rty Types.Bool then and_imm f.b ~dst:rax 1; store_loc f ~reg:(if is_float rty then xmm0 else rax) dst rty end diff --git a/test/programs/ffi-bool.flan b/test/programs/ffi-bool.flan new file mode 100644 index 00000000..f0112205 --- /dev/null +++ b/test/programs/ffi-bool.flan @@ -0,0 +1,24 @@ +;;;; A bool from C that is not 0 or 1 reads as its low bit on both backends: +;;;; abs(3) is 3, which is true, and equal to abs(1). + +(declare two [n i32] bool "abs") + +(defstruct Flag [on bool]) + +(defn main [] i32 + (let [a (two 3) + b (two 1) + c (two 0) + f (Flag {.on a}) + v [a b]] + (print (= a b)) (print " ") + (print (!= a b)) (print " ") + (print (= a true)) (print " ") + (print (= (.on f) b)) (print " ") + (print (= (at v 0) (at v 1))) (print " ") + (print (match a true "T" false "F")) (print " ") + (print (if a "t" "f")) (print " ") + (print (not a)) (print " ") + (print (= c false)) + (println "") + 0)) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 1c25dae4..dd1821ca 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -459,6 +459,12 @@ let () = "programs/match-bool.flan" match_bool_out; outputs ~dev:true "match over a bool and keywords, dev" "programs/match-bool.flan" match_bool_out; + let ffi_bool_out = "true false true true true T t false true\n" in + outputs "a bool from C" "programs/ffi-bool.flan" ffi_bool_out; + outputs ~opt:"-O0" "a bool from C, -O0" "programs/ffi-bool.flan" + ffi_bool_out; + outputs ~x86:true "a bool from C, --x86" "programs/ffi-bool.flan" + ffi_bool_out; (* update, ++ and -- evaluate their place's subexpressions once: the counts are the number of calls an index or a key function got. *) let update_out = "3\n11 20 90\n1 1 3\n16\n2\n7 1\n32\n2 50\n" in diff --git a/test/test_syntax.ml b/test/test_syntax.ml index 9470557e..553c684f 100644 --- a/test/test_syntax.ml +++ b/test/test_syntax.ml @@ -287,6 +287,11 @@ let () = "(defn g [h (Fn [i32 i32] bool)] () (h 1 2))"; reads "untyped parameter is dyn" "fn id(x) -> dyn = x" "(defn id [x dyn] dyn x)"; refuses "no return type" "fn f(x)\n x" "indent/return-type" "-> i32"; + (* The fix is .fln's commas whatever the file is called: [read] names it + . *) + refuses "where predicates joined with and" + "fn f(x: $t, y: $u) -> i32 where ordered?($t) and equal?($u)\n 0" + "indent/where-and" "commas, not and — write where ordered?($t), equal?($u)"; (* Characters, lexed before brackets and separators. *) reads "character literals" "x = [\\( \\, \\space \\)]" "(set x [\\( \\, \\space \\)])"; reads "character arguments" "f(\\,, \\))" "(f \\, \\))"; @@ -534,17 +539,6 @@ let () = if not (Test_support.contains d.Loc.dmsg "Did you mean x - 1?") then fail "x-1: %s" d.Loc.dmsg | exception e -> fail "x-1: %s" (Printexc.to_string e)); - (* Several where predicates joined with and: the fix is .fln's commas. *) - let f = Filename.concat scratch "syntax-where-and.fln" in - write f "fn f(x: $t, y: $u) -> i32 where ordered?($t) and equal?($u)\n 0\n"; - (match Front.checked f with - | _ -> fail "where joined with and checked" - | exception Loc.Error d -> - if not (Test_support.contains d.Loc.dmsg - "separates its predicates with commas, not and — write where \ - ordered?($t), equal?($u)") then - fail "where joined with and: %s" d.Loc.dmsg - | exception e -> fail "where joined with and: %s" (Printexc.to_string e)); (* One package, one file in two syntaxes: refused naming both. *) let dir = Filename.concat scratch "syntax-twin" in let pkg = Filename.concat dir "geo" in