coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add strict typing mode + 139 new tests: 749/749 passing

Browse Source 
Strict mode (spec/eval.sx):
- *strict* flag, set-strict!, set-prim-param-types!
- value-matches-type? checks values against declared types
- strict-check-args validates primitive call args at runtime
- Injected into eval-call before apply — zero cost when off
- Supports positional params, rest-type, nullable ("string?")

New test files:
- test-strict.sx (25): value-matches-type?, toggle, 12 type error cases
- test-errors.sx (74): undefined symbols, arity, permissive coercion,
  strict type mismatches, nil/empty edge cases, number edge cases,
  string edge cases, recursion patterns
- test-advanced.sx (39): nested special forms, higher-order patterns,
  define patterns, quasiquote advanced, thread-first, letrec, case/cond

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-15 12:12:48 +00:00
parent c67adaceaf
commit 8f146cc810
5 changed files with 1027 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

89
spec/eval.sx
View File

@@ -68,6 +68,89 @@
result)))))
;; --------------------------------------------------------------------------
;; 2b. Strict mode — runtime type checking for primitive calls
;; --------------------------------------------------------------------------
;;
;; When *strict* is true, primitive calls check arg types before dispatch.
;; The primitive param type registry maps name → {positional [[name type]...],
;; rest-type type-or-nil}. Stored in *prim-param-types* in the env.
;;
;; Strict mode is off by default. Hosts can enable it at startup via:
;; (set-strict! true)
;; (set-prim-param-types! types-dict)
(define *strict* false)
(define set-strict!
(fn (val)
(set! *strict* val)))
(define *prim-param-types* nil)
(define set-prim-param-types!
(fn (types)
(set! *prim-param-types* types)))
(define value-matches-type?
(fn (val expected-type)
;; Check if a runtime value matches a declared type string.
(cond
(= expected-type "any") true
(= expected-type "number") (number? val)
(= expected-type "string") (string? val)
(= expected-type "boolean") (boolean? val)
(= expected-type "nil") (nil? val)
(= expected-type "list") (list? val)
(= expected-type "dict") (dict? val)
(= expected-type "lambda") (lambda? val)
(= expected-type "symbol") (= (type-of val) "symbol")
(= expected-type "keyword") (= (type-of val) "keyword")
;; Nullable: "string?" means string or nil
(and (string? expected-type)
(ends-with? expected-type "?"))
(or (nil? val)
(value-matches-type? val (slice expected-type 0 (- (string-length expected-type) 1))))
:else true)))
(define strict-check-args
(fn (name args)
;; Check args against *prim-param-types* if strict mode is on.
;; Throws on type violation. No-op if *strict* is false or types not registered.
(when (and *strict* *prim-param-types*)
(let ((spec (get *prim-param-types* name)))
(when spec
(let ((positional (get spec "positional"))
(rest-type (get spec "rest-type")))
;; Check positional params
(when positional
(for-each
(fn (pair)
(let ((idx (first pair))
(param (nth pair 1))
(p-name (first param))
(p-type (nth param 1)))
(when (< idx (len args))
(let ((val (nth args idx)))
(when (not (value-matches-type? val p-type))
(error (str "Type error: " name " expected " p-type
" for param " p-name
", got " (type-of val) " (" (str val) ")")))))))
(map-indexed (fn (i p) (list i p)) positional)))
;; Check rest args
(when (and rest-type (> (len args) (len (or positional (list)))))
(for-each
(fn (pair)
(let ((idx (first pair))
(val (nth pair 1)))
(when (not (value-matches-type? val rest-type))
(error (str "Type error: " name " expected " rest-type
" for rest arg " idx
", got " (type-of val) " (" (str val) ")")))))
(map-indexed (fn (i v) (list i v))
(slice args (len (or positional (list)))))))))))))
;; --------------------------------------------------------------------------
;; 3. Core evaluator
;; --------------------------------------------------------------------------
@@ -201,7 +284,11 @@
(cond
;; Native callable (primitive function)
(and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f)))
(apply f evaluated-args)
(do
;; Strict mode: check arg types before dispatch
(when (and *strict* (= (type-of head) "symbol"))
(strict-check-args (symbol-name head) evaluated-args))
(apply f evaluated-args))
;; Lambda
(lambda? f)