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 | |
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.
-rw-r--r-- | libguile/vm-i-system.c | 6 | ||||
-rw-r--r-- | libguile/vm.c | 4 | ||||
-rw-r--r-- | module/language/tree-il.scm | 34 | ||||
-rw-r--r-- | module/language/tree-il/analyze.scm | 4 | ||||
-rw-r--r-- | module/language/tree-il/compile-glil.scm | 9 | ||||
-rw-r--r-- | module/language/tree-il/primitives.scm | 6 |
6 files changed, 29 insertions, 34 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 15e339492..c72b84d0e 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1508,7 +1508,7 @@ VM_DEFINE_INSTRUCTION (85, wind, "wind", 0, 2, 0) NEXT; } -VM_DEFINE_INSTRUCTION (86, throw, "throw", 1, -1, -1) +VM_DEFINE_INSTRUCTION (86, abort, "abort", 1, -1, -1) { unsigned n = FETCH (); SCM k; @@ -1517,8 +1517,8 @@ VM_DEFINE_INSTRUCTION (86, throw, "throw", 1, -1, -1) POP (args); POP (k); SYNC_REGISTER (); - vm_throw (vm, k, args); - /* vm_throw should not return */ + vm_abort (vm, k, args); + /* vm_abort should not return */ abort (); } diff --git a/libguile/vm.c b/libguile/vm.c index 66d89a4fe..c8dd07eab 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -207,9 +207,9 @@ vm_dispatch_hook (SCM vm, int hook_num) */ #define VM_SETJMP(jmpbuf) 0 -static void vm_throw (SCM vm, SCM k, SCM args) SCM_NORETURN; +static void vm_abort (SCM vm, SCM tag, SCM args) SCM_NORETURN; static void -vm_throw (SCM vm, SCM k, SCM args) +vm_abort (SCM vm, SCM tag, SCM args) { abort (); } 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))) diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 3363103e0..2d1a25289 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -345,7 +345,7 @@ ((<prompt> tag body handler) (lset-union eq? (step tag) (step handler))) - ((<control> tag type args) + ((<abort> tag args) (apply lset-union eq? (step tag) (map step args))) (else '()))) @@ -513,7 +513,7 @@ (and cont-var (zero? (hashq-ref refcounts cont-var 0)))) (max (recur tag) (recur body) (recur handler)))) - ((<control> tag type args) + ((<abort> tag args) (apply max (recur tag) (map recur args))) (else n))) diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index d85de2aa2..85c9c116e 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -1118,10 +1118,7 @@ (and (eq? context 'drop) (not RA))) (emit-label POST)))) - ((<control> src tag type args) + ((<abort> src tag args) (comp-push tag) - (case type - ((throw) - (for-each comp-push args) - (emit-code src (make-glil-call 'throw (length args)))) - (else (error "bad control type" x))))))) + (for-each comp-push args) + (emit-code src (make-glil-call 'abort (length args))))))) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 76bc88b7c..48cb03c04 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -439,11 +439,11 @@ 'control (case-lambda ((src tag . args) - (make-control src tag 'throw args)) + (make-abort src tag args)) (else #f))) (hashq-set! *primitive-expand-table* '@control (case-lambda - ((src tag type . args) - (make-control src tag (if (const? type) (const-exp type) (error "what ho" type)) args)) + ((src tag . args) + (make-abort src tag args)) (else #f))) |