guile-recovery-block

Using recovery blocks with Guile

by uriel.

A recovery block is a flow control form that evaluates a sequence of chunks of code stopping at the first one that causes a condition to be satisfied. Each alternative is evaluated with the same starting state. If none of the alternatives satisfies the condition: a form is evaluated to raise an error or return a default value.

Recovery blocks are described in: ''Recovery blocks in action: a system supporting high reliability'', Anderson and Kerr, Computing Laboratory, University of Newcastle upon Tyne, U.K.

This page presents a Guile module implementing a version of recovery blocks in which the initial state is a set of local bindings.

Using recovery blocks

The format of a recovery block is:

 (recovery-block BINDINGS 
   (ensure CONDITION 
       (by ALTERNATE-FORMS-1) 
     (else-by ALTERNATE-FORMS-2) 
     (else-by ALTERNATE-FORMS-3) 
     (else ELSE-FORMS))) 

notes:

• the bindings are evaluated only once and their values handed to the alternate forms;
• there can be any number of else-by forms;
• the presence of an else form is mandatory and its role should be to raise an error;

the execution flow is:

1. compute the bindings;
2. evaluate ALTERNATE-FORMS-1, the if CONDITION evaluates to true return the return value of ALTERNATE-FORMS-1;
3. evaluate ALTERNATE-FORMS-2, the if CONDITION evaluates to true return the return value of ALTERNATE-FORMS-2;
4. evaluate ALTERNATE-FORMS-3, the if CONDITION evaluates to true return the return value of ALTERNATE-FORMS-3;
5. evaluate ELSE-FORMS and return its return value.

Let's say that the BINDINGS are ((a 1) (b 2)), the alternate forms are transformed into:

 ((lambda (a b) 
    (values (begin ALTERNATE-FORMS) CONDITION)) a b) 

so the forms are allowed to mutate the local variables, but not the values themselves.

The module

 (define-module (recovery-block) 
   #:use-module (srfi srfi-11) 
   #:export (recovery-block) 
   #:re-export (let-values)) 
  
 ;; ------------------------------------------------------------ 
  
 ;; The minimum is: 
 ;; 
 ;; (ensure CONDITION 
 ;;     (by FORMS) 
 ;;   (else FORMS))) 
 (define (assert-ensure-form-length ensure-form) 
   (if (> 4 (length ensure-form)) 
       (scm-error 'wrong-type-arg 'recovery-block 
                  "expected at least 3 element in 'ensure' form, got ~A" 
                  (list (length ensure-form)) #f))) 
  
 (define (assert-first-atom-is-ensure ensure-form) 
   (if (not (eq? 'ensure (car ensure-form))) 
       (scm-error 'wrong-type-arg 'recovery-block 
                  "expected 'ensure' symbol, got ~A" 
                  (list (car ensure-form)) #f))) 
  
 (define (assert-second-atom-is-condition ensure-form) 
   (if (not (list? (cadr ensure-form))) 
       (scm-error 'wrong-type-arg 'recovery-block 
                  "expected condition as second atom of ensure form, got ~A" 
                  (list (cadr ensure-form)) #f))) 
  
 (define (assert-elements-are-alternates alternates) 
   (for-each (lambda (elm) 
               (if (> 2 (length elm)) 
                   (scm-error 'wrong-type-arg 'recovery-block 
                              "expected list of at least 2 elements, got ~A" 
                              (list elm) #f)) 
               (case (car elm) 
                 ((by else-by else) #t) 
                 (else 
                  (scm-error 'wrong-type-arg 'recovery-block 
     "expected 'else-by' or 'else' as first atom of each alternate, got ~A" 
                             (list (car elm)) #f)))) 
             alternates) 
   (if (not (eq? 'by (caar alternates))) 
       (scm-error 'wrong-type-arg 'recovery-block 
                  "expected 'by' as first atom of first alternate, got ~A" 
                  (list (caar alternates)) #f)) 
  
   (if (not (eq? 'else (caar (reverse alternates)))) 
       (scm-error 'wrong-type-arg 'recovery-block 
                  "expected 'else' as first atom of last alternate, got ~A" 
                  (list (caar (reverse alternates))) #f))) 
  
 ;; ------------------------------------------------------------ 
  
 ;; (recovery-block ((a 1) 
 ;;                  (b 2)) 
 ;;   (ensure CONDITION 
 ;;       (by FORMS) 
 ;;     (else-by FORMS) 
 ;;     (else-by FORMS) 
 ;;     (else FORMS))) 
  
 (define-macro (recovery-block BINDINGS ensure-form) 
  
   (define (make-node VARS FORMS CONDITION TAIL) 
     `(let-values (((form-result condition-result) 
                    ((lambda ,VARS 
                       (values (begin ,@FORMS) ,CONDITION)) ,@VARS))) 
        (if condition-result form-result ,TAIL))) 
  
   (assert-ensure-form-length ensure-form) 
   (assert-first-atom-is-ensure ensure-form)   
   (assert-second-atom-is-condition ensure-form)   
   (assert-elements-are-alternates (cddr ensure-form)) 
    
   (let* ((CONDITION     (cadr ensure-form)) 
          (VARS          (map car BINDINGS)) 
          (OUT           (fold (lambda (forms tail) 
                                 (make-node VARS forms CONDITION tail)) 
                               (append '(begin) (cdar (reverse ensure-form))) 
                               (cdr (reverse (cddr ensure-form)))))) 
     `(let ,BINDINGS ,OUT))) 

The test code

 (use-modules (recovery-block)) 
  
 ;; ------------------------------------------------------------ 
  
 (define (gee-print-catched-error key . args) 
   (if (null? args) 
       (format (current-error-port) "error key: ~A~%" key) 
       (format (current-error-port) "~A: ~A~%" (car args) 
               (let ((message            (cadr args)) 
                     (format-list        (caddr args))) 
                 (if format-list 
                     (apply format #f message format-list) 
                     message))))) 
  
 (define-macro (test DESCR FORM) 
   `(begin 
      (format #t "~%* ~A:~%~%" ,DESCR) 
      (catch #t 
        (lambda () 
          (let ((result ,FORM)) 
            (format #t "*** result: ~A~%" result))) 
        gee-print-catched-error))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "Condition satisfied by 'by' form" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (ensure (= r 1) 
           (by 
            (format #t "by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 1) 
            r) 
           (else-by 
            (format #t "first else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 2) 
            r) 
           (else-by 
            (format #t "second else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 3) 
            r) 
           (else 
            (format #t "else alternate: a=~A, b=~A, r=~A~%" a b r) 
            0)))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "Condition satisfied by first 'else-by' form" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (ensure (= r 2) 
           (by 
            (format #t "by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 1) 
            r) 
           (else-by 
            (format #t "first else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 2) 
            r) 
           (else-by 
            (format #t "second else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 3) 
            r) 
           (else 
            (format #t "else alternate: a=~A, b=~A, r=~A~%" a b r) 
            0)))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "Condition satisfied by second 'else-by' form" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (ensure (= r 3) 
           (by 
            (format #t "by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 1) 
            r) 
           (else-by 
            (format #t "first else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 2) 
            r) 
           (else-by 
            (format #t "second else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 3) 
            r) 
           (else 
            (format #t "else alternate: a=~A, b=~A, r=~A~%" a b r) 
            0)))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "Go down to 'else' form" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (ensure (= r 5) 
           (by 
            (format #t "by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 1) 
            r) 
           (else-by 
            (format #t "first else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 2) 
            r) 
           (else-by 
            (format #t "second else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 3) 
            r) 
           (else 
            (format #t "else alternate: a=~A, b=~A, r=~A~%" a b r) 
            0)))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "No 'else-by' alternates, condition satisfied by 'by' form" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (ensure (= r 1) 
           (by 
            (format #t "by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 1) 
            r) 
           (else 
            (format #t "else alternate: a=~A, b=~A, r=~A~%" a b r) 
            0)))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "Format error: no 'by' alternate" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (ensure (= r 1) 
           (else-by 
            (format #t "first else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 2) 
            r) 
           (else-by 
            (format #t "second else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 3) 
            r) 
           (else 
            (format #t "else alternate: a=~A, b=~A, r=~A~%" a b r) 
            0)))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "Format error: no 'else' alternate" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (ensure (= r 1) 
           (by 
            (format #t "by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 1) 
            r) 
           (else-by 
            (format #t "first else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 2) 
            r) 
           (else-by 
            (format #t "second else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 3) 
            r)))) 
  
 ;; ------------------------------------------------------------ 
  
 (test "Format error: missing 'ensure' symbol" 
       (recovery-block ((a (begin 
                             (format #t "evaluating 'a' value~%") 
                             (+ 1 2))) 
                        (b (begin 
                             (format #t "evaluating 'b' value~%") 
                             (+ 3 4))) 
                        (r #f)) 
         (cond (= r 1) 
           (by 
            (format #t "by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 1) 
            r) 
           (else-by 
            (format #t "first else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 2) 
            r) 
           (else-by 
            (format #t "second else-by alternate: a=~A, b=~A, r=~A~%" a b r) 
            (set! r 3) 
            r)))) 
  

category-guile