1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00

rename goto/args and friends to tail-call, tail-apply, etc

* libguile/vm-i-system.c (tail-call, tail-call/nargs, tail-apply)
  (tail-call/cc): Rename these back to tail-* from goto/*. We should
  reserve the rename-then-goto name for when you actually do a rename
  and goto, not when you shuffle the stack.

* doc/ref/vm.texi:
* module/language/glil/decompile-assembly.scm:
* module/language/tree-il/compile-glil.scm:
* test-suite/tests/tree-il.test: Adapt all callers and documentation.
This commit is contained in:
Andy Wingo 2010-01-03 14:49:40 +01:00
parent 87a6a23669
commit a5bbb22e83
5 changed files with 34 additions and 36 deletions

View file

@ -1,6 +1,6 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual. @c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 2008,2009 @c Copyright (C) 2008,2009,2010
@c Free Software Foundation, Inc. @c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions. @c See the file guile.texi for copying conditions.
@ -678,14 +678,12 @@ and arguments off the stack, and push the result of calling
@code{scm_apply}. @code{scm_apply}.
@end deffn @end deffn
@deffn Instruction goto/args nargs @deffn Instruction tail-call nargs
Like @code{call}, but reusing the current continuation. This Like @code{call}, but reusing the current continuation. This
instruction implements tail calls as required by RnRS. instruction implements tail calls as required by RnRS.
For compiled procedures, that means that @code{goto/args} simply For compiled procedures, that means that @code{tail-call} simply
shuffles down the procedure and arguments to the current stack frame. shuffles down the procedure and arguments to the current stack frame.
The @code{goto/*} instruction family is named as it is because tail
calls are equivalent to @code{goto}, along with relabeled variables.
For non-VM procedures, the result is the same, but the current VM For non-VM procedures, the result is the same, but the current VM
invocation remains on the C stack. True tail calls are not currently invocation remains on the C stack. True tail calls are not currently
@ -693,16 +691,16 @@ possible between compiled and non-compiled procedures.
@end deffn @end deffn
@deffn Instruction apply nargs @deffn Instruction apply nargs
@deffnx Instruction goto/apply nargs @deffnx Instruction tail-apply nargs
Like @code{call} and @code{goto/args}, except that the top item on the Like @code{call} and @code{tail-call}, except that the top item on the
stack must be a list. The elements of that list are then pushed on the stack must be a list. The elements of that list are then pushed on the
stack and treated as additional arguments, replacing the list itself, stack and treated as additional arguments, replacing the list itself,
then the procedure is invoked as usual. then the procedure is invoked as usual.
@end deffn @end deffn
@deffn Instruction call/nargs @deffn Instruction call/nargs
@deffnx Instruction goto/nargs @deffnx Instruction tail-call/nargs
These are like @code{call} and @code{goto/args}, except they take the These are like @code{call} and @code{tail-call}, except they take the
number of arguments from the stack instead of the instruction stream. number of arguments from the stack instead of the instruction stream.
These instructions are used in the implementation of multiple value These instructions are used in the implementation of multiple value
returns, where the actual number of values is pushed on the stack. returns, where the actual number of values is pushed on the stack.
@ -767,7 +765,7 @@ Signals an error if there is an insufficient number of values.
@end deffn @end deffn
@deffn Instruction call/cc @deffn Instruction call/cc
@deffnx Instruction goto/cc @deffnx Instruction tail-call/cc
Capture the current continuation, and then call (or tail-call) the Capture the current continuation, and then call (or tail-call) the
procedure on the top of the stack, with the continuation as the procedure on the top of the stack, with the continuation as the
argument. argument.

View file

@ -1,4 +1,4 @@
/* Copyright (C) 2001,2008,2009 Free Software Foundation, Inc. /* Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -808,11 +808,11 @@ VM_DEFINE_INSTRUCTION (54, call, "call", 1, -1, 1)
goto vm_error_wrong_type_apply; goto vm_error_wrong_type_apply;
} }
VM_DEFINE_INSTRUCTION (55, goto_args, "goto/args", 1, -1, 1) VM_DEFINE_INSTRUCTION (55, tail_call, "tail-call", 1, -1, 1)
{ {
register SCM x; register SCM x;
nargs = FETCH (); nargs = FETCH ();
vm_goto_args: vm_tail_call:
x = sp[-nargs]; x = sp[-nargs];
VM_HANDLE_INTERRUPTS; VM_HANDLE_INTERRUPTS;
@ -850,7 +850,7 @@ VM_DEFINE_INSTRUCTION (55, goto_args, "goto/args", 1, -1, 1)
if (SCM_STRUCTP (x) && SCM_STRUCT_APPLICABLE_P (x)) if (SCM_STRUCTP (x) && SCM_STRUCT_APPLICABLE_P (x))
{ {
sp[-nargs] = SCM_STRUCT_PROCEDURE (x); sp[-nargs] = SCM_STRUCT_PROCEDURE (x);
goto vm_goto_args; goto vm_tail_call;
} }
/* /*
* Other interpreted or compiled call * Other interpreted or compiled call
@ -886,13 +886,13 @@ VM_DEFINE_INSTRUCTION (55, goto_args, "goto/args", 1, -1, 1)
goto vm_error_wrong_type_apply; goto vm_error_wrong_type_apply;
} }
VM_DEFINE_INSTRUCTION (56, goto_nargs, "goto/nargs", 0, 0, 1) VM_DEFINE_INSTRUCTION (56, tail_call_nargs, "tail-call/nargs", 0, 0, 1)
{ {
SCM x; SCM x;
POP (x); POP (x);
nargs = scm_to_int (x); nargs = scm_to_int (x);
/* FIXME: should truncate values? */ /* FIXME: should truncate values? */
goto vm_goto_args; goto vm_tail_call;
} }
VM_DEFINE_INSTRUCTION (57, call_nargs, "call/nargs", 0, 0, 1) VM_DEFINE_INSTRUCTION (57, call_nargs, "call/nargs", 0, 0, 1)
@ -995,7 +995,7 @@ VM_DEFINE_INSTRUCTION (59, apply, "apply", 1, -1, 1)
goto vm_call; goto vm_call;
} }
VM_DEFINE_INSTRUCTION (60, goto_apply, "goto/apply", 1, -1, 1) VM_DEFINE_INSTRUCTION (60, tail_apply, "tail-apply", 1, -1, 1)
{ {
int len; int len;
SCM ls; SCM ls;
@ -1011,7 +1011,7 @@ VM_DEFINE_INSTRUCTION (60, goto_apply, "goto/apply", 1, -1, 1)
PUSH_LIST (ls, SCM_NULL_OR_NIL_P); PUSH_LIST (ls, SCM_NULL_OR_NIL_P);
nargs += len - 2; nargs += len - 2;
goto vm_goto_args; goto vm_tail_call;
} }
VM_DEFINE_INSTRUCTION (61, call_cc, "call/cc", 0, 1, 1) VM_DEFINE_INSTRUCTION (61, call_cc, "call/cc", 0, 1, 1)
@ -1051,7 +1051,7 @@ VM_DEFINE_INSTRUCTION (61, call_cc, "call/cc", 0, 1, 1)
} }
} }
VM_DEFINE_INSTRUCTION (62, goto_cc, "goto/cc", 0, 1, 1) VM_DEFINE_INSTRUCTION (62, tail_call_cc, "tail-call/cc", 0, 1, 1)
{ {
int first; int first;
SCM proc, cont; SCM proc, cont;
@ -1065,7 +1065,7 @@ VM_DEFINE_INSTRUCTION (62, goto_cc, "goto/cc", 0, 1, 1)
PUSH (proc); PUSH (proc);
PUSH (cont); PUSH (cont);
nargs = 1; nargs = 1;
goto vm_goto_args; goto vm_tail_call;
} }
else if (SCM_VALUESP (cont)) else if (SCM_VALUESP (cont))
{ {

View file

@ -1,6 +1,6 @@
;;; Guile VM code converters ;;; Guile VM code converters
;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -183,9 +183,9 @@
(cons (make-glil-call 'mul 2) (cons (make-glil-call 'mul 2)
(emit-constants (list-head stack 2) out)) (emit-constants (list-head stack 2) out))
(+ pos 1))) (+ pos 1)))
((goto/args ,n) ((tail-call ,n)
(lp (cdr in) (list-tail stack (1+ n)) (lp (cdr in) (list-tail stack (1+ n))
(cons (make-glil-call 'goto/args n) (cons (make-glil-call 'tail-call n)
(emit-constants (list-head stack (1+ n)) out)) (emit-constants (list-head stack (1+ n)) out))
(+ pos 2))) (+ pos 2)))
(else (error "unsupported decompilation" (car in))))))))) (else (error "unsupported decompilation" (car in)))))))))

View file

@ -1,6 +1,6 @@
;;; TREE-IL -> GLIL compiler ;;; TREE-IL -> GLIL compiler
;; Copyright (C) 2001,2008,2009 Free Software Foundation, Inc. ;; Copyright (C) 2001,2008,2009,2010 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -277,7 +277,7 @@
((tail) ((tail)
(comp-push proc) (comp-push proc)
(for-each comp-push args) (for-each comp-push args)
(emit-code src (make-glil-call 'goto/apply (1+ (length args))))) (emit-code src (make-glil-call 'tail-apply (1+ (length args)))))
((push) ((push)
(emit-code src (make-glil-call 'new-frame 0)) (emit-code src (make-glil-call 'new-frame 0))
(comp-push proc) (comp-push proc)
@ -344,12 +344,12 @@
(comp-push producer) (comp-push producer)
(emit-code src (make-glil-mv-call 0 MV)) (emit-code src (make-glil-mv-call 0 MV))
(case context (case context
((tail) (emit-code src (make-glil-call 'goto/args 1))) ((tail) (emit-code src (make-glil-call 'tail-call 1)))
(else (emit-code src (make-glil-call 'call 1)) (else (emit-code src (make-glil-call 'call 1))
(emit-branch #f 'br POST))) (emit-branch #f 'br POST)))
(emit-label MV) (emit-label MV)
(case context (case context
((tail) (emit-code src (make-glil-call 'goto/nargs 0))) ((tail) (emit-code src (make-glil-call 'tail-call/nargs 0)))
(else (emit-code src (make-glil-call 'call/nargs 0)) (else (emit-code src (make-glil-call 'call/nargs 0))
(emit-label POST) (emit-label POST)
(if (eq? context 'drop) (if (eq? context 'drop)
@ -362,7 +362,7 @@
(case context (case context
((tail) ((tail)
(comp-push (car args)) (comp-push (car args))
(emit-code src (make-glil-call 'goto/cc 1))) (emit-code src (make-glil-call 'tail-call/cc 1)))
((vals) ((vals)
(comp-vals (comp-vals
(make-application (make-application
@ -482,7 +482,7 @@
(for-each comp-push args) (for-each comp-push args)
(let ((len (length args))) (let ((len (length args)))
(case context (case context
((tail) (emit-code src (make-glil-call 'goto/args len))) ((tail) (emit-code src (make-glil-call 'tail-call len)))
((push) (emit-code src (make-glil-call 'call len)) ((push) (emit-code src (make-glil-call 'call len))
(maybe-emit-return)) (maybe-emit-return))
((vals) (emit-code src (make-glil-mv-call len MVRA)) ((vals) (emit-code src (make-glil-mv-call len MVRA))

View file

@ -1,7 +1,7 @@
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*- ;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
;;;; Andy Wingo <wingo@pobox.com> --- May 2009 ;;;; Andy Wingo <wingo@pobox.com> --- May 2009
;;;; ;;;;
;;;; Copyright (C) 2009 Free Software Foundation, Inc. ;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -69,7 +69,7 @@
(with-test-prefix "application" (with-test-prefix "application"
(assert-tree-il->glil (assert-tree-il->glil
(apply (toplevel foo) (const 1)) (apply (toplevel foo) (const 1))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (const 1) (call goto/args 1))) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (const 1) (call tail-call 1)))
(assert-tree-il->glil (assert-tree-il->glil
(begin (apply (toplevel foo) (const 1)) (void)) (begin (apply (toplevel foo) (const 1)) (void))
(program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1) (program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
@ -81,7 +81,7 @@
(assert-tree-il->glil (assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel bar))) (apply (toplevel foo) (apply (toplevel bar)))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
(call goto/args 1)))) (call tail-call 1))))
(with-test-prefix "conditional" (with-test-prefix "conditional"
(assert-tree-il->glil (assert-tree-il->glil
@ -457,7 +457,7 @@
(with-test-prefix "apply" (with-test-prefix "apply"
(assert-tree-il->glil (assert-tree-il->glil
(apply (primitive @apply) (toplevel foo) (toplevel bar)) (apply (primitive @apply) (toplevel foo) (toplevel bar))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2))) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call tail-apply 2)))
(assert-tree-il->glil (assert-tree-il->glil
(begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void)) (begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
(program () (std-prelude 0 0 #f) (label _) (program () (std-prelude 0 0 #f) (label _)
@ -471,12 +471,12 @@
(program () (std-prelude 0 0 #f) (label _) (program () (std-prelude 0 0 #f) (label _)
(toplevel ref foo) (toplevel ref foo)
(call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2) (call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2)
(call goto/args 1)))) (call tail-call 1))))
(with-test-prefix "call/cc" (with-test-prefix "call/cc"
(assert-tree-il->glil (assert-tree-il->glil
(apply (primitive @call-with-current-continuation) (toplevel foo)) (apply (primitive @call-with-current-continuation) (toplevel foo))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call goto/cc 1))) (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call tail-call/cc 1)))
(assert-tree-il->glil (assert-tree-il->glil
(begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void)) (begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
(program () (std-prelude 0 0 #f) (label _) (program () (std-prelude 0 0 #f) (label _)
@ -491,7 +491,7 @@
(program () (std-prelude 0 0 #f) (label _) (program () (std-prelude 0 0 #f) (label _)
(toplevel ref foo) (toplevel ref foo)
(toplevel ref bar) (call call/cc 1) (toplevel ref bar) (call call/cc 1)
(call goto/args 1)))) (call tail-call 1))))
(with-test-prefix "tree-il-fold" (with-test-prefix "tree-il-fold"