unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
* Contracts macro example
@ 2022-07-14 23:55 Zelphir Kaltstahl
  2022-07-19 15:20 ` Maxime Devos
  0 siblings, 1 reply; 6+ messages in thread
From: Zelphir Kaltstahl @ 2022-07-14 23:55 UTC (permalink / raw)
  To: Guile User

Hello Guile users!

I've tried myself again at writing some macros. Some post about programming 
language features inspired me to try and write a macro, which adds contracts (or 
my naive idea of what they are) to function definitions.

The code is at: 
https://notabug.org/ZelphirKaltstahl/guile-examples/src/d749de48307cebe279215ab5df50853c9d100b2f/macros/contract.scm.

Or here, so that this e-mail can stand on its own:

~~~~
;; Suppose we wanted to check assumptions about arguments to
;; our function. What kind of form could we write to express
;; this?

;; (define-with-contract account-withdraw
;;   (requires (< amount account-balance))
;;   (ensures (>= account-balance 0))
;;   (lambda (amount account-balance)
;;     ...))

;; Or abstractly:

;; (define-with-contract func
;;   (requires req-pred* ...)
;;   (ensures ensure-pred* ...)
;;   lambda-expr)


(import
  (except (rnrs base) let-values)
  (only (guile)
        lambda* λ)
  (ice-9 exceptions)
  (srfi srfi-1))


;; and-raise needs to be a macro, because its arguments must
;; not be immediately evaluated, otherwise we cannot raise
;; an exception containing the failing check.
(define-syntax and-raise
   (syntax-rules ()
     [(_ (op args* ...) check-expr* ...)
      (cond
       [(not (op args* ...))
        (raise-exception
         (make-exception
          (make-assertion-failure)
          (make-exception-with-message "assertion failed")
          (make-exception-with-irritants (quote (op args* ...)))))]
       [else
        (and-raise check-expr* ...)])]
     [(_ #|nothing|#)
       #t]))


;; `ensure` builds up an `and` expression, which contains
;; all the conditions.
(define-syntax ensure-with-result
   (syntax-rules (ensure)
     [(_ identifier expr* ... (op args* ...))
      (and-raise
       ;; insert identifier on the left
       (op identifier args* ...)
       (ensure-with-result identifier expr* ...))]
     ;; If there is only one more ensure clause, transform
     ;; it, and do not place another macro call.
     [(_ identifier (op args* ...))
      ;; insert identifier on the left
      (op identifier args* ...)]
     ;; If there are no more ensure clauses, transform to
     ;; `#t`, the neutral element of `and`.
     [(_ identifier)
      #t]))


(define-syntax define-with-contract
   (syntax-rules (require ensure <?>)
     ;; first process ensure (post-conditions)
     [(_ function-name
         (require reqs* ...)
         (ensure ensu-expr* ...)
         (lambda (args* ...)
           lambda-body-expr* ...))
      (define function-name
        (lambda (args* ...)
          ;; temporarily store result of the function
          (let ([result
                 (cond
                  ;; check pre-conditions (requirements)
                  [(not (and-raise reqs* ...))
                   (raise-exception
                    (make-exception
                     (make-assertion-failure)
                     (make-exception-with-message "assertion failed")
                     (make-exception-with-irritants (list args* ...))
                     (make-exception-with-origin (syntax->datum function-name))))]
                  ;; otherwise run the body
                  [else
                   lambda-body-expr* ...])])
            (cond
             ;; check post-conditions (ensures)
             [(not (ensure-with-result result ensu-expr* ...))
              ;; Problem: Cannot know which post-condition
              ;; failed. Could be improved.
              (raise-exception
               (make-exception
                (make-assertion-failure)
                (make-exception-with-message "assertion failed")
                (make-exception-with-irritants (list args* ...))
                (make-exception-with-origin (syntax->datum function-name))))]
             ;; return result if post conditions are true
             [else result]))))]))


;; Lets make an example definition: Withdrawing an amount of
;; money from an account, returning the new account balance
;; (although not really mutating the account or anything,
;; really just a toy example).
(define-with-contract account-withdraw
   (require (< amount account-balance)
            (>= amount 0))
   (ensure (>= 0))  ; depends on what the function returns
   (lambda (amount account-balance)
     (- account-balance amount)))


;; Using the defined function just like any other function.
(display (account-withdraw 10 20)) (newline)
(display (account-withdraw 30 20)) (newline)
~~~~

Are there any, for the more experienced eye, obvious mistakes or bad practices 
in there, that should be improved? (especially regarding macros).

Best regards,
Zelphir

-- 
repositories: https://notabug.org/ZelphirKaltstahl




^ permalink raw reply	[flat|nested] 6+ messages in thread
end of thread, other threads:[~2022-08-04 16:19 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-14 23:55 Contracts macro example Zelphir Kaltstahl
2022-07-19 15:20 ` Maxime Devos
2022-07-20  8:39   ` Zelphir Kaltstahl
2022-07-20  8:55     ` Maxime Devos
2022-07-24  1:21       ` Zelphir Kaltstahl
2022-08-04 16:19         ` Maxime Devos

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).