Skip to content

Instantly share code, notes, and snippets.

@samdphillips
Created April 12, 2022 01:07
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save samdphillips/b275477883d1ae1fa08c8cf031756460 to your computer and use it in GitHub Desktop.
Save samdphillips/b275477883d1ae1fa08c8cf031756460 to your computer and use it in GitHub Desktop.
not even close to being a full handling for checked exceptions
#lang racket/base
(require (for-syntax racket/base
racket/format
syntax/parse/lib/function-header)
(rename-in racket/base [raise base:raise])
racket/stxparam
syntax/parse/define)
(begin-for-syntax
(define (allowed-exception? stx)
(member stx
(syntax-parameter-value #'current-allowed-exceptions)
free-identifier=?))
(define (add-exceptions id-list)
(append id-list (syntax-parameter-value #'current-allowed-exceptions))))
(define-syntax-parameter current-allowed-exceptions null)
(define-syntax-parse-rule (raise (make-exn v ...))
#:fail-unless
(allowed-exception? #'make-exn)
(~a "not allowed exception: " #'make-exn)
(base:raise (make-exn v ...)))
(define-syntax-parse-rule (def/exc fheader:function-header
{~datum ::} (exn-name ...)
body ...+)
(define fheader
(syntax-parameterize ([current-allowed-exceptions
(add-exceptions (list #'exn-name ...))])
body ...)))
(def/exc (f) :: (exn:fail)
(raise (exn:fail "oops" (current-continuation-marks))))
(def/exc (g) :: (exn:fail)
(raise (exn:fail:filesystem "oops" (current-continuation-marks))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment