From b0a4be0f2235da6950ae0b267da04cbea33adc8e Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 4 Apr 2026 22:25:40 +0000 Subject: [PATCH] =?UTF-8?q?Step=208:=20numeric=20tower=20=E2=80=94=20exact?= =?UTF-8?q?/inexact=20predicates=20+=20truncate/remainder/modulo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 7 new R7RS primitives on the float-based tower (Number of float unchanged): - exact? / inexact? — integer detection via Float.is_integer - exact->inexact / inexact->exact — identity / round-to-integer - truncate — toward zero (floor for positive, ceil for negative) - remainder — sign follows dividend (= Float.rem) - modulo — sign follows divisor 8 new tests (2658/2658 pass). No type system, VM, compiler, or parser changes. Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/lib/sx_primitives.ml | 29 +++++++++ spec/primitives.sx | 108 +++++++++++++++++++++---------- spec/tests/test-r7rs.sx | 65 +++++++++++++++++++ 3 files changed, 169 insertions(+), 33 deletions(-) diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 4540b60e..c6eb6eba 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -150,6 +150,35 @@ let () = let x = as_number x and lo = as_number lo and hi = as_number hi in Number (Float.max lo (Float.min hi x)) | _ -> raise (Eval_error "clamp: 3 args")); + register "truncate" (fun args -> + match args with + | [a] -> let n = as_number a in Number (if n >= 0.0 then floor n else ceil n) + | _ -> raise (Eval_error "truncate: 1 arg")); + register "remainder" (fun args -> + match args with + | [a; b] -> Number (Float.rem (as_number a) (as_number b)) + | _ -> raise (Eval_error "remainder: 2 args")); + register "modulo" (fun args -> + match args with + | [a; b] -> + let a = as_number a and b = as_number b in + let r = Float.rem a b in + Number (if r = 0.0 || (r > 0.0) = (b > 0.0) then r else r +. b) + | _ -> raise (Eval_error "modulo: 2 args")); + register "exact?" (fun args -> + match args with [Number f] -> Bool (Float.is_integer f) | [_] -> Bool false + | _ -> raise (Eval_error "exact?: 1 arg")); + register "inexact?" (fun args -> + match args with [Number f] -> Bool (not (Float.is_integer f)) | [_] -> Bool false + | _ -> raise (Eval_error "inexact?: 1 arg")); + register "exact->inexact" (fun args -> + match args with [Number n] -> Number n | [a] -> Number (as_number a) + | _ -> raise (Eval_error "exact->inexact: 1 arg")); + register "inexact->exact" (fun args -> + match args with + | [Number n] -> if Float.is_integer n then Number n else Number (Float.round n) + | [a] -> Number (Float.round (as_number a)) + | _ -> raise (Eval_error "inexact->exact: 1 arg")); register "parse-int" (fun args -> let parse_leading_int s = let len = String.length s in diff --git a/spec/primitives.sx b/spec/primitives.sx index 23bce392..9d7f3433 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -123,6 +123,51 @@ :returns "number" :doc "Round to ndigits decimal places (default 0).") +(define-primitive + "truncate" + :params (((x :as number))) + :returns "number" + :doc "Truncate toward zero.") + +(define-primitive + "remainder" + :params (((a :as number) (b :as number))) + :returns "number" + :doc "Remainder — sign follows dividend.") + +(define-primitive + "modulo" + :params (((a :as number) (b :as number))) + :returns "number" + :doc "Modulo — sign follows divisor.") + +(define-primitive + "exact?" + :params (((x :as number))) + :returns "boolean" + :doc "True if x is exact (integer-valued).") + +(define-primitive + "inexact?" + :params (((x :as number))) + :returns "boolean" + :doc "True if x is inexact (non-integer).") + +;; -------------------------------------------------------------------------- +;; Core — Comparison +;; -------------------------------------------------------------------------- +(define-primitive + "exact->inexact" + :params (((x :as number))) + :returns "number" + :doc "Convert exact to inexact (identity for float tower).") + +(define-primitive + "inexact->exact" + :params (((x :as number))) + :returns "number" + :doc "Convert inexact to nearest exact integer.") + (define-primitive "min" :params (&rest (args :as number)) @@ -156,9 +201,6 @@ :doc "Decrement by 1." :body (- n 1)) -;; -------------------------------------------------------------------------- -;; Core — Comparison -;; -------------------------------------------------------------------------- (define-module :core.comparison) (define-primitive @@ -174,6 +216,9 @@ :doc "Inequality." :body (not (= a b))) +;; -------------------------------------------------------------------------- +;; Core — Predicates +;; -------------------------------------------------------------------------- (define-primitive "eq?" :params (a b) @@ -220,9 +265,6 @@ :doc "Greater than or equal." :body (or (> a b) (= a b))) -;; -------------------------------------------------------------------------- -;; Core — Predicates -;; -------------------------------------------------------------------------- (define-module :core.predicates) (define-primitive @@ -260,6 +302,9 @@ :doc "True if x is a boolean (true or false)." :body (= (type-of x) "boolean")) +;; -------------------------------------------------------------------------- +;; Core — Logic +;; -------------------------------------------------------------------------- (define-primitive "number?" :params (x) @@ -274,6 +319,9 @@ :doc "True if x is a string." :body (= (type-of x) "string")) +;; -------------------------------------------------------------------------- +;; Core — Strings +;; -------------------------------------------------------------------------- (define-primitive "list?" :params (x) @@ -308,9 +356,6 @@ :returns "boolean" :doc "True if coll contains key. Strings: substring check. Dicts: key check. Lists: membership.") -;; -------------------------------------------------------------------------- -;; Core — Logic -;; -------------------------------------------------------------------------- (define-module :core.logic) (define-primitive @@ -320,9 +365,6 @@ :doc "Logical negation. Note: and/or are special forms, not primitives." :body (if x false true)) -;; -------------------------------------------------------------------------- -;; Core — Strings -;; -------------------------------------------------------------------------- (define-module :core.strings) (define-primitive @@ -391,6 +433,9 @@ :returns "string" :doc "Strip leading/trailing whitespace.") +;; -------------------------------------------------------------------------- +;; Core — Collections +;; -------------------------------------------------------------------------- (define-primitive "split" :params ((s :as string) &rest (sep :as string)) @@ -433,9 +478,6 @@ :returns "boolean" :doc "True if string s ends with suffix.") -;; -------------------------------------------------------------------------- -;; Core — Collections -;; -------------------------------------------------------------------------- (define-module :core.collections) (define-primitive @@ -492,6 +534,9 @@ :returns "any" :doc "Element at index n, or nil if out of bounds.") +;; -------------------------------------------------------------------------- +;; Core — Dict operations +;; -------------------------------------------------------------------------- (define-primitive "cons" :params (x (coll :as list)) @@ -534,9 +579,6 @@ :returns "list" :doc "Consecutive pairs: (1 2 3 4) → ((1 2) (2 3) (3 4)).") -;; -------------------------------------------------------------------------- -;; Core — Dict operations -;; -------------------------------------------------------------------------- (define-module :core.dict) (define-primitive @@ -545,6 +587,9 @@ :returns "list" :doc "List of dict keys.") +;; -------------------------------------------------------------------------- +;; Stdlib — Format +;; -------------------------------------------------------------------------- (define-primitive "vals" :params ((d :as dict)) @@ -575,6 +620,9 @@ :returns "dict" :doc "Return new dict with keys removed.") +;; -------------------------------------------------------------------------- +;; Stdlib — Text +;; -------------------------------------------------------------------------- (define-primitive "dict-set!" :params ((d :as dict) key val) @@ -587,9 +635,6 @@ :returns "any" :doc "Pour coll into target. List target: convert to list. Dict target: convert pairs to dict.") -;; -------------------------------------------------------------------------- -;; Stdlib — Format -;; -------------------------------------------------------------------------- (define-module :stdlib.format) (define-primitive @@ -598,6 +643,12 @@ :returns "string" :doc "Parse ISO date string and format with strftime-style format.") +;; -------------------------------------------------------------------------- +;; Stdlib — Style +;; -------------------------------------------------------------------------- +;; -------------------------------------------------------------------------- +;; Stdlib — Debug +;; -------------------------------------------------------------------------- (define-primitive "format-decimal" :params ((val :as number) &rest (places :as number)) @@ -610,15 +661,15 @@ :returns "number" :doc "Parse string to integer with optional default on failure.") +;; -------------------------------------------------------------------------- +;; Type introspection — platform primitives +;; -------------------------------------------------------------------------- (define-primitive "parse-datetime" :params ((s :as string)) :returns "string" :doc "Parse datetime string — identity passthrough (returns string or nil).") -;; -------------------------------------------------------------------------- -;; Stdlib — Text -;; -------------------------------------------------------------------------- (define-module :stdlib.text) (define-primitive @@ -639,12 +690,6 @@ :returns "string" :doc "Remove HTML tags from string.") -;; -------------------------------------------------------------------------- -;; Stdlib — Style -;; -------------------------------------------------------------------------- -;; -------------------------------------------------------------------------- -;; Stdlib — Debug -;; -------------------------------------------------------------------------- (define-module :stdlib.debug) (define-primitive @@ -653,9 +698,6 @@ :returns "boolean" :doc "Assert condition is truthy; raise error with message if not.") -;; -------------------------------------------------------------------------- -;; Type introspection — platform primitives -;; -------------------------------------------------------------------------- (define-module :stdlib.types) (define-primitive diff --git a/spec/tests/test-r7rs.sx b/spec/tests/test-r7rs.sx index 34636c42..e55ddec5 100644 --- a/spec/tests/test-r7rs.sx +++ b/spec/tests/test-r7rs.sx @@ -369,3 +369,68 @@ (assert= 1 (my-or 1 2 3)) (assert= 3 (my-or false false 3)) (assert= false (my-or false false false))))) + +(defsuite + "numeric-tower" + (deftest + "exact? recognizes integers" + (do + (assert (exact? 42)) + (assert (exact? 0)) + (assert (exact? -7)) + (assert (not (exact? 3.14))) + (assert (not (exact? 0.5))))) + (deftest + "inexact? recognizes non-integers" + (do + (assert (inexact? 3.14)) + (assert (inexact? 0.5)) + (assert (not (inexact? 42))) + (assert (not (inexact? 0))))) + (deftest + "exact->inexact identity for floats" + (do + (assert (number? (exact->inexact 42))) + (assert= 42 (exact->inexact 42)) + (assert= 3.14 (exact->inexact 3.14)))) + (deftest + "inexact->exact rounds to integer" + (do + (assert (integer? (inexact->exact 3.7))) + (assert= 4 (inexact->exact 3.7)) + (assert= 3 (inexact->exact 3)) + (assert= -4 (inexact->exact -3.7)))) + (deftest + "truncate toward zero" + (do + (assert= 3 (truncate 3.7)) + (assert= -3 (truncate -3.7)) + (assert= 3 (truncate 3.2)) + (assert= -3 (truncate -3.2)) + (assert= 5 (truncate 5)))) + (deftest + "remainder sign follows dividend" + (do + (assert= 1 (remainder 7 3)) + (assert= -1 (remainder -7 3)) + (assert= 1 (remainder 7 -3)) + (assert= -1 (remainder -7 -3)))) + (deftest + "modulo sign follows divisor" + (do + (assert= 1 (modulo 7 3)) + (assert= 2 (modulo -7 3)) + (assert= -2 (modulo 7 -3)) + (assert= -1 (modulo -7 -3)))) + (deftest + "integer preservation through arithmetic" + (do + (assert (integer? (+ 3 4))) + (assert (integer? (* 3 4))) + (assert (integer? (- 10 3))) + (assert (not (integer? (/ 7 2)))) + (assert (integer? (/ 6 3))) + (assert (integer? (floor 3.7))) + (assert (integer? (ceil 3.2))) + (assert (integer? (round 3.5))) + (assert (integer? (truncate 3.7))))))