Changeset 8904 in project for release/3/F-operator/gshift-greset.scm


Ignore:
Timestamp:
02/25/08 16:11:05 (12 years ago)
Author:
Kon Lovett
Message:

Save.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/F-operator/gshift-greset.scm

    r2773 r8904  
    66(use datatype shift-reset)
    77
    8 (cond-expand [hygienic-macros
     8(cond-expand
     9  [hygienic-macros
    910
    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)]))
     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])] ) )
    1421
    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])]))
     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)] ) )
    2426
    25 (define-syntax greset
    26   (syntax-rules ()
    27     [(_ HR E) (HR (reset (h-value E)))]))
     27    (define-syntax greset
     28      (syntax-rules ()
     29        [(_ HR E) (HR (reset (h-value E)))] ) )
    2830
    29 (define-syntax gshift
    30   (syntax-rules ()
    31     [(_ HS F E)
    32       (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E)))]))
     31    (define-syntax gshift
     32      (syntax-rules ()
     33        [(_ HS F E)
     34          (shift f* (h-compose (lambda (x) (HS (f* x))) (lambda (F) E)))] ) ) ]
    3335
    34 ][else
     36  [else
    3537
    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)]))
     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)]))
    4042
    41 (define-macro (greset HR E)
    42   `(,HR (reset (h-value ,E))) )
     43    (define-macro (greset HR E)
     44      `(,HR (reset (h-value ,E))) )
    4345
    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 ])
     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 TracChangeset for help on using the changeset viewer.