From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Zelphir Kaltstahl Newsgroups: gmane.lisp.guile.user Subject: Contracts macro example Date: Thu, 14 Jul 2022 23:55:26 +0000 Message-ID: Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="6560"; mail-complaints-to="usenet@ciao.gmane.io" To: Guile User Original-X-From: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Fri Jul 15 01:55:54 2022 Return-path: Envelope-to: guile-user@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1oC8gU-0001Tx-TU for guile-user@m.gmane-mx.org; Fri, 15 Jul 2022 01:55:54 +0200 Original-Received: from localhost ([::1]:35774 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oC8gT-0000VD-95 for guile-user@m.gmane-mx.org; Thu, 14 Jul 2022 19:55:53 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:45166) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oC8gA-0000Uo-BL for guile-user@gnu.org; Thu, 14 Jul 2022 19:55:34 -0400 Original-Received: from mout02.posteo.de ([185.67.36.66]:47357) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oC8g8-0000Io-1i for guile-user@gnu.org; Thu, 14 Jul 2022 19:55:34 -0400 Original-Received: from submission (posteo.de [185.67.36.169]) by mout02.posteo.de (Postfix) with ESMTPS id 87AFD240107 for ; Fri, 15 Jul 2022 01:55:28 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.de; s=2017; t=1657842928; bh=dambdCTEnWwzQw/Y9G1tfg8AIZUHMTYNHn08AQ4fGc4=; h=Date:To:From:Subject:From; b=ku3mAzH6kGjEopXznd87S3fAVyYXRywzV+35iqXlg0GaAFMdpuqgmyBu1DX21UpyZ c+udiReF0WsQxfTvj71lSeUlH67fLBOogKiPtjbJ3NkgQ76cwE5gHyYbcHwjpHnDzu v9HMcpskXPLqcCdT8e52V7nA8diYz4XLjyuN+DWIhiHR+ReHXp/I4/A7FEDY2nHULs U0DGiHCNmvGixgqjXF2BudARC6nqIxHVABivGeKJEOy1tgFQiY8J9/LmQQNkhL+k+s bzH3CDlFlCUAjMP2mPNOEuI9qtPZmruCSW77aDVO7pVU9rcEN7rwgvsIBWMnos7f+b SE7EkHW6mKStg== Original-Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4LkWZl75bXz9rxQ for ; Fri, 15 Jul 2022 01:55:26 +0200 (CEST) Content-Language: en-US Received-SPF: pass client-ip=185.67.36.66; envelope-from=zelphirkaltstahl@posteo.de; helo=mout02.posteo.de X-Spam_score_int: -43 X-Spam_score: -4.4 X-Spam_bar: ---- X-Spam_report: (-4.4 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_MED=-2.3, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Original-Sender: "guile-user" Xref: news.gmane.io gmane.lisp.guile.user:18419 Archived-At: 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