source: project/release/3/F-operator/gshift-greset.scm @ 8904

Last change on this file since 8904 was 8904, checked in by Kon Lovett, 12 years ago

Save.

File size: 1.4 KB
Line 
1;;;; gshift-greset.scm
2;;;; Kon Lovett, Apr 6 '06
3
4;;;; From Indiana University TR611 by Oleg Kiselyov
5
6(use datatype shift-reset)
7
8(cond-expand
9  [hygienic-macros
10
11    ;; This has an interaction w/ the 'define' form, where the EXPR
12    ;; is "protected" thru expansion & is the original literal, so
13    ;; "undefined variable" results.
14    #;
15    (define-syntax (h-cases X)
16      (syntax-case X ()
17        [(sk EXPR (HCE HCV) (HVE HVV))
18          #'(cases h-datatype EXPR
19              [h-compose HCE HCV]
20              [h-value (HVE) HVV])] ) )
21
22    (define-macro (h-cases EXPR H-PART HV-PART)
23      `(cases h-datatype ,EXPR
24         [h-compose ,(car H-PART) ,(cadr H-PART)]
25         [h-value ,(list (car HV-PART)) ,(cadr HV-PART)] ) )
26
27    (define-syntax greset
28      (syntax-rules ()
29        [(_ HR E) (HR (reset (h-value E)))] ) )
30
31    (define-syntax gshift
32      (syntax-rules ()
33        [(_ HS F E)
34          (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E)))] ) ) ]
35
36  [else
37
38    (define-macro (h-cases EXPR H-PART HV-PART)
39      `(cases h-datatype ,EXPR
40         [h-compose ,(car H-PART) ,(cadr H-PART)]
41         [h-value ,(list (car HV-PART)) ,(cadr HV-PART)]))
42
43    (define-macro (greset HR E)
44      `(,HR (reset (h-value ,E))) )
45
46    (define-macro (gshift HS F E)
47      (let ([X-VAR (gensym)]
48            [F*-VAR (gensym)])
49        `(shift ,F*-VAR (h-compose (lambda (,X-VAR) (,HS (,F*-VAR ,X-VAR))) (lambda (,F) ,E))) ) ) ] )
Note: See TracBrowser for help on using the repository browser.