separated contract form from default form.

2026-05-11 01:11:55 +02:00
parent 9aebc6863d
commit 3a92a6552d
4 changed files with 173 additions and 4 deletions
@@ -0,0 +1,52 @@
+#lang racket/base
+
+(require "main.rkt")
+
+(provide define/contract/return
+         (all-from-out racket/contract)
+         (all-from-out "main.rkt")
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; define/return/contract
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-syntax def-returner
+  (syntax-rules ()
+    ((_ pred name)
+     (define/contract (name x)
+       (-> any/c pred)
+       (return-value x))
+     )
+    )
+  )
+
+(define-syntax call-returner
+  (syntax-rules ()
+    ((_ x name)
+     (name x))))
+
+(define-syntax define/contract/return
+  (syntax-rules ()
+    ((_ (name . formals) (c ... last-pred) b1 ...)
+     (define/contract (name . formals)
+       (c ... last-pred)
+       
+       (let ((ret (λ (x)
+                    (def-returner last-pred name)
+                    (call-returner x name))))
+         (with-handlers ([exn:return? ret])
+           b1
+           ...)))
+     )
+    ((_ name last-pred value)
+     (define/contract name
+       last-pred
+       (let ((ret (λ (x)
+                    (def-returner last-pred name)
+                    (call-returner x name))))
+         (with-handlers ([exn:return? ret])
+           value)))
+     )
+    )
+  )