Changeset 8904 in project


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

Save.

Location:
release/3/F-operator
Files:
1 added
6 edited

Legend:

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

    r2773 r8904  
    4040    (description (p "Shift/Reset Control Operators"))
    4141    (author (url "mailto:klovett@pacbell.net" "Kon Lovett"))
     42    (requires
     43      (url "datatype.html" "datatype")
     44      "Chicken 2.310+")
     45    (download "F-operator.egg")
     46
     47    (documentation
     48
     49      (p "The static delimited continuation operators shift and reset.")
     50
     51      (subsection "Shift/Reset - Dynamically scoped shift/reset"
     52
     53        (pre "(require-extension shift-reset)")
     54
     55        (p "A \"stuck on control\" situation, a 'shift' without an "
     56        "enclosing 'reset', is an error.")
     57
     58        (macro "(%reset EXPRESSION ...)"
     59          (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
     60          "delimited continuation. The body will contain one or more "
     61          "instances of " (code "(%shift ...)") ".")
     62
     63          (p "Any use of " (code "(dynamic-wind ...)") " within the "
     64          "dynamic scope of the partial continuation will be " (b
     65          "ignored") "!"))
     66
     67        (macro "(%shift PC-TAG EXPRESSION)"
     68          (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
     69          " is bound to the reified partial continuation delimited by "
     70          "the enclosing " (code "(%reset ...)") ". Provide a value to the "
     71          "partial continuation using the form " (code "(PC-TAG "
     72          "<something>)") "."))
     73
     74        (macro "(reset EXPRESSION ...)"
     75          (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
     76          "delimited continuation. The body will contain one or more "
     77          "instances of " (code "(shift ...)") "."))
     78
     79        (macro "(shift PC-TAG EXPRESSION)"
     80          (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
     81          " is bound to the reified partial continuation delimited by "
     82          "the enclosing " (code "(reset ...)") ". Provide a value to the "
     83          "partial continuation using the form " (code "(PC-TAG "
     84          "<something>)") "."))
     85
     86        (macro "(%reset-values EXPRESSION ...)"
     87          (p "Multiple value return version of " (code "(%reset ...)") ". "
     88          "The body will contain one or more instances of " (code
     89          "(%shift-values ...)") ".")
     90
     91          (p "Any use of " (code "(dynamic-wind ...)") " within the "
     92          "dynamic scope of the partial continuation will be " (b
     93          "ignored") "!"))
     94
     95        (macro "(%shift-values PC-TAG EXPRESSION)"
     96          (p "Multiple value return version of " (code "(%shift ...)") ". "
     97          "Provide a value to the partial continuation using the form "
     98          (code "(PC-TAG <something> ...)") "."))
     99
     100        (macro "(reset-values EXPRESSION ...)"
     101          (p "Multiple value return version of " (code "(reset ...)") ". "
     102          "The body will contain one or more instances of " (code
     103          "(shift-values ...)") "."))
     104
     105        (macro "(shift-values PC-TAG EXPRESSION)"
     106          (p "Multiple value return version of " (code "(shift ...)") ". "
     107          "Provide a value to the partial continuation using the form "
     108          (code "(PC-TAG <something> ...)") "."))
     109      )
     110
     111      (subsection "BShift/BReset - Statically scoped shift/reset"
     112
     113        (pre "(require-extension bshift-breset)")
     114
     115        (p "Invalid delimited continuations, what " (tt "RC-TAG") " "
     116        "below represents, and \"stuck on control\" will generate an "
     117        "error.")
     118
     119        (macro "(%breset RC-TAG EXPRESSION ...)"
     120          (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
     121          "delimited continuation named " (tt "RC-TAG") ". The body will "
     122          "contain one or more instances of " (code "(%bshift RC-TAG "
     123          "...)") ".")
     124
     125          (p "Any use of " (code "(dynamic-wind ...)") " within the "
     126          "dynamic scope of the partial continuation will be " (b
     127          "ignored") "!"))
     128
     129        (macro "(%bshift RC-TAG PC-TAG EXPRESSION)"
     130          (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
     131          " is bound to the reified partial continuation delimited by "
     132          "the enclosing " (code "(%breset RC-TAG ...)") ". Provide a "
     133          "value to the partial continuation using the form " (code
     134          "(PC-TAG <something>)") "."))
     135
     136        (macro "(breset RC-TAG EXPRESSION ...)"
     137          (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
     138          "delimited continuation named " (tt "RC-TAG") ". The body will "
     139          "contain one or more instances of " (code "(bshift RC-TAG "
     140          "...)") "."))
     141
     142        (macro "(bshift RC-TAG PC-TAG EXPRESSION)"
     143          (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
     144          " is bound to the reified partial continuation delimited by "
     145          "the enclosing " (code "(breset RC-TAG ...)") ". Provide a "
     146          "value to the partial continuation using the form " (code
     147          "(PC-TAG <something>)") "."))
     148
     149        (macro "(%breset-values RC-TAG EXPRESSION ...)"
     150          (p "Multiple value return version of " (code "(%breset ...)")
     151          ". The body will contain one or more instances of " (code
     152          "(%bshift-values RC-TAG ...)") ".")
     153
     154          (p "Any use of " (code "(dynamic-wind ...)") " within the "
     155          "dynamic scope of the partial continuation will be " (b
     156          "ignored") "!"))
     157
     158        (macro "(%bshift-values RC-TAG PC-TAG EXPRESSION)"
     159          (p "Multiple value return version of " (code "(%bshift ...)")
     160          ". Provide a value to the partial continuation using the form "
     161          (code "(PC-TAG <something> ...)") "."))
     162
     163        (macro "(breset-values RC-TAG EXPRESSION ...)"
     164          (p "Multiple value return version of " (code "(breset ...)")
     165          ". The body will contain one or more instances of " (code
     166          "(bshift-values RC-TAG ...)") "."))
     167
     168        (macro "(bshift-values RC-TAG PC-TAG EXPRESSION)"
     169          (p "Multiple value return version of " (code "(bshift ...)")
     170          ". Provide a value to the partial continuation using the form "
     171          (code "(PC-TAG <something> ...)") "."))
     172      )
     173
     174      (subsection "Range"
     175
     176        (pre "(require-extension range)")
     177
     178        (macro "(range RC-TAG FROM VALUE STEP TO?)"
     179          (p "The value of the delimited continuation " (tt "") " ranges "
     180          "over the set of values specified by the state generation "
     181          "procedure suite. For use with " (code "(breset ...)") ".")
     182
     183          (symbol-table
     184
     185            (describe FROM
     186              (p "Zero argument procedure, returning the initial "
     187              "state."))
     188
     189            (describe VALUE
     190              (p "Single argument procedure, of the state, returning the "
     191              "value of the state."))
     192
     193            (describe STEP
     194              (p "Single argument procedure, of the state, returning the "
     195              "next state."))
     196
     197            (describe TO?
     198              (p "Single argument procedure, of the state, returning "
     199              (code "#t") " when the range is complete."))
     200          ))
     201
     202        (macro "(range RC-TAG FROM [STEP] TO)"
     203          (p "The value of the delimited continuation " (tt "") " ranges "
     204          "over the number interval [" (tt "FROM") "  " (tt "TO") "], by "
     205          (tt "STEP") ". The increment is 1 when missing. For use with "
     206          (code "(breset ...)") "."))
     207
     208        (macro "(%range RC-TAG FROM VALUE STEP TO?)"
     209          (p "Version of " (code "(range ...)") " for use with " (code
     210          "(%breset ...)") "."))
     211
     212        (macro "(%range RC-TAG FROM [STEP] TO)"
     213          (p "Version of " (code "(range ...)") " for use with " (code
     214          "(%breset ...)") "."))
     215      )
     216
     217      (subsection "Reflect/Reify - Monads"
     218
     219        (pre "(require-extension reflect-reify)")
     220
     221        (macro "(define-unit KIND BODY ...)"
     222          (p "Expands to " (code "(define (KIND-unit obj) BODY ...)") ".") )
     223
     224        (macro "(define-bind KIND BODY ...)"
     225          (p "Expands to " (code "(define (KIND-bind monad func) BODY ...)") ".") )
     226
     227        (macro "(reflect KIND MONAD)"
     228          (p "Extract value from " (tt "MONAD") ". Plays the role of Haskell '<-'.") )
     229
     230        (macro "(reflect-values KIND MONAD)"
     231          (p "Extract value from " (tt "MONAD") ". Plays the role of Haskell '<-'.") )
     232
     233        (macro "(%reflect KIND MONAD)"
     234          (p "Extract value from " (tt "MONAD") ". Plays the role of Haskell '<-'.") )
     235
     236        (macro "(reify KIND EXPRESSION)"
     237          (p "Return result of " (tt "EXPRESSION") " as a monad.") )
     238
     239        (macro "(reify-values KIND EXPRESSION)"
     240          (p "Return result of " (tt "EXPRESSION") " as a monad.") )
     241
     242        (macro "(%reify KIND EXPRESSION)"
     243          (p "Return result of " (tt "EXPRESSION") " as a monad.") )
     244      )
     245
     246      (subsection "GShift/GReset - Generalized shift/reset"
     247
     248        (pre "(require-extension gshift-greset)")
     249
     250        (p "The generalized shift and reset operator family from " (url
     251        "http://www.cs.indiana.edu/cgi-bin/techreports/TRNNN.cgi?trnum=TR611"
     252        "How to remove a dynamic prompt: static and dynamic "
     253        "delimited continuation operators are equally expressible") ".")
     254
     255        (macro "(greset HR E)"
     256          (p "Reset parameterized by the H Reset procedure " (tt "HR")
     257          "."))
     258
     259        (macro "(gshift HS F E)"
     260          (p "Shift parameterized by the H Shift procedure " (tt "HS")
     261          "."))
     262
     263        (procedure "(hr-stop V)"
     264          (p "H Reset Stop."))
     265
     266        (procedure "(hs-stop V)"
     267          (p "H Shift Stop."))
     268
     269        (procedure "(hr-prop V)"
     270          (p "H Reset Propagate."))
     271
     272        (procedure "(hs-prop V)"
     273          (p "H Shift Propagate."))
     274
     275        (procedure "(h-compose F X)"
     276          (p "Returns the composition of " (tt "F") " and " (tt "X") " "
     277          "as an h-datatype."))
     278
     279        (procedure "(h-value V)"
     280          (p "Returns the value of " (tt "V") " as an h-datatype."))
     281
     282        (procedure "(h-datatype? OBJECT)"
     283          (p "Is " (tt "OBJECT") " an h-datatype?"))
     284
     285        (macro "(h-cases E ((F X) ON-h-EXPR) (V ON-V-EXPR))"
     286          (p "Deconstructs the h-datatype " (tt "E") ", binding " (tt
     287          "F") " & " (tt "X") " for an evaluation of the " (tt
     288          "ON-h-EXPR") " and " (tt "V") " for an evaluation of the " (tt
     289          "ON-V-EXPR") "."))
     290      )
     291    )
     292
     293    (section "Issues"
     294
     295      (p "Not a direct implementation of partial continuations. "
     296      "Simulated using full continuations.")
     297    )
     298
     299    (section "Examples" (pre ,examples))
     300
    42301    (history
     302      (version "1.4" "Moved the \"range\" macro into own file.")
    43303      (version "1.3" "Added %bshift-values/%breset-values & %shift-values/%reset-values")
    44304      (version "1.2" "Renamed H datatype stuff")
     
    51311      (version "0.2" "shiftv/resetv, bshiftv/bresetv")
    52312      (version "0.1" "Initial release"))
    53     (requires
    54       (url "datatype.html" "datatype")
    55       "Chicken 2.310+")
    56     (download "F-operator.egg")
    57 
    58     (documentation
    59 
    60       (p "The static delimited continuation operators shift and reset.")
    61 
    62       (subsection "Shift/Reset - Dynamically scoped shift/reset"
    63 
    64         (pre "(require-extension shift-reset)")
    65 
    66         (p "A \"stuck on control\" situation, a 'shift' without an "
    67         "enclosing 'reset', is an error.")
    68 
    69         (macro "(%reset EXPRESSION ...)"
    70           (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
    71           "delimited continuation. The body will contain one or more "
    72           "instances of " (code "(%shift ...)") ".")
    73 
    74           (p "Any use of " (code "(dynamic-wind ...)") " within the "
    75           "dynamic scope of the partial continuation will be " (b
    76           "ignored") "!"))
    77 
    78         (macro "(%shift PC-TAG EXPRESSION)"
    79           (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
    80           " is bound to the reified partial continuation delimited by "
    81           "the enclosing " (code "(%reset ...)") ". Provide a value to the "
    82           "partial continuation using the form " (code "(PC-TAG "
    83           "<something>)") "."))
    84 
    85         (macro "(reset EXPRESSION ...)"
    86           (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
    87           "delimited continuation. The body will contain one or more "
    88           "instances of " (code "(shift ...)") "."))
    89 
    90         (macro "(shift PC-TAG EXPRESSION)"
    91           (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
    92           " is bound to the reified partial continuation delimited by "
    93           "the enclosing " (code "(reset ...)") ". Provide a value to the "
    94           "partial continuation using the form " (code "(PC-TAG "
    95           "<something>)") "."))
    96 
    97         (macro "(%reset-values EXPRESSION ...)"
    98           (p "Multiple value return version of " (code "(%reset ...)") ". "
    99           "The body will contain one or more instances of " (code
    100           "(%shift-values ...)") ".")
    101 
    102           (p "Any use of " (code "(dynamic-wind ...)") " within the "
    103           "dynamic scope of the partial continuation will be " (b
    104           "ignored") "!"))
    105 
    106         (macro "(%shift-values PC-TAG EXPRESSION)"
    107           (p "Multiple value return version of " (code "(%shift ...)") ". "
    108           "Provide a value to the partial continuation using the form "
    109           (code "(PC-TAG <something> ...)") "."))
    110 
    111         (macro "(reset-values EXPRESSION ...)"
    112           (p "Multiple value return version of " (code "(reset ...)") ". "
    113           "The body will contain one or more instances of " (code
    114           "(shift-values ...)") "."))
    115 
    116         (macro "(shift-values PC-TAG EXPRESSION)"
    117           (p "Multiple value return version of " (code "(shift ...)") ". "
    118           "Provide a value to the partial continuation using the form "
    119           (code "(PC-TAG <something> ...)") "."))
    120       )
    121 
    122       (subsection "BShift/BReset - Statically scoped shift/reset"
    123 
    124         (pre "(require-extension bshift-breset)")
    125 
    126         (p "Invalid delimited continuations, what " (tt "RC-TAG") " "
    127         "below represents, and \"stuck on control\" will generate an "
    128         "error.")
    129 
    130         (macro "(%breset RC-TAG EXPRESSION ...)"
    131           (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
    132           "delimited continuation named " (tt "RC-TAG") ". The body will "
    133           "contain one or more instances of " (code "(%bshift RC-TAG "
    134           "...)") ".")
    135 
    136           (p "Any use of " (code "(dynamic-wind ...)") " within the "
    137           "dynamic scope of the partial continuation will be " (b
    138           "ignored") "!"))
    139 
    140         (macro "(%bshift RC-TAG PC-TAG EXPRESSION)"
    141           (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
    142           " is bound to the reified partial continuation delimited by "
    143           "the enclosing " (code "(%breset RC-TAG ...)") ". Provide a "
    144           "value to the partial continuation using the form " (code
    145           "(PC-TAG <something>)") "."))
    146 
    147         (macro "(breset RC-TAG EXPRESSION ...)"
    148           (p "Evaluate the body " (tt "EXPRESSION ...") " with a "
    149           "delimited continuation named " (tt "RC-TAG") ". The body will "
    150           "contain one or more instances of " (code "(bshift RC-TAG "
    151           "...)") "."))
    152 
    153         (macro "(bshift RC-TAG PC-TAG EXPRESSION)"
    154           (p "Within the scope of " (tt "EXPRESSION") " " (tt "PC-TAG")
    155           " is bound to the reified partial continuation delimited by "
    156           "the enclosing " (code "(breset RC-TAG ...)") ". Provide a "
    157           "value to the partial continuation using the form " (code
    158           "(PC-TAG <something>)") "."))
    159 
    160         (macro "(%breset-values RC-TAG EXPRESSION ...)"
    161           (p "Multiple value return version of " (code "(%breset ...)")
    162           ". The body will contain one or more instances of " (code
    163           "(%bshift-values RC-TAG ...)") ".")
    164 
    165           (p "Any use of " (code "(dynamic-wind ...)") " within the "
    166           "dynamic scope of the partial continuation will be " (b
    167           "ignored") "!"))
    168 
    169         (macro "(%bshift-values RC-TAG PC-TAG EXPRESSION)"
    170           (p "Multiple value return version of " (code "(%bshift ...)")
    171           ". Provide a value to the partial continuation using the form "
    172           (code "(PC-TAG <something> ...)") "."))
    173 
    174         (macro "(breset-values RC-TAG EXPRESSION ...)"
    175           (p "Multiple value return version of " (code "(breset ...)")
    176           ". The body will contain one or more instances of " (code
    177           "(bshift-values RC-TAG ...)") "."))
    178 
    179         (macro "(bshift-values RC-TAG PC-TAG EXPRESSION)"
    180           (p "Multiple value return version of " (code "(bshift ...)")
    181           ". Provide a value to the partial continuation using the form "
    182           (code "(PC-TAG <something> ...)") "."))
    183 
    184         (macro "(range RC-TAG FROM VALUE STEP TO?)"
    185           (p "The value of the delimited continuation " (tt "") " ranges "
    186           "over the set of values specified by the state generation "
    187           "procedure suite. For use with " (code "(breset ...)") ".")
    188 
    189           (symbol-table
    190 
    191             (describe FROM
    192               (p "Zero argument procedure, returning the initial "
    193               "state."))
    194 
    195             (describe VALUE
    196               (p "Single argument procedure, of the state, returning the "
    197               "value of the state."))
    198 
    199             (describe STEP
    200               (p "Single argument procedure, of the state, returning the "
    201               "next state."))
    202 
    203             (describe TO?
    204               (p "Single argument procedure, of the state, returning "
    205               (code "#t") " when the range is complete."))
    206           ))
    207 
    208         (macro "(range RC-TAG FROM [STEP] TO)"
    209           (p "The value of the delimited continuation " (tt "") " ranges "
    210           "over the number interval [" (tt "FROM") "  " (tt "TO") "], by "
    211           (tt "STEP") ". The increment is 1 when missing. For use with "
    212           (code "(breset ...)") "."))
    213 
    214         (macro "(%range RC-TAG FROM VALUE STEP TO?)"
    215           (p "Version of " (code "(range ...)") " for use with " (code
    216           "(%breset ...)") "."))
    217 
    218         (macro "(%range RC-TAG FROM [STEP] TO)"
    219           (p "Version of " (code "(range ...)") " for use with " (code
    220           "(%breset ...)") "."))
    221       )
    222 
    223       (subsection "Reflect/Reify - Monads"
    224 
    225         (pre "(require-extension reflect-reify)")
    226 
    227         (macro "(define-unit KIND BODY ...)"
    228           (p "Expands to " (code "(define (KIND-unit obj) BODY ...)") ".") )
    229 
    230         (macro "(define-bind KIND BODY ...)"
    231           (p "Expands to " (code "(define (KIND-bind monad func) BODY ...)") ".") )
    232 
    233         (macro "(reflect KIND MONAD)"
    234           (p "Extract value from " (tt "MONAD") ". Plays the role of Haskell '<-'.") )
    235 
    236         (macro "(reflect-values KIND MONAD)"
    237           (p "Extract value from " (tt "MONAD") ". Plays the role of Haskell '<-'.") )
    238 
    239         (macro "(%reflect KIND MONAD)"
    240           (p "Extract value from " (tt "MONAD") ". Plays the role of Haskell '<-'.") )
    241 
    242         (macro "(reify KIND EXPRESSION)"
    243           (p "Return result of " (tt "EXPRESSION") " as a monad.") )
    244 
    245         (macro "(reify-values KIND EXPRESSION)"
    246           (p "Return result of " (tt "EXPRESSION") " as a monad.") )
    247 
    248         (macro "(%reify KIND EXPRESSION)"
    249           (p "Return result of " (tt "EXPRESSION") " as a monad.") )
    250       )
    251 
    252       (subsection "GShift/GReset - Generalized shift/reset"
    253 
    254         (pre "(require-extension gshift-greset)")
    255 
    256         (p "The generalized shift and reset operator family from " (url
    257         "http://www.cs.indiana.edu/cgi-bin/techreports/TRNNN.cgi?trnum=TR611"
    258         "How to remove a dynamic prompt: static and dynamic "
    259         "delimited continuation operators are equally expressible") ".")
    260 
    261         (macro "(greset HR E)"
    262           (p "Reset parameterized by the H Reset procedure " (tt "HR")
    263           "."))
    264 
    265         (macro "(gshift HS F E)"
    266           (p "Shift parameterized by the H Shift procedure " (tt "HS")
    267           "."))
    268 
    269         (procedure "(hr-stop V)"
    270           (p "H Reset Stop."))
    271 
    272         (procedure "(hs-stop V)"
    273           (p "H Shift Stop."))
    274 
    275         (procedure "(hr-prop V)"
    276           (p "H Reset Propagate."))
    277 
    278         (procedure "(hs-prop V)"
    279           (p "H Shift Propagate."))
    280 
    281         (procedure "(h-compose F X)"
    282           (p "Returns the composition of " (tt "F") " and " (tt "X") " "
    283           "as an h-datatype."))
    284 
    285         (procedure "(h-value V)"
    286           (p "Returns the value of " (tt "V") " as an h-datatype."))
    287 
    288         (procedure "(h-datatype? OBJECT)"
    289           (p "Is " (tt "OBJECT") " an h-datatype?"))
    290 
    291         (macro "(h-cases E ((F X) ON-h-EXPR) (V ON-V-EXPR))"
    292           (p "Deconstructs the h-datatype " (tt "E") ", binding " (tt
    293           "F") " & " (tt "X") " for an evaluation of the " (tt
    294           "ON-h-EXPR") " and " (tt "V") " for an evaluation of the " (tt
    295           "ON-V-EXPR") "."))
    296       )
    297     )
    298 
    299     (section "Issues"
    300 
    301       (p "Not a direct implementation of partial continuations. "
    302       "Simulated using full continuations.")
    303     )
    304 
    305     (section "Examples" (pre ,examples))
    306313
    307314    (section "License" (pre ,license))
  • release/3/F-operator/F-operator.setup

    r3956 r8904  
    55(copy-to-repository "F-operator.html")
    66
    7 (install-dynld+syntax shift-reset shift-reset-runtime "1.3" -O3 -d0 (documentation "F-operator.html"))
     7(install-dynld+syntax shift-reset shift-reset-runtime *version* -O3 -d0 (documentation "F-operator.html"))
    88
    9 (install-dynld+syntax bshift-breset bshift-breset-runtime "1.3" -O3 -d0 (documentation "F-operator.html"))
     9(install-dynld+syntax bshift-breset bshift-breset-runtime *version* -O3 -d0 (documentation "F-operator.html"))
    1010
    11 (install-dynld+syntax gshift-greset gshift-greset-runtime  "1.3" -O3 -d0 (documentation "F-operator.html"))
     11(install-syntax range *version* (documentation "F-operator.html") (require-at-runtime bshift-breset-runtime))
    1212
    13 (install-syntax reflect-reify "1.3" (documentation "F-operator.html"))
     13(install-dynld+syntax gshift-greset gshift-greset-runtime  *version* -O3 -d0 (documentation "F-operator.html") (require-at-runtime datatype shift-reset-runtime))
     14
     15(install-syntax reflect-reify *version* (documentation "F-operator.html") (require-at-runtime shift-reset-runtime))
    1416
    1517(install-test "F-operator-test.scm")
  • release/3/F-operator/bshift-breset.scm

    r2773 r8904  
    22;;;; Kon Lovett, Apr 6 '06
    33
    4 (cond-expand [hygienic-macros
     4(cond-expand
     5  [hygienic-macros
    56
    6 ;; Statically scoped shift/reset (Oleg Kiselyov)
     7    ;; Statically scoped shift/reset (Oleg Kiselyov)
    78
    8 (define-syntax %breset
    9   (syntax-rules ()
    10     [(_ RC BODY ...) (*%breset (lambda (RC) BODY ...) 'RC)]
    11   ))
     9    (define-syntax %breset
     10      (syntax-rules ()
     11        [(_ RC BODY ...) (*%breset (lambda (RC) BODY ...) 'RC)] ) )
    1212
    13 (define-syntax %bshift
    14   (syntax-rules ()
    15     [(_ RC SP BODY ...) (*%bshift RC (lambda (SP) BODY ...) 'RC)]
    16   ))
     13    (define-syntax %bshift
     14      (syntax-rules ()
     15        [(_ RC SP BODY ...) (*%bshift RC (lambda (SP) BODY ...) 'RC)] ) )
    1716
    18 (define-syntax breset
    19   (syntax-rules ()
    20     [(_ RC BODY ...) (*breset (lambda (RC) BODY ...) 'RC)]
    21   ))
     17    (define-syntax breset
     18      (syntax-rules ()
     19        [(_ RC BODY ...) (*breset (lambda (RC) BODY ...) 'RC)] ) )
    2220
    23 (define-syntax bshift
    24   (syntax-rules ()
    25     [(_ RC SP BODY ...) (*bshift RC (lambda (SP) BODY ...) 'RC)]
    26   ))
     21    (define-syntax bshift
     22      (syntax-rules ()
     23        [(_ RC SP BODY ...) (*bshift RC (lambda (SP) BODY ...) 'RC)] ) )
    2724
    28 (define-syntax %breset-values
    29   (syntax-rules ()
    30     [(_ RC BODY ...) (*%breset-values (lambda (RC) BODY ...) 'RC)]
    31   ))
     25    (define-syntax %breset-values
     26      (syntax-rules ()
     27        [(_ RC BODY ...) (*%breset-values (lambda (RC) BODY ...) 'RC)] ) )
    3228
    33 (define-syntax %bshift-values
    34   (syntax-rules ()
    35     [(_ RC SP BODY ...) (*%bshift-values RC (lambda (SP) BODY ...) 'RC)]
    36   ))
     29    (define-syntax %bshift-values
     30      (syntax-rules ()
     31        [(_ RC SP BODY ...) (*%bshift-values RC (lambda (SP) BODY ...) 'RC)] ) )
    3732
    38 (define-syntax breset-values
    39   (syntax-rules ()
    40     [(_ RC BODY ...) (*breset-values (lambda (RC) BODY ...) 'RC)]
    41   ))
     33    (define-syntax breset-values
     34      (syntax-rules ()
     35        [(_ RC BODY ...) (*breset-values (lambda (RC) BODY ...) 'RC)] ) )
    4236
    43 (define-syntax bshift-values
    44   (syntax-rules ()
    45     [(_ RC SP BODY ...) (*bshift-values RC (lambda (SP) BODY ...) 'RC)]
    46   ))
     37    (define-syntax bshift-values
     38      (syntax-rules ()
     39        [(_ RC SP BODY ...) (*bshift-values RC (lambda (SP) BODY ...) 'RC)] ) ) ]
    4740
    48 ;; Range (Oleg Kiselyov)
     41  [else
    4942
    50 (define-syntax range-empty?
    51   (syntax-rules ()
    52     [(_ RV) (eq? *range:empty* RV)]
    53   ))
     43    ;;; Statically scoped shift/reset (Oleg Kiselyov)
    5444
    55 (define-syntax range
    56   (syntax-rules ()
     45    (define-macro (breset RC . BODY)
     46      `(*breset (lambda (,RC) ,@BODY) ',RC) )
    5747
    58     [(_ RC FROM VALUE STEP TO?)
    59       (bshift RC shifter
    60         (let loop ([state (FROM)])
    61           (if (TO? state)
    62             *range:empty*
    63             (begin
    64               (shifter (VALUE state))
    65               (loop (STEP state))))))]
     48    (define-macro (bshift RC SP . BODY)
     49      `(*bshift ,RC (lambda (,SP) ,@BODY) ',RC) )
    6650
    67       ; number range
    68     [(_ RC FROM STEP TO)
    69       (bshift RC shifter
    70         (do ([i FROM (+ i STEP)])
    71             ((> i TO) *range:empty*)
    72           (shifter i)))]
     51    (define-macro (breset-values RC . BODY)
     52      `(*breset-values (lambda (,RC) ,@BODY) ',RC) )
    7353
    74     [(_ RC FROM TO)
    75       (range RC FROM 1 TO)]
    76   ))
     54    (define-macro (bshift-values RC SP . BODY)
     55      `(*bshift-values ,RC (lambda (,SP) ,@BODY) ',RC) )
    7756
    78 (define-syntax %range
    79   (syntax-rules ()
     57    (define-macro (%breset RC . BODY)
     58      `(*%breset (lambda (,RC) ,@BODY) ',RC) )
    8059
    81     [(_ RC FROM VALUE STEP TO?)
    82       (%bshift RC shifter
    83         (let loop ([state (FROM)])
    84           (if (TO? state)
    85             *range:empty*
    86             (begin
    87               (shifter (VALUE state))
    88               (loop (STEP state))))))]
     60    (define-macro (%bshift RC SP . BODY)
     61      `(*%bshift ,RC (lambda (,SP) ,@BODY) ',RC) )
    8962
    90       ; number range
    91     [(_ RC FROM STEP TO)
    92       (%bshift RC shifter
    93         (do ([i FROM (+ i STEP)])
    94             ((> i TO) *range:empty*)
    95           (shifter i)))]
     63    (define-macro (%breset-values RC . BODY)
     64      `(*%breset-values (lambda (,RC) ,@BODY) ',RC) )
    9665
    97     [(_ RC FROM TO)
    98       (%range RC FROM 1 TO)]
    99   ))
    100 
    101 ][else
    102 
    103 ;;; Statically scoped shift/reset (Oleg Kiselyov)
    104 
    105 (define-macro (breset RC . BODY)
    106   `(*breset (lambda (,RC) ,@BODY) ',RC) )
    107 
    108 (define-macro (bshift RC SP . BODY)
    109   `(*bshift ,RC (lambda (,SP) ,@BODY) ',RC) )
    110 
    111 (define-macro (breset-values RC . BODY)
    112   `(*breset-values (lambda (,RC) ,@BODY) ',RC) )
    113 
    114 (define-macro (bshift-values RC SP . BODY)
    115   `(*bshift-values ,RC (lambda (,SP) ,@BODY) ',RC) )
    116 
    117 (define-macro (%breset RC . BODY)
    118   `(*%breset (lambda (,RC) ,@BODY) ',RC) )
    119 
    120 (define-macro (%bshift RC SP . BODY)
    121   `(*%bshift ,RC (lambda (,SP) ,@BODY) ',RC) )
    122 
    123 (define-macro (%breset-values RC . BODY)
    124   `(*%breset-values (lambda (,RC) ,@BODY) ',RC) )
    125 
    126 (define-macro (%bshift-values RC SP . BODY)
    127   `(*%bshift-values ,RC (lambda (,SP) ,@BODY) ',RC) )
    128 
    129 ;;; Range (Oleg Kiselyov)
    130 
    131 (define-macro (range-empty? RV)
    132   `(eq? *range:empty* ,RV) )
    133 
    134 (define-macro (range RC FROM . REST)
    135   (let ([arglen (length REST)])
    136     (cond
    137       [(= arglen 3)
    138         (let ([VALUE (car REST)] [STEP (cadr REST)] [TO? (caddr REST)]
    139               [LOOP-VAR (gensym)] [STATE-VAR (gensym)] [SHIFTER-VAR (gensym)])
    140           `(bshift ,RC ,SHIFTER-VAR
    141             (let ,LOOP-VAR ([,STATE-VAR (,FROM)])
    142               (if (,TO? ,STATE-VAR)
    143                 *range:empty*
    144                 (begin
    145                   (,SHIFTER-VAR (,VALUE ,STATE-VAR))
    146                   (,LOOP-VAR (,STEP ,STATE-VAR)) ) ) )) )]
    147       [(= arglen 2)
    148         (let ([STEP (car REST)] [TO (cadr REST)]
    149               [LOOP-VAR (gensym)] [I-VAR (gensym)] [SHIFTER-VAR (gensym)])
    150           `(bshift ,RC ,SHIFTER-VAR
    151             (do ([,I-VAR ,FROM (+ ,I-VAR ,STEP)])
    152                 ((> ,I-VAR ,TO) *range:empty*)
    153               (,SHIFTER-VAR ,I-VAR) )) )]
    154       [(= arglen 1)
    155         (let ([TO (car REST)])
    156           `(range ,RC ,FROM 1 ,TO) )]
    157       [else
    158         (syntax-error 'range "wrong number of arguments" REST)] ) ) )
    159 
    160 (define-macro (%range RC FROM . REST)
    161   (let ([arglen (length REST)])
    162     (cond
    163       [(= arglen 3)
    164         (let ([VALUE (car REST)] [STEP (cadr REST)] [TO? (caddr REST)]
    165               [LOOP-VAR (gensym)] [STATE-VAR (gensym)] [SHIFTER-VAR (gensym)])
    166           `(%bshift ,RC ,SHIFTER-VAR
    167             (let ,LOOP-VAR ([,STATE-VAR (,FROM)])
    168               (if (,TO? ,STATE-VAR)
    169                 *range:empty*
    170                 (begin
    171                   (,SHIFTER-VAR (,VALUE ,STATE-VAR))
    172                   (,LOOP-VAR (,STEP ,STATE-VAR)) ) ) )) )]
    173       [(= arglen 2)
    174         (let ([STEP (car REST)] [TO (cadr REST)]
    175               [LOOP-VAR (gensym)] [I-VAR (gensym)] [SHIFTER-VAR (gensym)])
    176           `(%bshift ,RC ,SHIFTER-VAR
    177             (do ([,I-VAR ,FROM (+ ,I-VAR ,STEP)])
    178                 ((> ,I-VAR ,TO) *range:empty*)
    179               (,SHIFTER-VAR ,I-VAR) )) )]
    180       [(= arglen 1)
    181         (let ([TO (car REST)])
    182           `(%range ,RC ,FROM 1 ,TO) )]
    183       [else
    184         (syntax-error '%range "wrong number of arguments" REST)] ) ) )
    185 
    186 ])
     66    (define-macro (%bshift-values RC SP . BODY)
     67      `(*%bshift-values ,RC (lambda (,SP) ,@BODY) ',RC) ) ] )
  • 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))) ) ) ] )
  • release/3/F-operator/reflect-reify.scm

    r2773 r8904  
    66;; Monads from shift and reset (from Filinski, POPL '94)
    77
    8 (cond-expand (syntax-case
     8(cond-expand
     9  [syntax-case
    910
    10 (define-syntax define-bind
    11   (lambda (exp)
    12     (syntax-case exp ()
    13       [(sk kind body ...)
    14         (identifier? #'kind)
    15         (with-syntax (
    16             [monad (datum->syntax-object #'sk 'monad)]
    17             [func (datum->syntax-object #'sk 'func)]
    18             [bind
    19               (datum->syntax-object #'sk
    20                 (string->symbol
    21                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
    22           #'(define (bind monad func) body ...))]
    23     ) ) )
     11    (define-syntax (define-bind exp)
     12      (syntax-case exp ()
     13        [(sk kind body ...)
     14          (identifier? #'kind)
     15          (with-syntax (
     16              [monad (datum->syntax-object #'sk 'monad)]
     17              [func (datum->syntax-object #'sk 'func)]
     18              [bind
     19                (datum->syntax-object #'sk
     20                  (string->symbol
     21                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
     22            #'(define (bind monad func) body ...))] ) )
    2423
    25 (define-syntax define-unit
    26   (lambda (exp)
    27     (syntax-case exp ()
    28       [(sk kind body ...)
    29         (identifier? #'kind)
    30         (with-syntax (
    31             [obj (datum->syntax-object #'sk 'obj)]
    32             [unit
    33               (datum->syntax-object #'sk
    34                 (string->symbol
    35                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
    36           #'(define (unit obj) body ...))]
    37     ) ) )
     24    (define-syntax (define-unit exp)
     25      (syntax-case exp ()
     26        [(sk kind body ...)
     27          (identifier? #'kind)
     28          (with-syntax (
     29              [obj (datum->syntax-object #'sk 'obj)]
     30              [unit
     31                (datum->syntax-object #'sk
     32                  (string->symbol
     33                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
     34            #'(define (unit obj) body ...))] ) )
    3835
    39 (define-syntax reflect
    40   (lambda (exp)
    41     (syntax-case exp ()
    42       [(sk kind meaning)
    43         (identifier? #'kind)
    44         (with-syntax (
    45             [bind
    46               (datum->syntax-object #'sk
    47                 (string->symbol
    48                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
    49           #'(shift k (bind meaning k)))]
    50     ) ) )
     36    (define-syntax (reflect exp)
     37      (syntax-case exp ()
     38        [(sk kind meaning)
     39          (identifier? #'kind)
     40          (with-syntax (
     41              [bind
     42                (datum->syntax-object #'sk
     43                  (string->symbol
     44                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
     45            #'(shift k (bind meaning k)))] ) )
    5146
    52 (define-syntax reflect-values
    53   (lambda (exp)
    54     (syntax-case exp ()
    55       [(sk kind meaning)
    56         (identifier? #'kind)
    57         (with-syntax (
    58             [bind
    59               (datum->syntax-object #'sk
    60                 (string->symbol
    61                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
    62           #'(shift-values k (bind meaning k)))]
    63     ) ) )
     47    (define-syntax (reflect-values exp)
     48      (syntax-case exp ()
     49        [(sk kind meaning)
     50          (identifier? #'kind)
     51          (with-syntax (
     52              [bind
     53                (datum->syntax-object #'sk
     54                  (string->symbol
     55                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
     56            #'(shift-values k (bind meaning k)))] ) )
    6457
    65 (define-syntax %reflect
    66   (lambda (exp)
    67     (syntax-case exp ()
    68       [(sk kind meaning)
    69         (identifier? #'kind)
    70         (with-syntax (
    71             [bind
    72               (datum->syntax-object #'sk
    73                 (string->symbol
    74                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
    75           #'(%shift k (bind meaning k)))]
    76     ) ) )
     58    (define-syntax (%reflect exp)
     59      (syntax-case exp ()
     60        [(sk kind meaning)
     61          (identifier? #'kind)
     62          (with-syntax (
     63              [bind
     64                (datum->syntax-object #'sk
     65                  (string->symbol
     66                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "bind")))])
     67            #'(%shift k (bind meaning k)))] ) )
    7768
    78 (define-syntax reify
    79   (lambda (exp)
    80     (syntax-case exp ()
    81       [(sk kind exp)
    82         (identifier? #'kind)
    83         (with-syntax (
    84             [unit
    85               (datum->syntax-object #'sk
    86                 (string->symbol
    87                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
    88           #'(reset (unit exp)))]
    89     ) ) )
     69    (define-syntax (reify exp)
     70      (syntax-case exp ()
     71        [(sk kind exp)
     72          (identifier? #'kind)
     73          (with-syntax (
     74              [unit
     75                (datum->syntax-object #'sk
     76                  (string->symbol
     77                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
     78            #'(reset (unit exp)))] ) )
    9079
    91 (define-syntax reify-values
    92   (lambda (exp)
    93     (syntax-case exp ()
    94       [(sk kind exp)
    95         (identifier? #'kind)
    96         (with-syntax (
    97             [unit
    98               (datum->syntax-object #'sk
    99                 (string->symbol
    100                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
    101           #'(reset-values (unit exp)))]
    102     ) ) )
     80    (define-syntax (reify-values exp)
     81      (syntax-case exp ()
     82        [(sk kind exp)
     83          (identifier? #'kind)
     84          (with-syntax (
     85              [unit
     86                (datum->syntax-object #'sk
     87                  (string->symbol
     88                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
     89            #'(reset-values (unit exp)))] ) )
    10390
    104 (define-syntax %reify
    105   (lambda (exp)
    106     (syntax-case exp ()
    107       [(sk kind exp)
    108         (identifier? #'kind)
    109         (with-syntax (
    110             [unit
    111               (datum->syntax-object #'sk
    112                 (string->symbol
    113                   (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
    114           #'(%reset (unit exp)))]
    115     ) ) )
     91    (define-syntax (%reify exp)
     92      (syntax-case exp ()
     93        [(sk kind exp)
     94          (identifier? #'kind)
     95          (with-syntax (
     96              [unit
     97                (datum->syntax-object #'sk
     98                  (string->symbol
     99                    (conc (symbol->string (syntax-object->datum #'kind)) #\- "unit")))])
     100            #'(%reset (unit exp)))] ) ) ]
    116101
    117 )(else
     102  [else
    118103
    119 (define-macro (define-bind KIND . BODY)
    120   (let ([BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
    121     `(define (,BIND monad func) ,@BODY) ) )
     104    (define-macro (define-bind KIND . BODY)
     105      (let ([BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
     106        `(define (,BIND monad func) ,@BODY) ) )
    122107
    123 (define-macro (define-unit KIND . BODY)
    124   (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
    125     `(define (,UNIT obj) ,@BODY) ) )
     108    (define-macro (define-unit KIND . BODY)
     109      (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
     110        `(define (,UNIT obj) ,@BODY) ) )
    126111
    127 (define-macro (reflect KIND MEANING)
    128   (let ([K (gensym)]
    129         [BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
    130     `(shift ,K (,BIND ,MEANING ,K)) ) )
     112    (define-macro (reflect KIND MEANING)
     113      (let ([K (gensym)]
     114            [BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
     115        `(shift ,K (,BIND ,MEANING ,K)) ) )
    131116
    132 (define-macro (reflect-values KIND MEANING)
    133   (let ([K (gensym)]
    134         [BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
    135     `(shift-values ,K (,BIND ,MEANING ,K)) ) )
     117    (define-macro (reflect-values KIND MEANING)
     118      (let ([K (gensym)]
     119            [BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
     120        `(shift-values ,K (,BIND ,MEANING ,K)) ) )
    136121
    137 (define-macro (%reflect KIND MEANING)
    138   (let ([K (gensym)]
    139         [BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
    140     `(%shift ,K (,BIND ,MEANING ,K)) ) )
     122    (define-macro (%reflect KIND MEANING)
     123      (let ([K (gensym)]
     124            [BIND (string->symbol (conc (symbol->string KIND) #\- "bind"))])
     125        `(%shift ,K (,BIND ,MEANING ,K)) ) )
    141126
    142 (define-macro (reify KIND EXP)
    143   (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
    144     `(reset (,UNIT ,EXP)) ) )
     127    (define-macro (reify KIND EXP)
     128      (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
     129        `(reset (,UNIT ,EXP)) ) )
    145130
    146 (define-macro (reify-values KIND EXP)
    147   (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
    148     `(reset-values (,UNIT ,EXP)) ) )
     131    (define-macro (reify-values KIND EXP)
     132      (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
     133        `(reset-values (,UNIT ,EXP)) ) )
    149134
    150 (define-macro (%reify KIND EXP)
    151   (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
    152     `(%reset (,UNIT ,EXP)) ) )
    153 
    154 ) )
     135    (define-macro (%reify KIND EXP)
     136      (let ([UNIT (string->symbol (conc (symbol->string KIND) #\- "unit"))])
     137        `(%reset (,UNIT ,EXP)) ) ) ] )
  • release/3/F-operator/tests/F-operator-test.scm

    r5067 r8904  
    33
    44(use testbase testbase-output-human)
    5 (use shift-reset bshift-breset gshift-greset reflect-reify)
     5(use shift-reset bshift-breset gshift-greset reflect-reify range)
    66(use srfi-1)
    77
     
    3636    (/ 1 x) ) )
    3737
    38 (cond-expand [hygienic-macros
    39 
    40 ;; Generalized shift/reset implementations of some control operators
    41 
    42 (define-syntax prompt
    43   (syntax-rules ()
    44     [(_ e) (greset hr-stop e)]
    45   ))
    46 
    47 (define-syntax control
    48   (syntax-rules ()
    49     [(_ f e) (gshift hs-prop f e)]
    50   ))
    51 
    52 (define-syntax prompt0
    53   (syntax-rules ()
    54     [(_ e) (greset hr-prop e)]
    55   ))
    56 
    57 (define-syntax shift0
    58   (syntax-rules ()
    59     [(_ f e) (gshift hs-stop f e)]
    60   ))
    61 
    62 ][else
    63 
    64 ;; Generalized shift/reset implementations of some control operators
    65 
    66 (define-macro (prompt E)
    67   `(greset hr-stop ,E) )
    68 
    69 (define-macro (control F E)
    70   `(gshift hs-prop ,F ,E) )
    71 
    72 (define-macro (prompt0 E)
    73   `(greset hr-prop ,E) )
    74 
    75 (define-macro (shift0 F E)
    76   `(gshift hs-stop ,F ,E) )
    77 
    78 ])
    79 
    80 ;;
     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) ) ] )
     74
     75;;;
    8176
    8277(define-test shift-reset-test "Shift/Reset Family"
     
    423418(test::for-each (cut test::styler-set! <> test::output-style-human))
    424419(run-test "Shift Reset Tests")
     420
     421(test::forget!)
Note: See TracChangeset for help on using the changeset viewer.