Initial import

main.rkt

@@ -0,0 +1,87 @@
+#lang racket/base
+
+(provide let/assert
+         make-assert
+         a-eq? a-!eq?
+         a->? a-<=?
+         a->=? a-<?
+         a-=? a-!=?
+         a-<0? a->=0?
+         a-<=0? a->0?
+         a-=0? a-!=0?
+         a-true? a-false?
+         a-nullptr? a-!nullptr?
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; let/assert
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define-syntax make-assert
+  (syntax-rules ()
+    ((_ name not-name pred)
+     (begin
+       (define-syntax name
+         (syntax-rules ()
+           ((_ const)
+            (λ (x) (pred x const)))))
+       (define-syntax not-name
+         (syntax-rules ()
+           ((_ const)
+            (λ (x) (not (pred x const))))))
+       )
+     )
+    )
+  )
+
+(make-assert a-eq? a-!eq? eq?)
+
+(define a-nullptr? (a-eq? #f))
+(define a-!nullptr? (a-!eq? #f))
+
+(make-assert a->? a-<=? >)
+(make-assert a->=? a-<? >=)
+(make-assert a-=? a-!=? =)
+
+(define (a-=0? x) (= x 0))
+(define (a-!=0? x) (not (= x 0)))
+(define (a->0? x) (> x 0))
+(define (a->=0? x) (>= x 0))
+(define (a-<0? x) (< x 0))
+(define (a-<=0? x) (<= x 0))
+
+
+(define a-true? (a-eq? #t))
+(define a-false? (a-eq? #f))
+
+(struct exn:let/assert exn (value) #:transparent)
+
+(define (raise-let/assert v)
+  (raise (exn:let/assert "let/assert" (current-continuation-marks) v)))
+
+(define (let/assert-value r)
+  (exn:let/assert-value r))
+
+(define-syntax assert-expr
+  (syntax-rules ()
+    ((_ expr cond retval)
+     (let ((a expr)) (if (cond a) a (raise-let/assert retval))))
+    ((_ expr)
+     expr)
+    )
+  )
+
+(define-syntax let/assert
+  (syntax-rules ()
+    ((_ ((v rest ...) ...) b1 ...)
+     (with-handlers ([exn:let/assert? let/assert-value])
+       (let* ((v (assert-expr rest ...))
+              ...)
+         b1
+         ...
+         )
+       )
+     )
+    )
+  )