source: project/F-operator/gshift-greset.scm @ 2773

Last change on this file since 2773 was 2773, checked in by Kon Lovett, 14 years ago

Added nounwind -values routines.

File size: 1.3 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 [hygienic-macros
9
10(define-macro (h-cases EXPR H-PART HV-PART)
11  `(cases h-datatype ,EXPR
12    [h-compose ,(car H-PART) ,(cadr H-PART)]
13    [h-value ,(list (car HV-PART)) ,(cadr HV-PART)]))
14
15;; This has an interaction w/ the 'define' form, where the EXPR
16;; is "protected" thru expansion & is the original literal, so
17;; "undefined variable" results.
18#;(define-syntax (h-cases X)
19  (syntax-case X ()
20    [(sk EXPR (HCE HCV) (HVE HVV))
21      #'(cases h-datatype EXPR
22        [h-compose HCE HCV]
23        [h-value (HVE) HVV])]))
24
25(define-syntax greset
26  (syntax-rules ()
27    [(_ HR E) (HR (reset (h-value E)))]))
28
29(define-syntax gshift
30  (syntax-rules ()
31    [(_ HS F E)
32      (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E)))]))
33
34][else
35
36(define-macro (h-cases EXPR H-PART HV-PART)
37  `(cases h-datatype ,EXPR
38    [h-compose ,(car H-PART) ,(cadr H-PART)]
39    [h-value ,(list (car HV-PART)) ,(cadr HV-PART)]))
40
41(define-macro (greset HR E)
42  `(,HR (reset (h-value ,E))) )
43
44(define-macro (gshift HS F E)
45  (let ([X-VAR (gensym)] [F*-VAR (gensym)])
46    `(shift ,F*-VAR (h-compose (lambda (,X-VAR) (,HS (,F*-VAR ,X-VAR))) (lambda (,F) ,E))) ) )
47
48])
Note: See TracBrowser for help on using the repository browser.