Extend def parameter contracts

ober

f9d8eb085813053d99bbf76f78ea77602c0f3ff6

diff --git a/docs/typing.md b/docs/typing.md
index f453eb8..0a796a6 100644
--- a/docs/typing.md
+++ b/docs/typing.md
@@ -178,6 +178,19 @@ Examples:
   p.x)
 ```
 
+Jerboa's normal `def` also accepts these markers on parameters:
+
+```scheme
+(def (maybe-length (s :? string)) : fixnum
+  (if s (string-length s) 0))
+
+(def (checked-index (n :~ (in-range? 0 len)))
+  (vector-ref values n))
+
+(def (trusted-hot-path (n :- fixnum))
+  n)
+```
+
 `:` and `:?` use the `(std typed)` type registry and follow
 `*typed-mode*`. `:~` is a contract check and runs immediately. `:-` is an
 unchecked assertion: use it only after a checked boundary has established the
diff --git a/lib/jerboa/core.sls b/lib/jerboa/core.sls
index c7020ca..9904332 100644
--- a/lib/jerboa/core.sls
+++ b/lib/jerboa/core.sls
@@ -292,15 +292,18 @@
 
   ;;;; ---- DEF ----
 
-  ;; Check if a datum looks like a typed param: (name : type)
+  ;; Check if a datum looks like a contract/typed param:
+  ;;   (name : type)     checked type
+  ;;   (name :? type)    checked nullable type
+  ;;   (name :- type)    unchecked assertion
+  ;;   (name :~ pred)    checked predicate contract
   (meta define (typed-param? p)
     (and (pair? p)
          (pair? (cdr p))
          (pair? (cddr p))
          (null? (cdddr p))
          (symbol? (car p))
-         (eq? (cadr p) ':)
-         (symbol? (caddr p))))
+         (memq (cadr p) '(: :? :- :~))))
 
   ;; Check if any param in the list is typed
   (meta define (has-typed-params? params)
@@ -316,16 +319,34 @@
            (if (typed-param? p) (car p) p))
          params))
 
-  ;; Extract typed params as list of (name type) pairs
+  ;; Extract typed params as list of (name op spec) triples.
   (meta define (extract-typed-params params)
     (let loop ([rest params] [acc '()])
       (cond
         [(null? rest) (reverse acc)]
         [(typed-param? (car rest))
          (loop (cdr rest)
-               (cons (list (caar rest) (caddar rest)) acc))]
+               (cons (list (caar rest) (cadar rest) (caddar rest)) acc))]
         [else (loop (cdr rest) acc)])))
 
+  (meta define (contract-check-form who ta)
+    (let ([aname (car ta)]
+          [op (cadr ta)]
+          [spec (caddr ta)])
+      (case op
+        [(:)
+         `(check-type! ',who ',aname ,aname ',spec)]
+        [(:?)
+         `(when ,aname
+            (check-type! ',who ',aname ,aname ',spec))]
+        [(:-)
+         '(void)]
+        [(:~)
+         `(unless (,spec ,aname)
+            (error ',who "argument failed predicate contract" ',aname ,aname))]
+        [else
+         '(void)])))
+
   (define-syntax def
     (lambda (stx)
       (syntax-case stx ()
@@ -338,10 +359,8 @@
          (let* ([params-list (syntax->datum #'params)]
                 [arg-names (extract-arg-names params-list)]
                 [typed (extract-typed-params params-list)]
-                ;; Build individual check-type! calls
                 [checks (map (lambda (ta)
-                               (let ([aname (car ta)] [atype (cadr ta)])
-                                 `(check-type! ',#'name ',aname ,aname ',atype)))
+                               (contract-check-form (syntax->datum #'name) ta))
                              typed)])
            (with-syntax ([(arg ...) (datum->syntax #'name arg-names)]
                          [(chk ...) (datum->syntax #'name checks)])
@@ -360,8 +379,7 @@
                 [arg-names (extract-arg-names params-list)]
                 [typed (extract-typed-params params-list)]
                 [checks (map (lambda (ta)
-                               (let ([aname (car ta)] [atype (cadr ta)])
-                                 `(check-type! ',#'name ',aname ,aname ',atype)))
+                               (contract-check-form (syntax->datum #'name) ta))
                              typed)])
            (with-syntax ([(arg ...) (datum->syntax #'name arg-names)]
                          [(chk ...) (datum->syntax #'name checks)])
diff --git a/tests/test-ergo.ss b/tests/test-ergo.ss
index e44e05e..f387f74 100644
--- a/tests/test-ergo.ss
+++ b/tests/test-ergo.ss
@@ -228,6 +228,30 @@
   (test-error "def typed: mixed type error"
     (mixed "bad" "two")))
 
+;; Nullable parameter contract
+(def (maybe-string-length (s :? string)) : fixnum
+  (if s (string-length s) 0))
+
+(parameterize ([*typed-mode* 'debug])
+  (test "def :? accepts #f" (maybe-string-length #f) 0)
+  (test "def :? accepts typed value" (maybe-string-length "abc") 3)
+  (test-error "def :? rejects wrong non-false value"
+    (maybe-string-length 42)))
+
+;; Unchecked parameter assertion
+(def (unchecked-fx (x :- fixnum))
+  x)
+
+(parameterize ([*typed-mode* 'debug])
+  (test "def :- skips type check" (unchecked-fx "not-a-fixnum") "not-a-fixnum"))
+
+;; Predicate parameter contract
+(def (bounded-index (n :~ (in-range? 0 10)))
+  n)
+
+(test "def :~ accepts predicate value" (bounded-index 9) 9)
+(test-error "def :~ rejects predicate value" (bounded-index 10))
+
 ;;; ========== def backward compat ==========
 
 (printf "~%-- def backward compat --~%")