Changeset 15941 in project


Ignore:
Timestamp:
09/17/09 19:29:15 (10 years ago)
Author:
Kon Lovett
Message:

Rel 2.0.0 for Chicken 4

Location:
release/4/F-operator
Files:
4 deleted
18 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/F-operator/tags/2.0.0/F-operator.meta

    r15934 r15941  
    1010 (files
    1111  "tests"
     12  "F-operator.setup"
    1213  "range.scm"
    13   "F-operator.setup"
    1414  "reflect-reify.scm"
    15   "shift-reset.scm" "shift-reset-runtime.scm"
    16   "bshift-breset.scm" "bshift-breset-runtime.scm"
    17   "gshift-greset.scm" "gshift-greset-runtime.scm") )
     15  "shift-reset.scm"
     16  "bshift-breset.scm"
     17  "gshift-greset.scm") )
  • release/4/F-operator/tags/2.0.0/F-operator.setup

    r15934 r15941  
    66
    77(setup-shared-extension-module 'shift-reset (extension-version "2.0.0")
    8   #:compile-options '(-fixnum
     8  #:compile-options '(-fixnum-arithmetic
    99                      -disable-interrupts
    1010                      -optimize-level 3
    1111                      -no-lambda-info -no-procedure-checks -no-argc-checks -no-bound-checks))
    1212
    13 (setup-shared-extension-module 'bbshift-reset (extension-version "2.0.0")
    14   #:compile-options '(-fixnum
     13(setup-shared-extension-module 'bshift-breset (extension-version "2.0.0")
     14  #:compile-options '(-fixnum-arithmetic
    1515                      -disable-interrupts
    1616                      -optimize-level 3
     
    1818
    1919(setup-shared-extension-module 'delimited-control (extension-version "2.0.0")
    20   #:compile-options '(-fixnum
     20  #:compile-options '(-fixnum-arithmetic
    2121                      -disable-interrupts
    2222                      -optimize-level 3
    2323                      -inline-limit 50
    2424                      -no-lambda-info -no-procedure-checks -no-argc-checks -no-bound-checks))
     25
     26(setup-shared-extension-module 'range (extension-version "2.0.0"))
     27
     28(setup-shared-extension-module 'reflect-reify (extension-version "2.0.0"))
     29
     30(setup-shared-extension-module 'gshift-greset (extension-version "2.0.0")
     31  #:compile-options '(-fixnum-arithmetic
     32                      -disable-interrupts
     33                      -optimize-level 3
     34                      -inline-limit 50
     35                      -no-lambda-info -no-procedure-checks -no-argc-checks -no-bound-checks))
     36
     37(install-extension-tag (extension-name) (extension-version "2.0.0"))
  • release/4/F-operator/tags/2.0.0/bshift-breset.scm

    r15934 r15941  
    1111  (breset-values *breset-values) (bshift-values *bshift-values)
    1212  ;;
     13  *%breset *%bshift
     14  *breset *bshift
     15  *%breset-values *%bshift-values
     16  *breset-values *bshift-values
     17  ;;
    1318  $range-empty-tag)
    1419
     
    8590(define-syntax *%breturn
    8691        (syntax-rules ()
    87                 ((RC EXPR RC-SYM CALLER)
     92                ((_ RC EXPR RC-SYM CALLER)
    8893      (let ((val EXPR) (rc RC))
    8994        (if (not (*box-structure? rc)) (bad-dk CALLER RC-SYM)
     
    95100  (let/cdc rc-k
    96101    (let ((rc (make-box rc-k)))
    97       (*%breturn rc
    98         (proc rc)
    99         rc-sym '%breset))))
     102      (*%breturn rc (proc rc) rc-sym '%breset) ) ) )
    100103
    101104(define (*%bshift rc proc rc-sym)
     
    104107      (proc
    105108        (lambda (val)
    106           (if (*box-structure? rc)
    107             (let ((old-rc (*box-structure-ref rc)))
    108               (let ((s-val
    109                       (let/cdc rc-k
    110                         (*box-structure-set! rc rc-k)
    111                         (##sys#direct-return s-k val))))
    112                 (*box-structure-set! rc old-rc)
    113                 s-val))
    114             (bad-dk '%bshift rc-sym))))
    115       rc-sym '%bshift)))
     109          (if (not (*box-structure? rc)) (bad-dk '%bshift rc-sym)
     110              (let ((old-rc (*box-structure-ref rc)))
     111                (let ((s-val
     112                        (let/cdc rc-k
     113                          (*box-structure-set! rc rc-k)
     114                          (##sys#direct-return s-k val))))
     115                  (*box-structure-set! rc old-rc)
     116                  s-val)))))
     117      rc-sym '%bshift) ) )
    116118
    117119;;
     
    121123(define-syntax *breturn
    122124        (syntax-rules ()
    123                 ((RC EXPR RC-SYM CALLER)
     125                ((_ RC EXPR RC-SYM CALLER)
    124126      (let ((val EXPR) (rc RC))
    125127        (if (not (*box-structure? rc)) (bad-dk CALLER RC-SYM)
     
    131133  (let/cc rc-k
    132134    (let ((rc (make-box rc-k)))
    133       (*breturn rc
    134         (proc rc)
    135         rc-sym 'breset))))
     135      (*breturn rc (proc rc) rc-sym 'breset) ) ) )
    136136
    137137(define (*bshift rc proc rc-sym)
     
    140140      (proc
    141141        (lambda (val)
    142           (if (*box-structure? rc)
    143             (let ((old-rc (*box-structure-ref rc)))
    144               (let ((s-val
    145                       (let/cc rc-k
    146                         (*box-structure-set! rc rc-k)
    147                         (s-k val))))
    148                 (*box-structure-set! rc old-rc)
    149                 s-val))
    150             (bad-dk 'bshift rc-sym))))
    151       rc-sym 'bshift)))
     142          (if (not (*box-structure? rc)) (bad-dk 'bshift rc-sym)
     143              (let ((old-rc (*box-structure-ref rc)))
     144                (let ((s-val
     145                        (let/cc rc-k
     146                          (*box-structure-set! rc rc-k)
     147                          (s-k val))))
     148                  (*box-structure-set! rc old-rc)
     149                  s-val)))))
     150      rc-sym 'bshift) ) )
    152151
    153152;;
     
    157156(define-syntax *%breturn-values
    158157        (syntax-rules ()
    159                 ((RC EXPR RC-SYM CALLER)
     158                ((_ RC EXPR RC-SYM CALLER)
    160159      (let ((rc RC))
    161160        (call-with-values
     
    170169  (let/scc rc-k
    171170    (let ((rc (make-box rc-k)))
    172       (*%breturn-values rc
    173         (proc rc)
    174         rc-sym '%breset-values))))
     171      (*%breturn-values rc (proc rc) rc-sym '%breset-values) ) ) )
    175172
    176173(define (*%bshift-values rc proc rc-sym)
     
    179176      (proc
    180177        (lambda vals
    181           (if (*box-structure? rc)
    182             (let ((old-rc (*box-structure-ref rc)))
    183               (call-with-values
    184                 (lambda ()
    185                   (let/scc rc-k
    186                     (*box-structure-set! rc rc-k)
    187                     (apply s-k vals)))
    188                 (lambda s-vals
    189                   (*box-structure-set! rc old-rc)
    190                   (apply values s-vals))))
    191             (bad-dk '%bshift-values rc-sym))))
    192       rc-sym '%bshift-values)))
     178          (if (not (*box-structure? rc)) (bad-dk '%bshift-values rc-sym)
     179              (let ((old-rc (*box-structure-ref rc)))
     180                (call-with-values
     181                  (lambda ()
     182                    (let/scc rc-k
     183                      (*box-structure-set! rc rc-k)
     184                      (apply s-k vals)))
     185                  (lambda s-vals
     186                    (*box-structure-set! rc old-rc)
     187                    (apply values s-vals)))))))
     188      rc-sym '%bshift-values) ) )
    193189
    194190;;
     
    198194(define-syntax *breturn-values
    199195        (syntax-rules ()
    200                 ((RC EXPR RC-SYM CALLER)
     196                ((_ RC EXPR RC-SYM CALLER)
    201197      (let ((rc RC))
    202198        (call-with-values
     
    211207  (let/ccp rc-k
    212208    (let ((rc (make-box rc-k)))
    213       (*breturn-values rc
    214         (proc rc)
    215         rc-sym 'breset-values) ) ) )
     209      (*breturn-values rc (proc rc) rc-sym 'breset-values) ) ) )
    216210
    217211(define (*bshift-values rc proc rc-sym)
     
    220214      (proc
    221215        (lambda vals
    222           (if (*box-structure? rc)
    223             (let ((old-rc (*box-structure-ref rc)))
    224               (call-with-values
    225                 (lambda ()
    226                   (let/ccp rc-k
    227                     (*box-structure-set! rc rc-k)
    228                     (apply continuation-return s-k vals)))
    229                 (lambda s-vals
    230                   (*box-structure-set! rc old-rc)
    231                   (apply values s-vals))))
    232             (bad-dk 'bshift-values rc-sym))))
     216          (if (not (*box-structure? rc)) (bad-dk 'bshift-values rc-sym)
     217              (let ((old-rc (*box-structure-ref rc)))
     218                (call-with-values
     219                  (lambda ()
     220                    (let/ccp rc-k
     221                      (*box-structure-set! rc rc-k)
     222                      (apply continuation-return s-k vals)))
     223                  (lambda s-vals
     224                    (*box-structure-set! rc old-rc)
     225                    (apply values s-vals)))))))
    233226      rc-sym 'bshift-values) ) )
    234227
  • release/4/F-operator/tags/2.0.0/delimited-control.scm

    r15934 r15941  
    55
    66(module delimited-control (;export
     7  ;;
    78  (prompt *prompt) (prompt0 *prompt)
    89  (reset *prompt) (reset0 *prompt)
     
    1011  (control0 *control)
    1112  (shift *control)
    12   (shift0 *control))
     13  (shift0 *control)
     14  ;;
     15  *prompt *control)
    1316
    1417  (import scheme chicken
  • release/4/F-operator/tags/2.0.0/gshift-greset.scm

    r15934 r15941  
    44;;;; From Indiana University TR611 by Oleg Kiselyov
    55
    6 (eval-when (compile)
    7   (declare
    8     (usual-integrations)
    9     (inline)
    10     (fixnum)
    11     (export
    12       h-datatype? h-compose h-value
    13       hr-stop hs-stop
    14       hr-prop hs-prop) ) )
     6(module gshift-greset (;export
     7  ;;
     8  (greset h-value) (gshift h-compose)
     9  h-datatype? h-compose h-value
     10  hr-stop hs-stop
     11  hr-prop hs-prop
     12  ;;
     13  (reset *reset) (shift *shift))
    1514
    16 (use datatype shift-reset)
     15  (import scheme
     16          (except chicken reset)
     17          (only data-structures constantly)
     18          datatype
     19          shift-reset)
    1720
    18 ;; This has an interaction w/ the 'define' form, where the EXPR
    19 ;; is "protected" thru expansion & is the original literal, so
    20 ;; "undefined variable" results.
    21 #;
    22 (define-syntax (h-cases X)
    23   (syntax-case X ()
    24     ((sk EXPR (HCE HCV) (HVE HVV))
    25       #'(cases h-datatype EXPR
    26           (h-compose HCE HCV)
    27           (h-value (HVE) HVV))) ) )
     21  (require-library data-structures datatype shift-reset)
    2822
    29 (define-macro (h-cases EXPR H-PART HV-PART)
    30   `(cases h-datatype ,EXPR
    31      (h-compose ,(car H-PART) ,(cadr H-PART))
    32      (h-value ,(list (car HV-PART)) ,(cadr HV-PART)) ) )
     23(define-syntax h-cases
     24  (lambda (frm rnm cmp)
     25    (##sys#check-syntax 'h-cases frm '(_ _ (_ _) (_ _)))
     26    (let ((_cases (rnm 'cases)))
     27      (let ((expr (cadr frm))
     28            (h-part (caddr frm))
     29            (hv-part (cadddr frm)) )
     30       `(cases h-datatype ,expr
     31           (h-compose ,(car h-part) ,(cadr h-part))
     32           (h-value ,(list (car hv-part)) ,(cadr hv-part)) ) ) ) ) )
    3333
    3434(define-syntax greset
     
    3939  (syntax-rules ()
    4040    ((_ HS F E)
    41       (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E)))) ) ) )
     41      (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E))) ) ) )
    4242
    4343(define-datatype h-datatype h-datatype?
    4444  (h-value (v (constantly #t)))
    45   (h-compose (f procedure?) (x procedure?)))
     45  (h-compose (f procedure?) (x procedure?)) )
    4646
    4747(define (hr-stop expr)
    4848  (h-cases expr
    49     ((f x) (greset hr-stop (x f)))
    50     (v v)))
     49    ((f x) (greset hr-stop (x f)) )
     50    (v v ) ) )
    5151
    5252(define hs-stop hr-stop)
     
    5454(define (hr-prop expr)
    5555  (h-cases expr
    56     ((f x) (x f))
    57     (v v)))
     56    ((f x) (x f) )
     57    (v v ) ) )
    5858
    5959(define (hs-prop expr)
    6060  (h-cases expr
    6161    ((f x)
    62       (shift g
    63         (h-compose (lambda (y) (hs-prop (g (f y)))) x)))
    64     (v v)))
     62      (shift g (h-compose (lambda (y) (hs-prop (g (f y)))) x)) )
     63    (v v ) ) )
     64
     65) ;module gshift-greset
     66
  • release/4/F-operator/tags/2.0.0/range.scm

    r15934 r15941  
    66(module range (;export
    77  ;;
    8   (range-empty? *range:empty*)
    9   (range *range:empty*)
    10   (%range *range:empty*)
     8  (range-empty? $range-empty-tag)
     9  (range $range-empty-tag)
     10  (%range $range-empty-tag)
    1111  ;;
    12   bshift
    13   %bshift)
     12  (%bshift *%bshift)
     13  (bshift *bshift))
    1414
    1515  (import scheme chicken bshift-breset)
     
    2727      (bshift RC shifter
    2828        (let loop ((state (FROM)))
    29           (if (TO? state) *range:empty*
     29          (if (TO? state) $range-empty-tag
    3030              (begin
    3131                (shifter (VALUE state))
     
    5757      (%bshift RC shifter
    5858        (do ((i FROM (+ i STEP)))
    59             ((> i TO) *range:empty*)
     59            ((> i TO) $range-empty-tag)
    6060          (shifter i))))
    6161    ;
  • release/4/F-operator/tags/2.0.0/reflect-reify.scm

    r15934 r15941  
    22;;;; Kon Lovett, Oct 10 '06
    33
    4 (use shift-reset)
    5 
    64;; Monads from shift and reset (from Filinski, POPL '94)
    75
    8 (define-syntax (define-bind exp)
    9   (syntax-case exp ()
    10     ((sk kind body ...)
    11       (identifier? #'kind)
    12       (with-syntax (
    13           (monad (datum->syntax-object #'sk 'monad))
    14           (func (datum->syntax-object #'sk 'func))
    15           (bind
    16             (datum->syntax-object #'sk
    17               (string->symbol
    18                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    19         #'(define (bind monad func) body ...))) ) )
     6(module reflect-reify (;export
     7  ;;
     8  define-bind define-unit
     9  reflect reflect-values %reflect
     10  reify reify-values %reify
     11  ;;
     12  shift reset)
    2013
    21 (define-syntax (define-unit exp)
    22   (syntax-case exp ()
    23     ((sk kind body ...)
    24       (identifier? #'kind)
    25       (with-syntax (
    26           (obj (datum->syntax-object #'sk 'obj))
    27           (unit
    28             (datum->syntax-object #'sk
    29               (string->symbol
    30                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    31         #'(define (unit obj) body ...))) ) )
     14  (import scheme chicken shift-reset)
    3215
    33 (define-syntax (reflect exp)
    34   (syntax-case exp ()
    35     ((sk kind meaning)
    36       (identifier? #'kind)
    37       (with-syntax (
    38           (bind
    39             (datum->syntax-object #'sk
    40               (string->symbol
    41                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    42         #'(shift k (bind meaning k)))) ) )
     16  (require-library shift-reset)
    4317
    44 (define-syntax (reflect-values exp)
    45   (syntax-case exp ()
    46     ((sk kind meaning)
    47       (identifier? #'kind)
    48       (with-syntax (
    49           (bind
    50             (datum->syntax-object #'sk
    51               (string->symbol
    52                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    53         #'(shift-values k (bind meaning k)))) ) )
     18#; ;Doesn't work!
     19(define-for-syntax (check-identifier? loc obj)
     20  (unless (symbol? (strip-syntax obj))
     21    (syntax-error "bad argument type - not an identifier" obj)) )
    5422
    55 (define-syntax (%reflect exp)
    56   (syntax-case exp ()
    57     ((sk kind meaning)
    58       (identifier? #'kind)
    59       (with-syntax (
    60           (bind
    61             (datum->syntax-object #'sk
    62               (string->symbol
    63                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    64         #'(%shift k (bind meaning k)))) ) )
     23(define-for-syntax (suffix-identifier id sym)
     24  (string->symbol (conc (strip-syntax id) #\- (strip-syntax sym))) )
    6525
    66 (define-syntax (reify exp)
    67   (syntax-case exp ()
    68     ((sk kind exp)
    69       (identifier? #'kind)
    70       (with-syntax (
    71           (unit
    72             (datum->syntax-object #'sk
    73               (string->symbol
    74                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    75         #'(reset (unit exp)))) ) )
     26(define-for-syntax (bind-identifier id) (suffix-identifier id 'bind))
    7627
    77 (define-syntax (reify-values exp)
    78   (syntax-case exp ()
    79     ((sk kind exp)
    80       (identifier? #'kind)
    81       (with-syntax (
    82           (unit
    83             (datum->syntax-object #'sk
    84               (string->symbol
    85                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    86         #'(reset-values (unit exp)))) ) )
     28(define-for-syntax (unit-identifier id) (suffix-identifier id 'unit))
    8729
    88 (define-syntax (%reify exp)
    89   (syntax-case exp ()
    90     ((sk kind exp)
    91       (identifier? #'kind)
    92       (with-syntax (
    93           (unit
    94             (datum->syntax-object #'sk
    95               (string->symbol
    96                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    97         #'(%reset (unit exp)))) ) ) )
     30(define-syntax define-bind
     31  (lambda (frm rnm cmp)
     32    (##sys#check-syntax 'define-bind frm '(_ symbol _ . _))
     33    (let ((_define (rnm 'define)))
     34      (let ((kind (cadr frm))
     35            (body (cddr frm)) )
     36        `(,_define (,(bind-identifier kind) monad func) ,@body) ) ) ) )
     37
     38(define-syntax define-unit
     39  (lambda (frm rnm cmp)
     40    (##sys#check-syntax 'define-unit frm '(_ symbol _ . _))
     41    (let ((_define (rnm 'define)))
     42      (let ((kind (cadr frm))
     43            (body (cddr frm)) )
     44        `(,_define (,(unit-identifier kind) obj) ,@body) ) ) ) )
     45
     46(define-syntax reflect
     47  (lambda (frm rnm cmp)
     48    (##sys#check-syntax 'reflect frm '(_ symbol _))
     49    (let ((_shift (rnm 'shift)))
     50      (let ((kind (cadr frm))
     51            (meaning (caddr frm)) )
     52        `(,_shift k (,(bind-identifier kind) ,meaning k)) ) ) ) )
     53
     54(define-syntax reflect-values
     55  (lambda (frm rnm cmp)
     56    (##sys#check-syntax 'reflect-values frm '(_ symbol _))
     57    (let ((_shift-values (rnm 'shift-values)))
     58      (let ((kind (cadr frm))
     59            (meaning (caddr frm)) )
     60        `(,_shift-values k (,(bind-identifier kind) ,meaning k)) ) ) ) )
     61
     62(define-syntax %reflect
     63  (lambda (frm rnm cmp)
     64    (##sys#check-syntax '%reflect frm '(_ symbol _))
     65    (let ((_%shift (rnm '%shift)))
     66      (let ((kind (cadr frm))
     67            (meaning (caddr frm)) )
     68        `(,_%shift k (,(bind-identifier kind) ,meaning k)) ) ) ) )
     69
     70(define-syntax reify
     71  (lambda (frm rnm cmp)
     72    (##sys#check-syntax 'reify frm '(_ symbol _))
     73    (let ((_reset (rnm 'reset)))
     74      (let ((kind (cadr frm))
     75            (expr (caddr frm)) )
     76        `(,_reset (,(unit-identifier kind) ,expr)) ) ) ) )
     77
     78(define-syntax reify-values
     79  (lambda (frm rnm cmp)
     80    (##sys#check-syntax 'reify-values frm '(_ symbol _))
     81    (let ((_reset-values (rnm 'reset-values)))
     82      (let ((kind (cadr frm))
     83            (expr (caddr frm)) )
     84        `(,_reset-values (,(unit-identifier kind) ,expr)) ) ) ) )
     85
     86(define-syntax %reify
     87  (lambda (frm rnm cmp)
     88    (##sys#check-syntax '%reify frm '(_ symbol _))
     89    (let ((_%reset (rnm '%reset)))
     90      (let ((kind (cadr frm))
     91            (expr (caddr frm)) )
     92        `(,_%reset (,(unit-identifier kind) ,expr)) ) ) ) )
     93
     94) ;module reflect-reify
  • release/4/F-operator/tags/2.0.0/shift-reset.scm

    r15934 r15941  
    55
    66(module shift-reset (;export
     7  ;;
    78  (%reset *%reset) (%shift *%shift)
    89  (reset *reset) (shift *shift)
    910  (%reset-values *%reset-values) (%shift-values *%shift-values)
    10   (reset-values *reset-values) (shift-values *shift-values))
     11  (reset-values *reset-values) (shift-values *shift-values)
     12  ;;
     13  *%reset *%shift
     14  *reset *shift
     15  *%reset-values *%shift-values
     16  *reset-values *shift-values)
    1117
    12   (import scheme chicken
     18  (import scheme
     19          (except chicken reset)
    1320          (only miscmacros let/cc))
    1421
    1522  (require-library miscmacros)
     23
     24  (declare
     25                (always-bound
     26                        *meta-dk*
     27                        *meta-k*
     28                        *meta-dkv*
     29                        *meta-kv*))
    1630
    1731(define-syntax %reset
     
    115129(define (*shift proc)
    116130  (let/cc k
    117     (*return
    118       (proc
    119         (lambda (val)
    120           (*reset
    121             (lambda ()
    122               (k val)))))) ) )
     131    (*return (proc (lambda (val) (*reset (lambda () (k val)))))) ) )
    123132
    124133;;
     
    148157(define (*%shift-values proc)
    149158  (let/scc k
    150     (*%return-values
    151       (proc
    152         (lambda vals
    153           (*%reset-values
    154             (lambda ()
    155               (apply k vals)))))) ) )
     159    (*%return-values (proc (lambda vals (*%reset-values (lambda () (apply k vals)))))) ) )
    156160
    157161;;
     
    184188  (let/ccp k
    185189    (*return-values
    186       (proc
    187         (lambda vals
    188           (*reset-values
    189             (lambda ()
    190               (apply continuation-return k vals)))))
     190      (proc (lambda vals (*reset-values (lambda () (apply continuation-return k vals)))))
    191191      'shift-values) ) )
    192192
  • release/4/F-operator/tags/2.0.0/tests/run.scm

    r15934 r15941  
    22;;;; Kon Lovett, Apr 6 '06
    33
    4 (use testbase testbase-output-human)
     4(use test)
    55(use shift-reset bshift-breset gshift-greset reflect-reify range)
    66(use srfi-1)
     
    99
    1010(define (make-collector)
    11   (let ([lst '()])
     11  (let ((lst '()))
    1212    (lambda v
    13       (if (null? v)
    14         (reverse! lst)
     13      (if (null? v) (reverse! lst)
    1514        (begin
    1615          (set-cdr! v lst)
     
    2423
    2524(define (maybe-foo x)
    26   (if (zero? x)
    27     (reflect maybe #f)  ; exception
    28     (/ 1 x) ) )
     25  (if (zero? x) (reflect maybe #f)  ; exception
     26      (/ 1 x) ) )
    2927
    3028(define (maybe-bar x)
     
    3230
    3331(define (maybe-baz x)
    34   (if (zero? x)
    35     (reflect maybe #f)
    36     (/ 1 x) ) )
    37 
    38 (cond-expand
    39   [hygienic-macros
    40 
    41     ;; Generalized shift/reset implementations of some control operators
    42 
    43     (define-syntax prompt
    44       (syntax-rules ()
    45         [(_ e) (greset hr-stop e)] ) )
    46 
    47     (define-syntax control
    48       (syntax-rules ()
    49         [(_ f e) (gshift hs-prop f e)] ) )
    50 
    51     (define-syntax prompt0
    52       (syntax-rules ()
    53         [(_ e) (greset hr-prop e)] ) )
    54 
    55     (define-syntax shift0
    56       (syntax-rules ()
    57         [(_ f e) (gshift hs-stop f e)] ) ) ]
    58 
    59   [else
    60 
    61     ;; Generalized shift/reset implementations of some control operators
    62 
    63     (define-macro (prompt E)
    64       `(greset hr-stop ,E) )
    65 
    66     (define-macro (control F E)
    67       `(gshift hs-prop ,F ,E) )
    68 
    69     (define-macro (prompt0 E)
    70       `(greset hr-prop ,E) )
    71 
    72     (define-macro (shift0 F E)
    73       `(gshift hs-stop ,F ,E) ) ] )
     32  (if (zero? x) (reflect maybe #f)
     33      (/ 1 x) ) )
     34
     35;; Generalized shift/reset implementations of some control operators
     36
     37(define-syntax prompt
     38  (syntax-rules ()
     39    ((_ e) (greset hr-stop e)) ) )
     40
     41(define-syntax control
     42  (syntax-rules ()
     43    ((_ f e) (gshift hs-prop f e)) ) )
     44
     45(define-syntax prompt0
     46  (syntax-rules ()
     47    ((_ e) (greset hr-prop e)) ) )
     48
     49(define-syntax shift0
     50  (syntax-rules ()
     51    ((_ f e) (gshift hs-stop f e)) ) )
    7452
    7553;;;
    7654
    77 (define-test shift-reset-test "Shift/Reset Family"
    78 
    79   (test/case "%shift/%reset"
    80 
    81     (expect-eqv 5
     55(test-group "Shift/Reset Family"
     56
     57  (test-group "%shift/%reset"
     58
     59    (test 5
    8260      (+ 1 (%reset (* 2 (%shift k 4)))))
    8361
    84     (expect-eqv 117
     62    (test 117
    8563      (+ 10 (%reset (+ 2 (%shift k (+ 100 (k (k 3))))))))
    8664
    87     (expect-eqv 60
     65    (test 60
    8866      (* 10 (%reset (* 2 (%shift g (%reset (* 5 (%shift f (+ (f 1) 1)))))))))
    8967
    90     (expect-eqv 121
    91       (let ([f (lambda (x) (%shift k (k (k x))))])
     68    (test 121
     69      (let ((f (lambda (x) (%shift k (k (k x))))))
    9270        (+ 1 (%reset (+ 10 (f 100))))))
    9371
    94     (expect-equal '(a)
     72    (test '(a)
    9573      (%reset
    96         (let ([x (%shift f (cons 'a (f '())))])
     74        (let ((x (%shift f (cons 'a (f '())))))
    9775          (%shift g x))))
    9876
    99     (expect-equal '(a 1 b b c) ; not '(a b 1 b b c)
     77    (test '(a 1 b b c) ; not '(a b 1 b b c)
    10078      (cons 'a (%reset (cons 'b (%shift f (cons 1 (f (f (cons 'c '())))))))))
    10179
    102     (expect-failure (%shift t 'x))
    103   )
    104 
    105   (test/case "shift/reset"
    106 
    107     (expect-eqv 5
     80    (test-error (%shift t 'x))
     81  )
     82
     83  (test-group "shift/reset"
     84
     85    (test 5
    10886      (+ 1 (reset (* 2 (shift k 4)))))
    10987
    110     (expect-eqv 117
     88    (test 117
    11189      (+ 10 (reset (+ 2 (shift k (+ 100 (k (k 3))))))))
    11290
    113     (expect-eqv 60
     91    (test 60
    11492      (* 10 (reset (* 2 (shift g (reset (* 5 (shift f (+ (f 1) 1)))))))))
    11593
    116     (expect-eqv 121
    117       (let ([f (lambda (x) (shift k (k (k x))))])
     94    (test 121
     95      (let ((f (lambda (x) (shift k (k (k x))))))
    11896        (+ 1 (reset (+ 10 (f 100))))))
    11997
    120     (expect-equal '(a)
     98    (test '(a)
    12199      (reset
    122         (let ([x (shift f (cons 'a (f '())))])
     100        (let ((x (shift f (cons 'a (f '())))))
    123101          (shift g x))))
    124102
    125     (expect-equal '(a 1 b b c) ; not '(a b 1 b b c)
     103    (test '(a 1 b b c) ; not '(a b 1 b b c)
    126104      (cons 'a (reset (cons 'b (shift f (cons 1 (f (f (cons 'c '())))))))))
    127105
    128     (expect-failure (shift t 'x))
    129   )
    130 
    131   (test/case "%shift-values/%reset-values"
    132 
    133     (expect-eqv 5
     106    (test-error (shift t 'x))
     107  )
     108
     109  (test-group "%shift-values/%reset-values"
     110
     111    (test 5
    134112      (+ 1 (%reset-values (* 2 (%shift-values k 4)))))
    135113
    136     (expect-eqv 117
     114    (test 117
    137115      (+ 10 (%reset-values (+ 2 (%shift-values k (+ 100 (k (k 3))))))))
    138116
    139     (expect-eqv 60
     117    (test 60
    140118      (* 10 (%reset-values (* 2 (%shift-values g (%reset-values (* 5 (%shift-values f (+ (f 1) 1)))))))))
    141119
    142     (expect-eqv 121
    143       (let ([f (lambda (x) (%shift-values k (k (k x))))])
     120    (test 121
     121      (let ((f (lambda (x) (%shift-values k (k (k x))))))
    144122        (+ 1 (%reset-values (+ 10 (f 100))))))
    145123
    146     (expect-equal '(a)
     124    (test '(a)
    147125      (%reset-values
    148         (let ([x (%shift-values f (cons 'a (f '())))])
     126        (let ((x (%shift-values f (cons 'a (f '())))))
    149127          (%shift-values g x))))
    150128
    151     (expect-equal '(a 1 b b c)
     129    (test '(a 1 b b c)
    152130      (cons 'a (%reset-values (cons 'b (%shift-values f (cons 1 (f (f (cons 'c '())))))))))
    153131
    154     (expect-failure (%shift-values t 'x))
    155 
    156     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     132    (test-error (%shift-values t 'x))
     133
     134    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    157135      (cons 'a
    158136        (%reset-values
    159137          (cons 'b
    160             (let-values ([(x y) (%shift-values f (cons 1 (f '2 (f 3 '()))))])
     138            (let-values (((x y) (%shift-values f (cons 1 (f '2 (f 3 '()))))))
    161139              (cons x y))))))
    162140  )
    163141
    164   (test/case "shift-values/reset-values"
    165 
    166     (expect-eqv 5
     142  (test-group "shift-values/reset-values"
     143
     144    (test 5
    167145      (+ 1 (reset-values (* 2 (shift-values k 4)))))
    168146
    169     (expect-eqv 117
     147    (test 117
    170148      (+ 10 (reset-values (+ 2 (shift-values k (+ 100 (k (k 3))))))))
    171149
    172     (expect-eqv 60
     150    (test 60
    173151      (* 10 (reset-values (* 2 (shift-values g (reset-values (* 5 (shift-values f (+ (f 1) 1)))))))))
    174152
    175     (expect-eqv 121
    176       (let ([f (lambda (x) (shift-values k (k (k x))))])
     153    (test 121
     154      (let ((f (lambda (x) (shift-values k (k (k x))))))
    177155        (+ 1 (reset-values (+ 10 (f 100))))))
    178156
    179     (expect-equal '(a)
     157    (test '(a)
    180158      (reset-values
    181         (let ([x (shift-values f (cons 'a (f '())))])
     159        (let ((x (shift-values f (cons 'a (f '())))))
    182160          (shift-values g x))))
    183161
    184     (expect-equal '(a 1 b b c)
     162    (test '(a 1 b b c)
    185163      (cons 'a (reset-values (cons 'b (shift-values f (cons 1 (f (f (cons 'c '())))))))))
    186164
    187     (expect-failure (shift-values t 'x))
    188 
    189     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     165    (test-error (shift-values t 'x))
     166
     167    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    190168      (cons 'a
    191169        (reset-values
    192170          (cons 'b
    193             (let-values ([(x y) (shift-values f (cons 1 (f '2 (f 3 '()))))])
     171            (let-values (((x y) (shift-values f (cons 1 (f '2 (f 3 '()))))))
    194172              (cons x y))))))
    195173  )
    196174
    197   (test/case "%bshift/%breset" (
    198       [gather (make-collector)]
    199       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    200     )
    201 
    202     (expect-equal "step 1" '(1 2 6 24 120)
    203       (begin
    204         (%breset r
    205           (gather (fact (%range r 1 5))))
    206         (gather)))
    207     (expect-set! gather (make-collector))
    208 
    209     (expect-equal "step 2" '(1 6 120 5040 362880 39916800 6227020800)
    210       (begin
    211         (%breset r
    212           (gather (fact (%range r 1 2 14))))
    213         (gather)))
    214     (expect-set! gather (make-collector))
    215 
    216     (expect-equal "two %ranges" '(101 111 121 102 112 122)
    217       (begin
     175  (test-group "%bshift/%breset"
     176
     177    (let ((gather (make-collector)))
     178
     179      (define (fact n) (let loop ((n n)) (if (<= n 0) 1 (* n (loop (- n 1))))))
     180
     181      (test "step 1" '(1 2 6 24 120)
     182        (begin
     183          (%breset r
     184            (gather (fact (%range r 1 5))))
     185          (gather)))
     186      (set! gather (make-collector))
     187
     188      (test "step 2" '(1 6 120 5040 362880 39916800 6227020800)
     189        (begin
     190          (%breset r
     191            (gather (fact (%range r 1 2 14))))
     192          (gather)))
     193      (set! gather (make-collector))
     194
     195      (test "two %ranges" '(101 111 121 102 112 122)
     196        (begin
     197          (%breset r1
     198            (%breset r2 (gather (+ (%range r1 1 2) (%range r2 100 10 120)))))
     199          (gather)))
     200      (set! gather (make-collector))
     201
     202      (test "collect" 120
    218203        (%breset r1
    219           (%breset r2 (gather (+ (%range r1 1 2) (%range r2 100 10 120)))))
    220         (gather)))
    221     (expect-set! gather (make-collector))
    222 
    223     (expect-eqv "collect" 120
    224       (%breset r1
    225         (%breset r2
    226           (%bshift r1 f
    227             (let ([n (%range r2 1 5)]
    228                   [nprev (f #f)])
    229               (* n (if (range-empty? nprev) 1 nprev)))))))
    230 
    231     (expect-equal "%range-collect" '(120 120 60 20 5)
    232       (begin
    233         (%breset r3
    234           (gather
    235             (%breset r1
    236               (%breset r2
    237                 (%bshift r1 f
    238                   (let ([n (%range r2 (%range r3 1 5) 5)]
    239                         [nprev (f #f)])
    240                     (* n (if (range-empty? nprev) 1 nprev))))))))
    241         (gather)))
    242     (expect-set! gather (make-collector))
    243 
    244     (expect-equal '(11 14 17)
    245       (begin
    246         (%breset r
    247           (let* ([k (%range r 1 3 9)]
    248                 [j (+ 10 k)])
    249             (gather j)))
    250         (gather)))
    251     (expect-set! gather (make-collector))
    252 
    253     (expect-equal '(1 2 3)
    254       (begin
    255         (%breset out
     204          (%breset r2
     205            (%bshift r1 f
     206              (let ((n (%range r2 1 5))
     207                    (nprev (f #f)))
     208                (* n (if (range-empty? nprev) 1 nprev)))))))
     209
     210      (test "%range-collect" '(120 120 60 20 5)
     211        (begin
     212          (%breset r3
     213            (gather
     214              (%breset r1
     215                (%breset r2
     216                  (%bshift r1 f
     217                    (let ((n (%range r2 (%range r3 1 5) 5))
     218                          (nprev (f #f)))
     219                      (* n (if (range-empty? nprev) 1 nprev))))))))
     220          (gather)))
     221      (set! gather (make-collector))
     222
     223      (test '(11 14 17)
     224        (begin
    256225          (%breset r
    257             (let ([k (%range r 1 4)])
    258               (gather k)
    259               (when (> k 2)
    260                 (%bshift out f #f)))))
    261         (gather)))
    262     (expect-set! gather (make-collector))
    263 
    264     (expect-equal '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
    265       (begin
    266         (%breset r
    267           (let ([k (%range r 1 4)])
    268             (%breset inner
    269               (let ([j (%range inner 10 k (* 10 k))])
    270                 (when (odd? k)
    271                   (%bshift r f #f))
    272                 (gather (list k j))))))
    273         (gather)))
    274     (expect-set! gather (make-collector))
    275   )
    276 
    277   (test/case "bshift/breset" (
    278       [gather (make-collector)]
    279       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    280     )
    281 
    282     (expect-equal "step 1" '(1 2 6 24 120)
    283       (begin
    284         (breset r
    285           (gather (fact (range r 1 5))))
    286         (gather)))
    287     (expect-set! gather (make-collector))
    288 
    289     (expect-equal "step 2" '(1 6 120 5040 362880 39916800 6227020800)
    290       (begin
    291         (breset r
    292           (gather (fact (range r 1 2 14))))
    293         (gather)))
    294     (expect-set! gather (make-collector))
    295 
    296     (expect-equal "two ranges" '(101 111 121 102 112 122)
    297       (begin
     226            (let* ((k (%range r 1 3 9))
     227                  (j (+ 10 k)))
     228              (gather j)))
     229          (gather)))
     230      (set! gather (make-collector))
     231
     232      (test '(1 2 3)
     233        (begin
     234          (%breset out
     235            (%breset r
     236              (let ((k (%range r 1 4)))
     237                (gather k)
     238                (when (> k 2)
     239                  (%bshift out f #f)))))
     240          (gather)))
     241      (set! gather (make-collector))
     242
     243      (test '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
     244        (begin
     245          (%breset r
     246            (let ((k (%range r 1 4)))
     247              (%breset inner
     248                (let ((j (%range inner 10 k (* 10 k))))
     249                  (when (odd? k)
     250                    (%bshift r f #f))
     251                  (gather (list k j))))))
     252          (gather)))
     253      (set! gather (make-collector)) )
     254  )
     255
     256  (test-group "bshift/breset"
     257
     258    (let ((gather (make-collector)))
     259
     260      (define (fact n) (let loop ((n n)) (if (<= n 0) 1 (* n (loop (- n 1))))))
     261
     262      (test "step 1" '(1 2 6 24 120)
     263        (begin
     264          (breset r
     265            (gather (fact (range r 1 5))))
     266          (gather)))
     267      (set! gather (make-collector))
     268
     269      (test "step 2" '(1 6 120 5040 362880 39916800 6227020800)
     270        (begin
     271          (breset r
     272            (gather (fact (range r 1 2 14))))
     273          (gather)))
     274      (set! gather (make-collector))
     275
     276      (test "two ranges" '(101 111 121 102 112 122)
     277        (begin
     278          (breset r1
     279            (breset r2 (gather (+ (range r1 1 2) (range r2 100 10 120)))))
     280          (gather)))
     281      (set! gather (make-collector))
     282
     283      (test "collect" 120
    298284        (breset r1
    299           (breset r2 (gather (+ (range r1 1 2) (range r2 100 10 120)))))
    300         (gather)))
    301     (expect-set! gather (make-collector))
    302 
    303     (expect-eqv "collect" 120
    304       (breset r1
    305         (breset r2
    306           (bshift r1 f
    307             (let ([n (range r2 1 5)]
    308                   [nprev (f #f)])
    309               (* n (if (range-empty? nprev) 1 nprev)))))))
    310 
    311     (expect-equal "range-collect" '(120 120 60 20 5)
    312       (begin
    313         (breset r3
    314           (gather
    315             (breset r1
    316               (breset r2
    317                 (bshift r1 f
    318                   (let ([n (range r2 (range r3 1 5) 5)]
    319                         [nprev (f #f)])
    320                     (* n (if (range-empty? nprev) 1 nprev))))))))
    321         (gather)))
    322     (expect-set! gather (make-collector))
    323 
    324     (expect-equal '(11 14 17)
    325       (begin
    326         (breset r
    327           (let* ([k (range r 1 3 9)]
    328                 [j (+ 10 k)])
    329             (gather j)))
    330         (gather)))
    331     (expect-set! gather (make-collector))
    332 
    333     (expect-equal '(1 2 3)
    334       (begin
    335         (breset out
     285          (breset r2
     286            (bshift r1 f
     287              (let ((n (range r2 1 5))
     288                    (nprev (f #f)))
     289                (* n (if (range-empty? nprev) 1 nprev)))))))
     290
     291      (test "range-collect" '(120 120 60 20 5)
     292        (begin
     293          (breset r3
     294            (gather
     295              (breset r1
     296                (breset r2
     297                  (bshift r1 f
     298                    (let ((n (range r2 (range r3 1 5) 5))
     299                          (nprev (f #f)))
     300                      (* n (if (range-empty? nprev) 1 nprev))))))))
     301          (gather)))
     302      (set! gather (make-collector))
     303
     304      (test '(11 14 17)
     305        (begin
    336306          (breset r
    337             (let ([k (range r 1 4)])
    338               (gather k)
    339               (when (> k 2)
    340                 (bshift out f #f)))))
    341         (gather)))
    342     (expect-set! gather (make-collector))
    343 
    344     (expect-equal '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
    345       (begin
    346         (breset r
    347           (let ([k (range r 1 4)])
    348             (breset inner
    349               (let ([j (range inner 10 k (* 10 k))])
    350                 (when (odd? k)
    351                   (bshift r f #f))
    352                 (gather (list k j))))))
    353         (gather)))
    354     (expect-set! gather (make-collector))
    355   )
    356 
    357   (test/case "%bshift-values/%breset-values" (
    358       [gather (make-collector)]
    359       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    360     )
    361 
    362     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     307            (let* ((k (range r 1 3 9))
     308                  (j (+ 10 k)))
     309              (gather j)))
     310          (gather)))
     311      (set! gather (make-collector))
     312
     313      (test '(1 2 3)
     314        (begin
     315          (breset out
     316            (breset r
     317              (let ((k (range r 1 4)))
     318                (gather k)
     319                (when (> k 2)
     320                  (bshift out f #f)))))
     321          (gather)))
     322      (set! gather (make-collector))
     323
     324      (test '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
     325        (begin
     326          (breset r
     327            (let ((k (range r 1 4)))
     328              (breset inner
     329                (let ((j (range inner 10 k (* 10 k))))
     330                  (when (odd? k)
     331                    (bshift r f #f))
     332                  (gather (list k j))))))
     333          (gather)))
     334      (set! gather (make-collector)) )
     335  )
     336
     337  (test-group "%bshift-values/%breset-values"
     338
     339    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    363340      (cons 'a
    364341        (%breset-values r
    365342          (cons 'b
    366             (let-values ([(x y) (%bshift-values r f (cons 1 (f '2 (f 3 '()))))])
     343            (let-values (((x y) (%bshift-values r f (cons 1 (f '2 (f 3 '()))))))
    367344              (cons x y))))))
    368345  )
    369346
    370   (test/case "bshift-values/breset-values" (
    371       [gather (make-collector)]
    372       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    373     )
    374 
    375     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     347  (test-group "bshift-values/breset-values"
     348
     349    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    376350      (cons 'a
    377351        (breset-values r
    378352          (cons 'b
    379             (let-values ([(x y) (bshift-values r f (cons 1 (f '2 (f 3 '()))))])
     353            (let-values (((x y) (bshift-values r f (cons 1 (f '2 (f 3 '()))))))
    380354              (cons x y))))))
    381355  )
    382356
    383   (test/case "gshift/greset"
    384 
    385     (expect-eqv 117 (+ 10 (prompt (+ 2 (control k (+ 100 (k (k 3))))))))
    386 
    387     (expect-equal '() (prompt (let ((x (control f (cons 'a (f '()))))) (control g x))))
    388 
    389     (expect-eqv 2 (prompt ((lambda (x) (control l 2)) (control l (+ 1 (l 0))))))
    390 
    391     (expect-equal '(a) (prompt (control f (cons 'a (f '())))))
    392 
    393     (expect-equal '(a) (prompt (let ((x (control f (cons 'a (f '()))))) (control g (g x)))))
    394 
    395     (expect-eqv 117 (+ 10 (prompt0 (+ 2 (control k (+ 100 (k (k 3))))))))
    396 
    397     (expect-equal '() (prompt0 (prompt0 (let ((x (control f (cons 'a (f '()))))) (control g x)))))
    398 
    399     (expect-eqv 117 (+ 10 (prompt0 (+ 2 (shift0 k (+ 100 (k (k 3))))))))
    400 
    401     (expect-equal '() (prompt0 (cons 'a (prompt0 (shift0 f (shift0 g '()))))))
    402 
    403     (expect-equal '(a) (prompt0 (cons 'a (prompt0 (prompt0 (shift0 f (shift0 g '())))))))
    404   )
    405 
    406   (test/case "reflect/reify"
    407 
    408     (expect-equal 0.5
     357  (test-group "gshift/greset"
     358
     359    (test 117 (+ 10 (prompt (+ 2 (control k (+ 100 (k (k 3))))))))
     360
     361    (test '() (prompt (let ((x (control f (cons 'a (f '()))))) (control g x))))
     362
     363    (test 2 (prompt ((lambda (x) (control l 2)) (control l (+ 1 (l 0))))))
     364
     365    (test '(a) (prompt (control f (cons 'a (f '())))))
     366
     367    (test '(a) (prompt (let ((x (control f (cons 'a (f '()))))) (control g (g x)))))
     368
     369    (test 117 (+ 10 (prompt0 (+ 2 (control k (+ 100 (k (k 3))))))))
     370
     371    (test '() (prompt0 (prompt0 (let ((x (control f (cons 'a (f '()))))) (control g x)))))
     372
     373    (test 117 (+ 10 (prompt0 (+ 2 (shift0 k (+ 100 (k (k 3))))))))
     374
     375    (test '() (prompt0 (cons 'a (prompt0 (shift0 f (shift0 g '()))))))
     376
     377    (test '(a) (prompt0 (cons 'a (prompt0 (prompt0 (shift0 f (shift0 g '())))))))
     378  )
     379
     380  (test-group "reflect/reify"
     381
     382    (test 0.5
    409383      (reify maybe
    410384        (maybe-baz
     
    415389  )
    416390)
    417 
    418 (test::for-each (cut test::styler-set! <> test::output-style-human))
    419 (run-test "Shift Reset Tests")
    420 
    421 (test::forget!)
  • release/4/F-operator/trunk/F-operator.meta

    r15934 r15941  
    1010 (files
    1111  "tests"
     12  "F-operator.setup"
    1213  "range.scm"
    13   "F-operator.setup"
    1414  "reflect-reify.scm"
    15   "shift-reset.scm" "shift-reset-runtime.scm"
    16   "bshift-breset.scm" "bshift-breset-runtime.scm"
    17   "gshift-greset.scm" "gshift-greset-runtime.scm") )
     15  "shift-reset.scm"
     16  "bshift-breset.scm"
     17  "gshift-greset.scm") )
  • release/4/F-operator/trunk/F-operator.setup

    r15934 r15941  
    66
    77(setup-shared-extension-module 'shift-reset (extension-version "2.0.0")
    8   #:compile-options '(-fixnum
     8  #:compile-options '(-fixnum-arithmetic
    99                      -disable-interrupts
    1010                      -optimize-level 3
    1111                      -no-lambda-info -no-procedure-checks -no-argc-checks -no-bound-checks))
    1212
    13 (setup-shared-extension-module 'bbshift-reset (extension-version "2.0.0")
    14   #:compile-options '(-fixnum
     13(setup-shared-extension-module 'bshift-breset (extension-version "2.0.0")
     14  #:compile-options '(-fixnum-arithmetic
    1515                      -disable-interrupts
    1616                      -optimize-level 3
     
    1818
    1919(setup-shared-extension-module 'delimited-control (extension-version "2.0.0")
    20   #:compile-options '(-fixnum
     20  #:compile-options '(-fixnum-arithmetic
    2121                      -disable-interrupts
    2222                      -optimize-level 3
    2323                      -inline-limit 50
    2424                      -no-lambda-info -no-procedure-checks -no-argc-checks -no-bound-checks))
     25
     26(setup-shared-extension-module 'range (extension-version "2.0.0"))
     27
     28(setup-shared-extension-module 'reflect-reify (extension-version "2.0.0"))
     29
     30(setup-shared-extension-module 'gshift-greset (extension-version "2.0.0")
     31  #:compile-options '(-fixnum-arithmetic
     32                      -disable-interrupts
     33                      -optimize-level 3
     34                      -inline-limit 50
     35                      -no-lambda-info -no-procedure-checks -no-argc-checks -no-bound-checks))
     36
     37(install-extension-tag (extension-name) (extension-version "2.0.0"))
  • release/4/F-operator/trunk/bshift-breset.scm

    r15934 r15941  
    1111  (breset-values *breset-values) (bshift-values *bshift-values)
    1212  ;;
     13  *%breset *%bshift
     14  *breset *bshift
     15  *%breset-values *%bshift-values
     16  *breset-values *bshift-values
     17  ;;
    1318  $range-empty-tag)
    1419
     
    8590(define-syntax *%breturn
    8691        (syntax-rules ()
    87                 ((RC EXPR RC-SYM CALLER)
     92                ((_ RC EXPR RC-SYM CALLER)
    8893      (let ((val EXPR) (rc RC))
    8994        (if (not (*box-structure? rc)) (bad-dk CALLER RC-SYM)
     
    95100  (let/cdc rc-k
    96101    (let ((rc (make-box rc-k)))
    97       (*%breturn rc
    98         (proc rc)
    99         rc-sym '%breset))))
     102      (*%breturn rc (proc rc) rc-sym '%breset) ) ) )
    100103
    101104(define (*%bshift rc proc rc-sym)
     
    104107      (proc
    105108        (lambda (val)
    106           (if (*box-structure? rc)
    107             (let ((old-rc (*box-structure-ref rc)))
    108               (let ((s-val
    109                       (let/cdc rc-k
    110                         (*box-structure-set! rc rc-k)
    111                         (##sys#direct-return s-k val))))
    112                 (*box-structure-set! rc old-rc)
    113                 s-val))
    114             (bad-dk '%bshift rc-sym))))
    115       rc-sym '%bshift)))
     109          (if (not (*box-structure? rc)) (bad-dk '%bshift rc-sym)
     110              (let ((old-rc (*box-structure-ref rc)))
     111                (let ((s-val
     112                        (let/cdc rc-k
     113                          (*box-structure-set! rc rc-k)
     114                          (##sys#direct-return s-k val))))
     115                  (*box-structure-set! rc old-rc)
     116                  s-val)))))
     117      rc-sym '%bshift) ) )
    116118
    117119;;
     
    121123(define-syntax *breturn
    122124        (syntax-rules ()
    123                 ((RC EXPR RC-SYM CALLER)
     125                ((_ RC EXPR RC-SYM CALLER)
    124126      (let ((val EXPR) (rc RC))
    125127        (if (not (*box-structure? rc)) (bad-dk CALLER RC-SYM)
     
    131133  (let/cc rc-k
    132134    (let ((rc (make-box rc-k)))
    133       (*breturn rc
    134         (proc rc)
    135         rc-sym 'breset))))
     135      (*breturn rc (proc rc) rc-sym 'breset) ) ) )
    136136
    137137(define (*bshift rc proc rc-sym)
     
    140140      (proc
    141141        (lambda (val)
    142           (if (*box-structure? rc)
    143             (let ((old-rc (*box-structure-ref rc)))
    144               (let ((s-val
    145                       (let/cc rc-k
    146                         (*box-structure-set! rc rc-k)
    147                         (s-k val))))
    148                 (*box-structure-set! rc old-rc)
    149                 s-val))
    150             (bad-dk 'bshift rc-sym))))
    151       rc-sym 'bshift)))
     142          (if (not (*box-structure? rc)) (bad-dk 'bshift rc-sym)
     143              (let ((old-rc (*box-structure-ref rc)))
     144                (let ((s-val
     145                        (let/cc rc-k
     146                          (*box-structure-set! rc rc-k)
     147                          (s-k val))))
     148                  (*box-structure-set! rc old-rc)
     149                  s-val)))))
     150      rc-sym 'bshift) ) )
    152151
    153152;;
     
    157156(define-syntax *%breturn-values
    158157        (syntax-rules ()
    159                 ((RC EXPR RC-SYM CALLER)
     158                ((_ RC EXPR RC-SYM CALLER)
    160159      (let ((rc RC))
    161160        (call-with-values
     
    170169  (let/scc rc-k
    171170    (let ((rc (make-box rc-k)))
    172       (*%breturn-values rc
    173         (proc rc)
    174         rc-sym '%breset-values))))
     171      (*%breturn-values rc (proc rc) rc-sym '%breset-values) ) ) )
    175172
    176173(define (*%bshift-values rc proc rc-sym)
     
    179176      (proc
    180177        (lambda vals
    181           (if (*box-structure? rc)
    182             (let ((old-rc (*box-structure-ref rc)))
    183               (call-with-values
    184                 (lambda ()
    185                   (let/scc rc-k
    186                     (*box-structure-set! rc rc-k)
    187                     (apply s-k vals)))
    188                 (lambda s-vals
    189                   (*box-structure-set! rc old-rc)
    190                   (apply values s-vals))))
    191             (bad-dk '%bshift-values rc-sym))))
    192       rc-sym '%bshift-values)))
     178          (if (not (*box-structure? rc)) (bad-dk '%bshift-values rc-sym)
     179              (let ((old-rc (*box-structure-ref rc)))
     180                (call-with-values
     181                  (lambda ()
     182                    (let/scc rc-k
     183                      (*box-structure-set! rc rc-k)
     184                      (apply s-k vals)))
     185                  (lambda s-vals
     186                    (*box-structure-set! rc old-rc)
     187                    (apply values s-vals)))))))
     188      rc-sym '%bshift-values) ) )
    193189
    194190;;
     
    198194(define-syntax *breturn-values
    199195        (syntax-rules ()
    200                 ((RC EXPR RC-SYM CALLER)
     196                ((_ RC EXPR RC-SYM CALLER)
    201197      (let ((rc RC))
    202198        (call-with-values
     
    211207  (let/ccp rc-k
    212208    (let ((rc (make-box rc-k)))
    213       (*breturn-values rc
    214         (proc rc)
    215         rc-sym 'breset-values) ) ) )
     209      (*breturn-values rc (proc rc) rc-sym 'breset-values) ) ) )
    216210
    217211(define (*bshift-values rc proc rc-sym)
     
    220214      (proc
    221215        (lambda vals
    222           (if (*box-structure? rc)
    223             (let ((old-rc (*box-structure-ref rc)))
    224               (call-with-values
    225                 (lambda ()
    226                   (let/ccp rc-k
    227                     (*box-structure-set! rc rc-k)
    228                     (apply continuation-return s-k vals)))
    229                 (lambda s-vals
    230                   (*box-structure-set! rc old-rc)
    231                   (apply values s-vals))))
    232             (bad-dk 'bshift-values rc-sym))))
     216          (if (not (*box-structure? rc)) (bad-dk 'bshift-values rc-sym)
     217              (let ((old-rc (*box-structure-ref rc)))
     218                (call-with-values
     219                  (lambda ()
     220                    (let/ccp rc-k
     221                      (*box-structure-set! rc rc-k)
     222                      (apply continuation-return s-k vals)))
     223                  (lambda s-vals
     224                    (*box-structure-set! rc old-rc)
     225                    (apply values s-vals)))))))
    233226      rc-sym 'bshift-values) ) )
    234227
  • release/4/F-operator/trunk/delimited-control.scm

    r15934 r15941  
    55
    66(module delimited-control (;export
     7  ;;
    78  (prompt *prompt) (prompt0 *prompt)
    89  (reset *prompt) (reset0 *prompt)
     
    1011  (control0 *control)
    1112  (shift *control)
    12   (shift0 *control))
     13  (shift0 *control)
     14  ;;
     15  *prompt *control)
    1316
    1417  (import scheme chicken
  • release/4/F-operator/trunk/gshift-greset.scm

    r15934 r15941  
    44;;;; From Indiana University TR611 by Oleg Kiselyov
    55
    6 (eval-when (compile)
    7   (declare
    8     (usual-integrations)
    9     (inline)
    10     (fixnum)
    11     (export
    12       h-datatype? h-compose h-value
    13       hr-stop hs-stop
    14       hr-prop hs-prop) ) )
     6(module gshift-greset (;export
     7  ;;
     8  (greset h-value) (gshift h-compose)
     9  h-datatype? h-compose h-value
     10  hr-stop hs-stop
     11  hr-prop hs-prop
     12  ;;
     13  (reset *reset) (shift *shift))
    1514
    16 (use datatype shift-reset)
     15  (import scheme
     16          (except chicken reset)
     17          (only data-structures constantly)
     18          datatype
     19          shift-reset)
    1720
    18 ;; This has an interaction w/ the 'define' form, where the EXPR
    19 ;; is "protected" thru expansion & is the original literal, so
    20 ;; "undefined variable" results.
    21 #;
    22 (define-syntax (h-cases X)
    23   (syntax-case X ()
    24     ((sk EXPR (HCE HCV) (HVE HVV))
    25       #'(cases h-datatype EXPR
    26           (h-compose HCE HCV)
    27           (h-value (HVE) HVV))) ) )
     21  (require-library data-structures datatype shift-reset)
    2822
    29 (define-macro (h-cases EXPR H-PART HV-PART)
    30   `(cases h-datatype ,EXPR
    31      (h-compose ,(car H-PART) ,(cadr H-PART))
    32      (h-value ,(list (car HV-PART)) ,(cadr HV-PART)) ) )
     23(define-syntax h-cases
     24  (lambda (frm rnm cmp)
     25    (##sys#check-syntax 'h-cases frm '(_ _ (_ _) (_ _)))
     26    (let ((_cases (rnm 'cases)))
     27      (let ((expr (cadr frm))
     28            (h-part (caddr frm))
     29            (hv-part (cadddr frm)) )
     30       `(cases h-datatype ,expr
     31           (h-compose ,(car h-part) ,(cadr h-part))
     32           (h-value ,(list (car hv-part)) ,(cadr hv-part)) ) ) ) ) )
    3333
    3434(define-syntax greset
     
    3939  (syntax-rules ()
    4040    ((_ HS F E)
    41       (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E)))) ) ) )
     41      (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E))) ) ) )
    4242
    4343(define-datatype h-datatype h-datatype?
    4444  (h-value (v (constantly #t)))
    45   (h-compose (f procedure?) (x procedure?)))
     45  (h-compose (f procedure?) (x procedure?)) )
    4646
    4747(define (hr-stop expr)
    4848  (h-cases expr
    49     ((f x) (greset hr-stop (x f)))
    50     (v v)))
     49    ((f x) (greset hr-stop (x f)) )
     50    (v v ) ) )
    5151
    5252(define hs-stop hr-stop)
     
    5454(define (hr-prop expr)
    5555  (h-cases expr
    56     ((f x) (x f))
    57     (v v)))
     56    ((f x) (x f) )
     57    (v v ) ) )
    5858
    5959(define (hs-prop expr)
    6060  (h-cases expr
    6161    ((f x)
    62       (shift g
    63         (h-compose (lambda (y) (hs-prop (g (f y)))) x)))
    64     (v v)))
     62      (shift g (h-compose (lambda (y) (hs-prop (g (f y)))) x)) )
     63    (v v ) ) )
     64
     65) ;module gshift-greset
     66
  • release/4/F-operator/trunk/range.scm

    r15934 r15941  
    66(module range (;export
    77  ;;
    8   (range-empty? *range:empty*)
    9   (range *range:empty*)
    10   (%range *range:empty*)
     8  (range-empty? $range-empty-tag)
     9  (range $range-empty-tag)
     10  (%range $range-empty-tag)
    1111  ;;
    12   bshift
    13   %bshift)
     12  (%bshift *%bshift)
     13  (bshift *bshift))
    1414
    1515  (import scheme chicken bshift-breset)
     
    2727      (bshift RC shifter
    2828        (let loop ((state (FROM)))
    29           (if (TO? state) *range:empty*
     29          (if (TO? state) $range-empty-tag
    3030              (begin
    3131                (shifter (VALUE state))
     
    5757      (%bshift RC shifter
    5858        (do ((i FROM (+ i STEP)))
    59             ((> i TO) *range:empty*)
     59            ((> i TO) $range-empty-tag)
    6060          (shifter i))))
    6161    ;
  • release/4/F-operator/trunk/reflect-reify.scm

    r15934 r15941  
    22;;;; Kon Lovett, Oct 10 '06
    33
    4 (use shift-reset)
    5 
    64;; Monads from shift and reset (from Filinski, POPL '94)
    75
    8 (define-syntax (define-bind exp)
    9   (syntax-case exp ()
    10     ((sk kind body ...)
    11       (identifier? #'kind)
    12       (with-syntax (
    13           (monad (datum->syntax-object #'sk 'monad))
    14           (func (datum->syntax-object #'sk 'func))
    15           (bind
    16             (datum->syntax-object #'sk
    17               (string->symbol
    18                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    19         #'(define (bind monad func) body ...))) ) )
     6(module reflect-reify (;export
     7  ;;
     8  define-bind define-unit
     9  reflect reflect-values %reflect
     10  reify reify-values %reify
     11  ;;
     12  shift reset)
    2013
    21 (define-syntax (define-unit exp)
    22   (syntax-case exp ()
    23     ((sk kind body ...)
    24       (identifier? #'kind)
    25       (with-syntax (
    26           (obj (datum->syntax-object #'sk 'obj))
    27           (unit
    28             (datum->syntax-object #'sk
    29               (string->symbol
    30                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    31         #'(define (unit obj) body ...))) ) )
     14  (import scheme chicken shift-reset)
    3215
    33 (define-syntax (reflect exp)
    34   (syntax-case exp ()
    35     ((sk kind meaning)
    36       (identifier? #'kind)
    37       (with-syntax (
    38           (bind
    39             (datum->syntax-object #'sk
    40               (string->symbol
    41                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    42         #'(shift k (bind meaning k)))) ) )
     16  (require-library shift-reset)
    4317
    44 (define-syntax (reflect-values exp)
    45   (syntax-case exp ()
    46     ((sk kind meaning)
    47       (identifier? #'kind)
    48       (with-syntax (
    49           (bind
    50             (datum->syntax-object #'sk
    51               (string->symbol
    52                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    53         #'(shift-values k (bind meaning k)))) ) )
     18#; ;Doesn't work!
     19(define-for-syntax (check-identifier? loc obj)
     20  (unless (symbol? (strip-syntax obj))
     21    (syntax-error "bad argument type - not an identifier" obj)) )
    5422
    55 (define-syntax (%reflect exp)
    56   (syntax-case exp ()
    57     ((sk kind meaning)
    58       (identifier? #'kind)
    59       (with-syntax (
    60           (bind
    61             (datum->syntax-object #'sk
    62               (string->symbol
    63                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))))
    64         #'(%shift k (bind meaning k)))) ) )
     23(define-for-syntax (suffix-identifier id sym)
     24  (string->symbol (conc (strip-syntax id) #\- (strip-syntax sym))) )
    6525
    66 (define-syntax (reify exp)
    67   (syntax-case exp ()
    68     ((sk kind exp)
    69       (identifier? #'kind)
    70       (with-syntax (
    71           (unit
    72             (datum->syntax-object #'sk
    73               (string->symbol
    74                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    75         #'(reset (unit exp)))) ) )
     26(define-for-syntax (bind-identifier id) (suffix-identifier id 'bind))
    7627
    77 (define-syntax (reify-values exp)
    78   (syntax-case exp ()
    79     ((sk kind exp)
    80       (identifier? #'kind)
    81       (with-syntax (
    82           (unit
    83             (datum->syntax-object #'sk
    84               (string->symbol
    85                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    86         #'(reset-values (unit exp)))) ) )
     28(define-for-syntax (unit-identifier id) (suffix-identifier id 'unit))
    8729
    88 (define-syntax (%reify exp)
    89   (syntax-case exp ()
    90     ((sk kind exp)
    91       (identifier? #'kind)
    92       (with-syntax (
    93           (unit
    94             (datum->syntax-object #'sk
    95               (string->symbol
    96                 (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))))
    97         #'(%reset (unit exp)))) ) ) )
     30(define-syntax define-bind
     31  (lambda (frm rnm cmp)
     32    (##sys#check-syntax 'define-bind frm '(_ symbol _ . _))
     33    (let ((_define (rnm 'define)))
     34      (let ((kind (cadr frm))
     35            (body (cddr frm)) )
     36        `(,_define (,(bind-identifier kind) monad func) ,@body) ) ) ) )
     37
     38(define-syntax define-unit
     39  (lambda (frm rnm cmp)
     40    (##sys#check-syntax 'define-unit frm '(_ symbol _ . _))
     41    (let ((_define (rnm 'define)))
     42      (let ((kind (cadr frm))
     43            (body (cddr frm)) )
     44        `(,_define (,(unit-identifier kind) obj) ,@body) ) ) ) )
     45
     46(define-syntax reflect
     47  (lambda (frm rnm cmp)
     48    (##sys#check-syntax 'reflect frm '(_ symbol _))
     49    (let ((_shift (rnm 'shift)))
     50      (let ((kind (cadr frm))
     51            (meaning (caddr frm)) )
     52        `(,_shift k (,(bind-identifier kind) ,meaning k)) ) ) ) )
     53
     54(define-syntax reflect-values
     55  (lambda (frm rnm cmp)
     56    (##sys#check-syntax 'reflect-values frm '(_ symbol _))
     57    (let ((_shift-values (rnm 'shift-values)))
     58      (let ((kind (cadr frm))
     59            (meaning (caddr frm)) )
     60        `(,_shift-values k (,(bind-identifier kind) ,meaning k)) ) ) ) )
     61
     62(define-syntax %reflect
     63  (lambda (frm rnm cmp)
     64    (##sys#check-syntax '%reflect frm '(_ symbol _))
     65    (let ((_%shift (rnm '%shift)))
     66      (let ((kind (cadr frm))
     67            (meaning (caddr frm)) )
     68        `(,_%shift k (,(bind-identifier kind) ,meaning k)) ) ) ) )
     69
     70(define-syntax reify
     71  (lambda (frm rnm cmp)
     72    (##sys#check-syntax 'reify frm '(_ symbol _))
     73    (let ((_reset (rnm 'reset)))
     74      (let ((kind (cadr frm))
     75            (expr (caddr frm)) )
     76        `(,_reset (,(unit-identifier kind) ,expr)) ) ) ) )
     77
     78(define-syntax reify-values
     79  (lambda (frm rnm cmp)
     80    (##sys#check-syntax 'reify-values frm '(_ symbol _))
     81    (let ((_reset-values (rnm 'reset-values)))
     82      (let ((kind (cadr frm))
     83            (expr (caddr frm)) )
     84        `(,_reset-values (,(unit-identifier kind) ,expr)) ) ) ) )
     85
     86(define-syntax %reify
     87  (lambda (frm rnm cmp)
     88    (##sys#check-syntax '%reify frm '(_ symbol _))
     89    (let ((_%reset (rnm '%reset)))
     90      (let ((kind (cadr frm))
     91            (expr (caddr frm)) )
     92        `(,_%reset (,(unit-identifier kind) ,expr)) ) ) ) )
     93
     94) ;module reflect-reify
  • release/4/F-operator/trunk/shift-reset.scm

    r15934 r15941  
    55
    66(module shift-reset (;export
     7  ;;
    78  (%reset *%reset) (%shift *%shift)
    89  (reset *reset) (shift *shift)
    910  (%reset-values *%reset-values) (%shift-values *%shift-values)
    10   (reset-values *reset-values) (shift-values *shift-values))
     11  (reset-values *reset-values) (shift-values *shift-values)
     12  ;;
     13  *%reset *%shift
     14  *reset *shift
     15  *%reset-values *%shift-values
     16  *reset-values *shift-values)
    1117
    12   (import scheme chicken
     18  (import scheme
     19          (except chicken reset)
    1320          (only miscmacros let/cc))
    1421
    1522  (require-library miscmacros)
     23
     24  (declare
     25                (always-bound
     26                        *meta-dk*
     27                        *meta-k*
     28                        *meta-dkv*
     29                        *meta-kv*))
    1630
    1731(define-syntax %reset
     
    115129(define (*shift proc)
    116130  (let/cc k
    117     (*return
    118       (proc
    119         (lambda (val)
    120           (*reset
    121             (lambda ()
    122               (k val)))))) ) )
     131    (*return (proc (lambda (val) (*reset (lambda () (k val)))))) ) )
    123132
    124133;;
     
    148157(define (*%shift-values proc)
    149158  (let/scc k
    150     (*%return-values
    151       (proc
    152         (lambda vals
    153           (*%reset-values
    154             (lambda ()
    155               (apply k vals)))))) ) )
     159    (*%return-values (proc (lambda vals (*%reset-values (lambda () (apply k vals)))))) ) )
    156160
    157161;;
     
    184188  (let/ccp k
    185189    (*return-values
    186       (proc
    187         (lambda vals
    188           (*reset-values
    189             (lambda ()
    190               (apply continuation-return k vals)))))
     190      (proc (lambda vals (*reset-values (lambda () (apply continuation-return k vals)))))
    191191      'shift-values) ) )
    192192
  • release/4/F-operator/trunk/tests/run.scm

    r15934 r15941  
    22;;;; Kon Lovett, Apr 6 '06
    33
    4 (use testbase testbase-output-human)
     4(use test)
    55(use shift-reset bshift-breset gshift-greset reflect-reify range)
    66(use srfi-1)
     
    99
    1010(define (make-collector)
    11   (let ([lst '()])
     11  (let ((lst '()))
    1212    (lambda v
    13       (if (null? v)
    14         (reverse! lst)
     13      (if (null? v) (reverse! lst)
    1514        (begin
    1615          (set-cdr! v lst)
     
    2423
    2524(define (maybe-foo x)
    26   (if (zero? x)
    27     (reflect maybe #f)  ; exception
    28     (/ 1 x) ) )
     25  (if (zero? x) (reflect maybe #f)  ; exception
     26      (/ 1 x) ) )
    2927
    3028(define (maybe-bar x)
     
    3230
    3331(define (maybe-baz x)
    34   (if (zero? x)
    35     (reflect maybe #f)
    36     (/ 1 x) ) )
    37 
    38 (cond-expand
    39   [hygienic-macros
    40 
    41     ;; Generalized shift/reset implementations of some control operators
    42 
    43     (define-syntax prompt
    44       (syntax-rules ()
    45         [(_ e) (greset hr-stop e)] ) )
    46 
    47     (define-syntax control
    48       (syntax-rules ()
    49         [(_ f e) (gshift hs-prop f e)] ) )
    50 
    51     (define-syntax prompt0
    52       (syntax-rules ()
    53         [(_ e) (greset hr-prop e)] ) )
    54 
    55     (define-syntax shift0
    56       (syntax-rules ()
    57         [(_ f e) (gshift hs-stop f e)] ) ) ]
    58 
    59   [else
    60 
    61     ;; Generalized shift/reset implementations of some control operators
    62 
    63     (define-macro (prompt E)
    64       `(greset hr-stop ,E) )
    65 
    66     (define-macro (control F E)
    67       `(gshift hs-prop ,F ,E) )
    68 
    69     (define-macro (prompt0 E)
    70       `(greset hr-prop ,E) )
    71 
    72     (define-macro (shift0 F E)
    73       `(gshift hs-stop ,F ,E) ) ] )
     32  (if (zero? x) (reflect maybe #f)
     33      (/ 1 x) ) )
     34
     35;; Generalized shift/reset implementations of some control operators
     36
     37(define-syntax prompt
     38  (syntax-rules ()
     39    ((_ e) (greset hr-stop e)) ) )
     40
     41(define-syntax control
     42  (syntax-rules ()
     43    ((_ f e) (gshift hs-prop f e)) ) )
     44
     45(define-syntax prompt0
     46  (syntax-rules ()
     47    ((_ e) (greset hr-prop e)) ) )
     48
     49(define-syntax shift0
     50  (syntax-rules ()
     51    ((_ f e) (gshift hs-stop f e)) ) )
    7452
    7553;;;
    7654
    77 (define-test shift-reset-test "Shift/Reset Family"
    78 
    79   (test/case "%shift/%reset"
    80 
    81     (expect-eqv 5
     55(test-group "Shift/Reset Family"
     56
     57  (test-group "%shift/%reset"
     58
     59    (test 5
    8260      (+ 1 (%reset (* 2 (%shift k 4)))))
    8361
    84     (expect-eqv 117
     62    (test 117
    8563      (+ 10 (%reset (+ 2 (%shift k (+ 100 (k (k 3))))))))
    8664
    87     (expect-eqv 60
     65    (test 60
    8866      (* 10 (%reset (* 2 (%shift g (%reset (* 5 (%shift f (+ (f 1) 1)))))))))
    8967
    90     (expect-eqv 121
    91       (let ([f (lambda (x) (%shift k (k (k x))))])
     68    (test 121
     69      (let ((f (lambda (x) (%shift k (k (k x))))))
    9270        (+ 1 (%reset (+ 10 (f 100))))))
    9371
    94     (expect-equal '(a)
     72    (test '(a)
    9573      (%reset
    96         (let ([x (%shift f (cons 'a (f '())))])
     74        (let ((x (%shift f (cons 'a (f '())))))
    9775          (%shift g x))))
    9876
    99     (expect-equal '(a 1 b b c) ; not '(a b 1 b b c)
     77    (test '(a 1 b b c) ; not '(a b 1 b b c)
    10078      (cons 'a (%reset (cons 'b (%shift f (cons 1 (f (f (cons 'c '())))))))))
    10179
    102     (expect-failure (%shift t 'x))
    103   )
    104 
    105   (test/case "shift/reset"
    106 
    107     (expect-eqv 5
     80    (test-error (%shift t 'x))
     81  )
     82
     83  (test-group "shift/reset"
     84
     85    (test 5
    10886      (+ 1 (reset (* 2 (shift k 4)))))
    10987
    110     (expect-eqv 117
     88    (test 117
    11189      (+ 10 (reset (+ 2 (shift k (+ 100 (k (k 3))))))))
    11290
    113     (expect-eqv 60
     91    (test 60
    11492      (* 10 (reset (* 2 (shift g (reset (* 5 (shift f (+ (f 1) 1)))))))))
    11593
    116     (expect-eqv 121
    117       (let ([f (lambda (x) (shift k (k (k x))))])
     94    (test 121
     95      (let ((f (lambda (x) (shift k (k (k x))))))
    11896        (+ 1 (reset (+ 10 (f 100))))))
    11997
    120     (expect-equal '(a)
     98    (test '(a)
    12199      (reset
    122         (let ([x (shift f (cons 'a (f '())))])
     100        (let ((x (shift f (cons 'a (f '())))))
    123101          (shift g x))))
    124102
    125     (expect-equal '(a 1 b b c) ; not '(a b 1 b b c)
     103    (test '(a 1 b b c) ; not '(a b 1 b b c)
    126104      (cons 'a (reset (cons 'b (shift f (cons 1 (f (f (cons 'c '())))))))))
    127105
    128     (expect-failure (shift t 'x))
    129   )
    130 
    131   (test/case "%shift-values/%reset-values"
    132 
    133     (expect-eqv 5
     106    (test-error (shift t 'x))
     107  )
     108
     109  (test-group "%shift-values/%reset-values"
     110
     111    (test 5
    134112      (+ 1 (%reset-values (* 2 (%shift-values k 4)))))
    135113
    136     (expect-eqv 117
     114    (test 117
    137115      (+ 10 (%reset-values (+ 2 (%shift-values k (+ 100 (k (k 3))))))))
    138116
    139     (expect-eqv 60
     117    (test 60
    140118      (* 10 (%reset-values (* 2 (%shift-values g (%reset-values (* 5 (%shift-values f (+ (f 1) 1)))))))))
    141119
    142     (expect-eqv 121
    143       (let ([f (lambda (x) (%shift-values k (k (k x))))])
     120    (test 121
     121      (let ((f (lambda (x) (%shift-values k (k (k x))))))
    144122        (+ 1 (%reset-values (+ 10 (f 100))))))
    145123
    146     (expect-equal '(a)
     124    (test '(a)
    147125      (%reset-values
    148         (let ([x (%shift-values f (cons 'a (f '())))])
     126        (let ((x (%shift-values f (cons 'a (f '())))))
    149127          (%shift-values g x))))
    150128
    151     (expect-equal '(a 1 b b c)
     129    (test '(a 1 b b c)
    152130      (cons 'a (%reset-values (cons 'b (%shift-values f (cons 1 (f (f (cons 'c '())))))))))
    153131
    154     (expect-failure (%shift-values t 'x))
    155 
    156     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     132    (test-error (%shift-values t 'x))
     133
     134    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    157135      (cons 'a
    158136        (%reset-values
    159137          (cons 'b
    160             (let-values ([(x y) (%shift-values f (cons 1 (f '2 (f 3 '()))))])
     138            (let-values (((x y) (%shift-values f (cons 1 (f '2 (f 3 '()))))))
    161139              (cons x y))))))
    162140  )
    163141
    164   (test/case "shift-values/reset-values"
    165 
    166     (expect-eqv 5
     142  (test-group "shift-values/reset-values"
     143
     144    (test 5
    167145      (+ 1 (reset-values (* 2 (shift-values k 4)))))
    168146
    169     (expect-eqv 117
     147    (test 117
    170148      (+ 10 (reset-values (+ 2 (shift-values k (+ 100 (k (k 3))))))))
    171149
    172     (expect-eqv 60
     150    (test 60
    173151      (* 10 (reset-values (* 2 (shift-values g (reset-values (* 5 (shift-values f (+ (f 1) 1)))))))))
    174152
    175     (expect-eqv 121
    176       (let ([f (lambda (x) (shift-values k (k (k x))))])
     153    (test 121
     154      (let ((f (lambda (x) (shift-values k (k (k x))))))
    177155        (+ 1 (reset-values (+ 10 (f 100))))))
    178156
    179     (expect-equal '(a)
     157    (test '(a)
    180158      (reset-values
    181         (let ([x (shift-values f (cons 'a (f '())))])
     159        (let ((x (shift-values f (cons 'a (f '())))))
    182160          (shift-values g x))))
    183161
    184     (expect-equal '(a 1 b b c)
     162    (test '(a 1 b b c)
    185163      (cons 'a (reset-values (cons 'b (shift-values f (cons 1 (f (f (cons 'c '())))))))))
    186164
    187     (expect-failure (shift-values t 'x))
    188 
    189     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     165    (test-error (shift-values t 'x))
     166
     167    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    190168      (cons 'a
    191169        (reset-values
    192170          (cons 'b
    193             (let-values ([(x y) (shift-values f (cons 1 (f '2 (f 3 '()))))])
     171            (let-values (((x y) (shift-values f (cons 1 (f '2 (f 3 '()))))))
    194172              (cons x y))))))
    195173  )
    196174
    197   (test/case "%bshift/%breset" (
    198       [gather (make-collector)]
    199       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    200     )
    201 
    202     (expect-equal "step 1" '(1 2 6 24 120)
    203       (begin
    204         (%breset r
    205           (gather (fact (%range r 1 5))))
    206         (gather)))
    207     (expect-set! gather (make-collector))
    208 
    209     (expect-equal "step 2" '(1 6 120 5040 362880 39916800 6227020800)
    210       (begin
    211         (%breset r
    212           (gather (fact (%range r 1 2 14))))
    213         (gather)))
    214     (expect-set! gather (make-collector))
    215 
    216     (expect-equal "two %ranges" '(101 111 121 102 112 122)
    217       (begin
     175  (test-group "%bshift/%breset"
     176
     177    (let ((gather (make-collector)))
     178
     179      (define (fact n) (let loop ((n n)) (if (<= n 0) 1 (* n (loop (- n 1))))))
     180
     181      (test "step 1" '(1 2 6 24 120)
     182        (begin
     183          (%breset r
     184            (gather (fact (%range r 1 5))))
     185          (gather)))
     186      (set! gather (make-collector))
     187
     188      (test "step 2" '(1 6 120 5040 362880 39916800 6227020800)
     189        (begin
     190          (%breset r
     191            (gather (fact (%range r 1 2 14))))
     192          (gather)))
     193      (set! gather (make-collector))
     194
     195      (test "two %ranges" '(101 111 121 102 112 122)
     196        (begin
     197          (%breset r1
     198            (%breset r2 (gather (+ (%range r1 1 2) (%range r2 100 10 120)))))
     199          (gather)))
     200      (set! gather (make-collector))
     201
     202      (test "collect" 120
    218203        (%breset r1
    219           (%breset r2 (gather (+ (%range r1 1 2) (%range r2 100 10 120)))))
    220         (gather)))
    221     (expect-set! gather (make-collector))
    222 
    223     (expect-eqv "collect" 120
    224       (%breset r1
    225         (%breset r2
    226           (%bshift r1 f
    227             (let ([n (%range r2 1 5)]
    228                   [nprev (f #f)])
    229               (* n (if (range-empty? nprev) 1 nprev)))))))
    230 
    231     (expect-equal "%range-collect" '(120 120 60 20 5)
    232       (begin
    233         (%breset r3
    234           (gather
    235             (%breset r1
    236               (%breset r2
    237                 (%bshift r1 f
    238                   (let ([n (%range r2 (%range r3 1 5) 5)]
    239                         [nprev (f #f)])
    240                     (* n (if (range-empty? nprev) 1 nprev))))))))
    241         (gather)))
    242     (expect-set! gather (make-collector))
    243 
    244     (expect-equal '(11 14 17)
    245       (begin
    246         (%breset r
    247           (let* ([k (%range r 1 3 9)]
    248                 [j (+ 10 k)])
    249             (gather j)))
    250         (gather)))
    251     (expect-set! gather (make-collector))
    252 
    253     (expect-equal '(1 2 3)
    254       (begin
    255         (%breset out
     204          (%breset r2
     205            (%bshift r1 f
     206              (let ((n (%range r2 1 5))
     207                    (nprev (f #f)))
     208                (* n (if (range-empty? nprev) 1 nprev)))))))
     209
     210      (test "%range-collect" '(120 120 60 20 5)
     211        (begin
     212          (%breset r3
     213            (gather
     214              (%breset r1
     215                (%breset r2
     216                  (%bshift r1 f
     217                    (let ((n (%range r2 (%range r3 1 5) 5))
     218                          (nprev (f #f)))
     219                      (* n (if (range-empty? nprev) 1 nprev))))))))
     220          (gather)))
     221      (set! gather (make-collector))
     222
     223      (test '(11 14 17)
     224        (begin
    256225          (%breset r
    257             (let ([k (%range r 1 4)])
    258               (gather k)
    259               (when (> k 2)
    260                 (%bshift out f #f)))))
    261         (gather)))
    262     (expect-set! gather (make-collector))
    263 
    264     (expect-equal '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
    265       (begin
    266         (%breset r
    267           (let ([k (%range r 1 4)])
    268             (%breset inner
    269               (let ([j (%range inner 10 k (* 10 k))])
    270                 (when (odd? k)
    271                   (%bshift r f #f))
    272                 (gather (list k j))))))
    273         (gather)))
    274     (expect-set! gather (make-collector))
    275   )
    276 
    277   (test/case "bshift/breset" (
    278       [gather (make-collector)]
    279       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    280     )
    281 
    282     (expect-equal "step 1" '(1 2 6 24 120)
    283       (begin
    284         (breset r
    285           (gather (fact (range r 1 5))))
    286         (gather)))
    287     (expect-set! gather (make-collector))
    288 
    289     (expect-equal "step 2" '(1 6 120 5040 362880 39916800 6227020800)
    290       (begin
    291         (breset r
    292           (gather (fact (range r 1 2 14))))
    293         (gather)))
    294     (expect-set! gather (make-collector))
    295 
    296     (expect-equal "two ranges" '(101 111 121 102 112 122)
    297       (begin
     226            (let* ((k (%range r 1 3 9))
     227                  (j (+ 10 k)))
     228              (gather j)))
     229          (gather)))
     230      (set! gather (make-collector))
     231
     232      (test '(1 2 3)
     233        (begin
     234          (%breset out
     235            (%breset r
     236              (let ((k (%range r 1 4)))
     237                (gather k)
     238                (when (> k 2)
     239                  (%bshift out f #f)))))
     240          (gather)))
     241      (set! gather (make-collector))
     242
     243      (test '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
     244        (begin
     245          (%breset r
     246            (let ((k (%range r 1 4)))
     247              (%breset inner
     248                (let ((j (%range inner 10 k (* 10 k))))
     249                  (when (odd? k)
     250                    (%bshift r f #f))
     251                  (gather (list k j))))))
     252          (gather)))
     253      (set! gather (make-collector)) )
     254  )
     255
     256  (test-group "bshift/breset"
     257
     258    (let ((gather (make-collector)))
     259
     260      (define (fact n) (let loop ((n n)) (if (<= n 0) 1 (* n (loop (- n 1))))))
     261
     262      (test "step 1" '(1 2 6 24 120)
     263        (begin
     264          (breset r
     265            (gather (fact (range r 1 5))))
     266          (gather)))
     267      (set! gather (make-collector))
     268
     269      (test "step 2" '(1 6 120 5040 362880 39916800 6227020800)
     270        (begin
     271          (breset r
     272            (gather (fact (range r 1 2 14))))
     273          (gather)))
     274      (set! gather (make-collector))
     275
     276      (test "two ranges" '(101 111 121 102 112 122)
     277        (begin
     278          (breset r1
     279            (breset r2 (gather (+ (range r1 1 2) (range r2 100 10 120)))))
     280          (gather)))
     281      (set! gather (make-collector))
     282
     283      (test "collect" 120
    298284        (breset r1
    299           (breset r2 (gather (+ (range r1 1 2) (range r2 100 10 120)))))
    300         (gather)))
    301     (expect-set! gather (make-collector))
    302 
    303     (expect-eqv "collect" 120
    304       (breset r1
    305         (breset r2
    306           (bshift r1 f
    307             (let ([n (range r2 1 5)]
    308                   [nprev (f #f)])
    309               (* n (if (range-empty? nprev) 1 nprev)))))))
    310 
    311     (expect-equal "range-collect" '(120 120 60 20 5)
    312       (begin
    313         (breset r3
    314           (gather
    315             (breset r1
    316               (breset r2
    317                 (bshift r1 f
    318                   (let ([n (range r2 (range r3 1 5) 5)]
    319                         [nprev (f #f)])
    320                     (* n (if (range-empty? nprev) 1 nprev))))))))
    321         (gather)))
    322     (expect-set! gather (make-collector))
    323 
    324     (expect-equal '(11 14 17)
    325       (begin
    326         (breset r
    327           (let* ([k (range r 1 3 9)]
    328                 [j (+ 10 k)])
    329             (gather j)))
    330         (gather)))
    331     (expect-set! gather (make-collector))
    332 
    333     (expect-equal '(1 2 3)
    334       (begin
    335         (breset out
     285          (breset r2
     286            (bshift r1 f
     287              (let ((n (range r2 1 5))
     288                    (nprev (f #f)))
     289                (* n (if (range-empty? nprev) 1 nprev)))))))
     290
     291      (test "range-collect" '(120 120 60 20 5)
     292        (begin
     293          (breset r3
     294            (gather
     295              (breset r1
     296                (breset r2
     297                  (bshift r1 f
     298                    (let ((n (range r2 (range r3 1 5) 5))
     299                          (nprev (f #f)))
     300                      (* n (if (range-empty? nprev) 1 nprev))))))))
     301          (gather)))
     302      (set! gather (make-collector))
     303
     304      (test '(11 14 17)
     305        (begin
    336306          (breset r
    337             (let ([k (range r 1 4)])
    338               (gather k)
    339               (when (> k 2)
    340                 (bshift out f #f)))))
    341         (gather)))
    342     (expect-set! gather (make-collector))
    343 
    344     (expect-equal '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
    345       (begin
    346         (breset r
    347           (let ([k (range r 1 4)])
    348             (breset inner
    349               (let ([j (range inner 10 k (* 10 k))])
    350                 (when (odd? k)
    351                   (bshift r f #f))
    352                 (gather (list k j))))))
    353         (gather)))
    354     (expect-set! gather (make-collector))
    355   )
    356 
    357   (test/case "%bshift-values/%breset-values" (
    358       [gather (make-collector)]
    359       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    360     )
    361 
    362     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     307            (let* ((k (range r 1 3 9))
     308                  (j (+ 10 k)))
     309              (gather j)))
     310          (gather)))
     311      (set! gather (make-collector))
     312
     313      (test '(1 2 3)
     314        (begin
     315          (breset out
     316            (breset r
     317              (let ((k (range r 1 4)))
     318                (gather k)
     319                (when (> k 2)
     320                  (bshift out f #f)))))
     321          (gather)))
     322      (set! gather (make-collector))
     323
     324      (test '((2 10) (2 12) (2 14) (2 16) (2 18) (2 20) (4 10) (4 14) (4 18) (4 22) (4 26) (4 30) (4 34) (4 38))
     325        (begin
     326          (breset r
     327            (let ((k (range r 1 4)))
     328              (breset inner
     329                (let ((j (range inner 10 k (* 10 k))))
     330                  (when (odd? k)
     331                    (bshift r f #f))
     332                  (gather (list k j))))))
     333          (gather)))
     334      (set! gather (make-collector)) )
     335  )
     336
     337  (test-group "%bshift-values/%breset-values"
     338
     339    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    363340      (cons 'a
    364341        (%breset-values r
    365342          (cons 'b
    366             (let-values ([(x y) (%bshift-values r f (cons 1 (f '2 (f 3 '()))))])
     343            (let-values (((x y) (%bshift-values r f (cons 1 (f '2 (f 3 '()))))))
    367344              (cons x y))))))
    368345  )
    369346
    370   (test/case "bshift-values/breset-values" (
    371       [gather (make-collector)]
    372       [fact (lambda (n) (let loop ([n n]) (if (<= n 0) 1 (* n (loop (- n 1))))))]
    373     )
    374 
    375     (expect-equal '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
     347  (test-group "bshift-values/breset-values"
     348
     349    (test '(a 1 b 2 b 3) ; not '(a b 1 b 2 b 3)
    376350      (cons 'a
    377351        (breset-values r
    378352          (cons 'b
    379             (let-values ([(x y) (bshift-values r f (cons 1 (f '2 (f 3 '()))))])
     353            (let-values (((x y) (bshift-values r f (cons 1 (f '2 (f 3 '()))))))
    380354              (cons x y))))))
    381355  )
    382356
    383   (test/case "gshift/greset"
    384 
    385     (expect-eqv 117 (+ 10 (prompt (+ 2 (control k (+ 100 (k (k 3))))))))
    386 
    387     (expect-equal '() (prompt (let ((x (control f (cons 'a (f '()))))) (control g x))))
    388 
    389     (expect-eqv 2 (prompt ((lambda (x) (control l 2)) (control l (+ 1 (l 0))))))
    390 
    391     (expect-equal '(a) (prompt (control f (cons 'a (f '())))))
    392 
    393     (expect-equal '(a) (prompt (let ((x (control f (cons 'a (f '()))))) (control g (g x)))))
    394 
    395     (expect-eqv 117 (+ 10 (prompt0 (+ 2 (control k (+ 100 (k (k 3))))))))
    396 
    397     (expect-equal '() (prompt0 (prompt0 (let ((x (control f (cons 'a (f '()))))) (control g x)))))
    398 
    399     (expect-eqv 117 (+ 10 (prompt0 (+ 2 (shift0 k (+ 100 (k (k 3))))))))
    400 
    401     (expect-equal '() (prompt0 (cons 'a (prompt0 (shift0 f (shift0 g '()))))))
    402 
    403     (expect-equal '(a) (prompt0 (cons 'a (prompt0 (prompt0 (shift0 f (shift0 g '())))))))
    404   )
    405 
    406   (test/case "reflect/reify"
    407 
    408     (expect-equal 0.5
     357  (test-group "gshift/greset"
     358
     359    (test 117 (+ 10 (prompt (+ 2 (control k (+ 100 (k (k 3))))))))
     360
     361    (test '() (prompt (let ((x (control f (cons 'a (f '()))))) (control g x))))
     362
     363    (test 2 (prompt ((lambda (x) (control l 2)) (control l (+ 1 (l 0))))))
     364
     365    (test '(a) (prompt (control f (cons 'a (f '())))))
     366
     367    (test '(a) (prompt (let ((x (control f (cons 'a (f '()))))) (control g (g x)))))
     368
     369    (test 117 (+ 10 (prompt0 (+ 2 (control k (+ 100 (k (k 3))))))))
     370
     371    (test '() (prompt0 (prompt0 (let ((x (control f (cons 'a (f '()))))) (control g x)))))
     372
     373    (test 117 (+ 10 (prompt0 (+ 2 (shift0 k (+ 100 (k (k 3))))))))
     374
     375    (test '() (prompt0 (cons 'a (prompt0 (shift0 f (shift0 g '()))))))
     376
     377    (test '(a) (prompt0 (cons 'a (prompt0 (prompt0 (shift0 f (shift0 g '())))))))
     378  )
     379
     380  (test-group "reflect/reify"
     381
     382    (test 0.5
    409383      (reify maybe
    410384        (maybe-baz
     
    415389  )
    416390)
    417 
    418 (test::for-each (cut test::styler-set! <> test::output-style-human))
    419 (run-test "Shift Reset Tests")
    420 
    421 (test::forget!)
Note: See TracChangeset for help on using the changeset viewer.