From 64daec5065a66a08e38744a5d32a97e009be3270 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Sun, 24 Apr 2022 14:34:57 +0200
Subject: [PATCH] Add and use assert-type in utils.

---
 scribblings/utils.scrbl | 22 ++++++++++++++++++++++
 utils.rkt               | 11 +++++++----
 2 files changed, 29 insertions(+), 4 deletions(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index b1c279b..cc63de3 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -35,6 +35,28 @@ the variables.
 
 }
 
+@section{Type utilities}
+
+Typed Racket's @racket[cast] should only be used as a last resort, because it
+installs two contracts which may have a significant performance penalty.
+See
+@hyperlink["https://racket.discourse.group/t/managing-cast-performance-penalty/905"]{this
+discussion} for more details.  The best approach is to use
+@hyperlink["https://docs.racket-lang.org/ts-guide/occurrence-typing.html"]{occurrence
+typing} either via a direct @racket[if] check using a predicate, or using
+@racket[assert].
+
+@defform[(assert-type expr type)]{
+
+@racket[assert] that the type of @racket[expr] is @racket[type].
+
+@examples[#:eval utils-evaluator
+(define some-number : Any 1)
+(assert-type some-number Integer)
+(assert-type some-number Positive-Integer)
+(eval:error (assert-type some-number Zero1))
+]}
+
 @section{Hashtable injection}
 
 This section defines some utilities to streamline the usage of hash tables
diff --git a/utils.rkt b/utils.rkt
index 1b9b9bf..efd1d99 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -6,6 +6,7 @@
 (provide
  Variable VariableMapping GeneralPair
 
+ assert-type
  eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
  extract-symbols any->string stringify-variable-mapping string->any
  handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
@@ -25,6 +26,9 @@
 (define-type Variable Symbol)
 (define-type (VariableMapping A) (Immutable-HashTable Variable A))
 
+(define-syntax-parse-rule (assert-type e:expr type:expr)
+  (assert e (make-predicate type)))
+
 (: eval-with (-> (VariableMapping Any) Any AnyValues))
 (define (eval-with ht expr)
   (parameterize ([current-namespace (make-base-namespace)])
@@ -107,7 +111,7 @@
                           ([x form])
                   (extract-symbols x)))]
       [else '()]))
-  (assert (extract-rec form) (make-predicate (Listof Symbol))))
+  (assert-type (extract-rec form) (Listof Symbol)))
 
 (module+ test
   (test-case "extract-symbols"
@@ -223,7 +227,7 @@
    (λ ([pairs : (Listof (Pair Symbol Any))])
      (make-immutable-hash pairs))
    (λ (sexp)
-     (assert sexp (make-predicate (Listof (GeneralPair String Any))))
+     (assert-type sexp (Listof (GeneralPair String Any)))
      (unstringify-pairs sexp))
    string->any))
 
@@ -244,8 +248,7 @@
 
 (: read-symbol-list (-> String (Listof Symbol)))
 (define (read-symbol-list str)
-  (assert (string->any (string-append "(" str ")"))
-          (make-predicate (Listof Symbol))))
+  (assert-type (string->any (string-append "(" str ")")) (Listof Symbol)))
 
 (module+ test
   (test-case "read-symbol-list"