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:
parent
87a6a23669
commit
a5bbb22e83
5 changed files with 34 additions and 36 deletions
|
@ -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.
|
||||||
|
|
|
@ -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))
|
||||||
{
|
{
|
||||||
|
|
|
@ -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)))))))))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue