diff options
author | Andy Wingo <wingo@pobox.com> | 2010-02-19 10:49:24 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-02-19 12:10:11 +0100 |
commit | 6e84cb95b18d81ef7a8490cccdfb08d3f88116ea (patch) | |
tree | 41d26678df853cb3e6f77bdb08ebe962c58306f5 /module/language/tree-il.scm | |
parent | 07a0c7d5d9523936d5fe4cac595bd75859416c9e (diff) | |
download | guile-6e84cb95b18d81ef7a8490cccdfb08d3f88116ea.tar.gz |
rename <control> to <abort>
* libguile/vm-i-system.c (abort): Rename instruction from `throw'.
* libguile/vm.c (vm_abort): Rename from vm_throw.
* module/language/tree-il.scm (<abort>, make-abort, abort-src,
abort-tag, abort-args: Rename from <control> & company.
* module/language/tree-il/analyze.scm:
* module/language/tree-il/compile-glil.scm:
* module/language/tree-il/primitives.scm: Fix all callers.
Diffstat (limited to 'module/language/tree-il.scm')
-rw-r--r-- | module/language/tree-il.scm | 34 |
1 files changed, 16 insertions, 18 deletions
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm index 47b2d831a..1ae39e874 100644 --- a/module/language/tree-il.scm +++ b/module/language/tree-il.scm @@ -48,7 +48,7 @@ <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder dynwind-body dynwind-unwinder <dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals dynlet-body <prompt> prompt? make-prompt prompt-src prompt-tag prompt-body prompt-handler - <control> control? make-control control-src control-tag control-type control-args + <abort> abort? make-abort abort-src abort-tag abort-args parse-tree-il unparse-tree-il @@ -82,7 +82,7 @@ (<dynwind> winder body unwinder) (<dynlet> fluids vals body) (<prompt> tag body handler) - (<control> tag type args)) + (<abort> tag args)) @@ -182,8 +182,8 @@ ((prompt ,tag ,body ,handler) (make-prompt loc (retrans tag) (retrans body) (retrans handler))) - ((control ,tag ,type ,args) - (make-control loc (retrans tag) type (map retrans args))) + ((abort ,tag ,type ,args) + (make-abort loc (retrans tag) type (map retrans args))) (else (error "unrecognized tree-il" exp))))) @@ -260,8 +260,8 @@ ((<prompt> tag body handler) `(prompt ,tag ,(unparse-tree-il body) ,(unparse-tree-il handler))) - ((<control> tag type args) - `(control ,(unparse-tree-il tag) ,type ,(map unparse-tree-il args))))) + ((<abort> tag args) + `(abort ,(unparse-tree-il tag) ,(map unparse-tree-il args))))) (define (tree-il->scheme e) (record-case e @@ -352,10 +352,8 @@ ,(tree-il->scheme handler))) - ((<control> tag type args) - (case type - ((throw) `(throw ,(tree-il->scheme tag) ,@(map tree-il->scheme args))) - (else (error "bad control type" type)))))) + ((<abort> tag args) + `(@abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args))))) (define (tree-il-fold leaf down up seed tree) @@ -420,7 +418,7 @@ This is an implementation of `foldts' as described by Andy Wingo in (up tree (loop tag (loop body (loop handler (down tree result)))))) - ((<control> tag type args) + ((<abort> tag args) (up tree (loop tag (loop args (down tree result))))) (else (leaf tree result)))))) @@ -489,7 +487,7 @@ This is an implementation of `foldts' as described by Andy Wingo in (let*-values (((seed ...) (foldts tag seed ...)) ((seed ...) (foldts body seed ...))) (foldts handler seed ...))) - ((<control> tag args) + ((<abort> tag args) (let*-values (((seed ...) (foldts tag seed ...))) (fold-values foldts args seed ...))) (else @@ -563,9 +561,9 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (prompt-body x) (lp body)) (set! (prompt-handler x) (lp handler))) - ((<control> tag args) - (set! (control-tag x) (lp tag)) - (set! (control-args x) (map lp args))) + ((<abort> tag args) + (set! (abort-tag x) (lp tag)) + (set! (abort-args x) (map lp args))) (else #f)) @@ -638,9 +636,9 @@ This is an implementation of `foldts' as described by Andy Wingo in (set! (prompt-body x) (lp body)) (set! (prompt-handler x) (lp handler))) - ((<control> tag args) - (set! (control-tag x) (lp tag)) - (set! (control-args x) (map lp args))) + ((<abort> tag args) + (set! (abort-tag x) (lp tag)) + (set! (abort-args x) (map lp args))) (else #f)) x))) |