* added call-with-current-continuation.
This commit is contained in:
parent
daadee442c
commit
d7b72ae38a
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -1,10 +1,11 @@
|
|||
|
||||
|
||||
(library (ikarus control)
|
||||
(export call/cf call/cc dynamic-wind exit)
|
||||
(export call/cf call/cc call-with-current-continuation dynamic-wind exit)
|
||||
(import
|
||||
(ikarus system $stack)
|
||||
(except (ikarus) call/cf call/cc dynamic-wind exit))
|
||||
(except (ikarus) call/cf call/cc call-with-current-continuation
|
||||
dynamic-wind exit))
|
||||
|
||||
(define primitive-call/cf
|
||||
(lambda (f)
|
||||
|
@ -85,6 +86,10 @@
|
|||
(unless (eq? save winders) (do-wind save))
|
||||
(apply k v1 v2 v*)])))))))
|
||||
|
||||
(define call-with-current-continuation
|
||||
;; look at how verbose I am ;;
|
||||
(lambda (f) (call/cc f)))
|
||||
|
||||
(define dynamic-wind
|
||||
(lambda (in body out)
|
||||
(in)
|
||||
|
|
|
@ -93,7 +93,6 @@
|
|||
(let f ([ls (library-path)])
|
||||
(and (pair? ls)
|
||||
(let ([name (string-append (car ls) str)])
|
||||
(printf "trying ~s\n" name)
|
||||
(if (file-exists? name)
|
||||
name
|
||||
(f (cdr ls))))))))
|
||||
|
|
|
@ -775,6 +775,31 @@
|
|||
(bless `(letrec ([,f (lambda ,lhs* ,b . ,b*)])
|
||||
(,f . ,rhs*)))
|
||||
(stx-error stx "invalid syntax"))])))
|
||||
(define do-macro
|
||||
(lambda (stx)
|
||||
(define bind
|
||||
(lambda (x)
|
||||
(syntax-match x ()
|
||||
[(x init) `(,x ,init ,x)]
|
||||
[(x init step) `(,x ,init ,step)]
|
||||
[_ (stx-error stx "invalid binding")])))
|
||||
(syntax-match stx ()
|
||||
[(_ (binding* ...)
|
||||
(test expr* ...)
|
||||
command* ...)
|
||||
(syntax-match (map bind binding*) ()
|
||||
[([x* init* step*] ...)
|
||||
(if (valid-bound-ids? x*)
|
||||
(bless
|
||||
`(letrec ([loop
|
||||
(lambda ,x*
|
||||
(if ,test
|
||||
(begin (void) ,@expr*)
|
||||
(begin
|
||||
,@command*
|
||||
(loop ,@step*))))])
|
||||
(loop ,@init*)))
|
||||
(stx-error stx "duplicate bindings"))])])))
|
||||
(define let*-macro
|
||||
(lambda (stx)
|
||||
(syntax-match stx ()
|
||||
|
@ -1514,6 +1539,7 @@
|
|||
[(include) include-macro]
|
||||
[(cond) cond-macro]
|
||||
[(let) let-macro]
|
||||
[(do) do-macro]
|
||||
[(or) or-macro]
|
||||
[(and) and-macro]
|
||||
[(let*) let*-macro]
|
||||
|
|
|
@ -90,6 +90,7 @@
|
|||
[let (macro . let)]
|
||||
[let* (macro . let*)]
|
||||
[cond (macro . cond)]
|
||||
[do (macro . do)]
|
||||
[and (macro . and)]
|
||||
[or (macro . or)]))
|
||||
|
||||
|
@ -149,6 +150,7 @@
|
|||
[let i r]
|
||||
[let* i r]
|
||||
[cond i r]
|
||||
[do i r]
|
||||
[and i r]
|
||||
[or i r]))
|
||||
|
||||
|
@ -370,6 +372,7 @@
|
|||
[values i r]
|
||||
[call-with-values i r]
|
||||
[call/cc i r]
|
||||
[call-with-current-continuation i r]
|
||||
[call/cf i]
|
||||
[dynamic-wind i r]
|
||||
[error i]
|
||||
|
|
Loading…
Reference in New Issue