peval avoids introducing 'throw

* module/language/tree-il/peval.scm (peval): Introduce raise-type-error
for dynwind unwinder thunk check.
* module/language/tree-il/compile-cps.scm (raise-type-error):
* module/language/tree-il/compile-bytecode.scm (canonicalize): Handle
raise-type-error, as it can be in Tree-IL now.

module/language/tree-il/compile-bytecode.scm

@@ -446,6 +446,13 @@
         (make-primcall src 'throw
                        (list key (make-primcall #f 'list args))))
 
+       (($ <primcall> src 'raise-type-error (($ <const> _ #(subr pos what)) x))
+        (define msg
+          (format #f "Wrong type argument in position ~a (expecting ~a): ~~S"
+                  pos what))
+        (make-primcall src 'throw/value+data
+                       (list x (make-const #f `#(wrong-type-arg ,subr ,msg)))))
+
        ;; Now that we handled special cases, ensure remaining primcalls
        ;; are understood by the code generator, and if not, reify them
        ;; as calls.

module/language/tree-il/compile-cps.scm

@@ -1513,6 +1513,23 @@ use as the proc slot."
            (build-term
              ($throw src 'raise-exception #f (exn)))))))))
 
+(define-custom-primcall-converter (raise-type-error cps src args convert-args k)
+  (match args
+    ((($ <const> _ #((? string? proc-name)
+                     (? exact-integer? pos)
+                     (? string? what)))
+      val)
+     ;; When called with just one arg, we know that raise-exception is
+     ;; non-continuing, and so we can prune the graph at its continuation.
+     ;; This improves flow analysis, because the path that leads to the
+     ;; raise-exception doesn't rejoin the graph.
+     (convert-args cps (list val)
+       (lambda (cps vals)
+         (with-cps cps
+           (build-term
+             ($throw src 'raise-type-error (vector proc-name pos what)
+                     vals))))))))
+
 (define-custom-primcall-converter (values cps src args convert-args k)
   (convert-args cps args
     (lambda (cps args)

module/language/tree-il/peval.scm

@@ -1270,14 +1270,9 @@ top-level bindings from ENV and return the resulting expression."
                ;; fixme: introduce logic to fold thunk?
                (make-primcall src 'thunk? (list u))
                (make-call src w '())
-               (make-primcall
+               (make-primcall src 'raise-type-error
-                src 'throw
+                              (list (make-const #f #("dynamic-wind" 3 "thunk"))
-                (list
+                                    u)))
-                 (make-const #f 'wrong-type-arg)
-                 (make-const #f "dynamic-wind")
-                 (make-const #f "Wrong type (expecting thunk): ~S")
-                 (make-primcall #f 'list (list u))
-                 (make-primcall #f 'list (list u)))))
               (make-primcall src 'wind (list w u)))
              (make-begin0 src
                           (make-call src thunk '())