Commit | Line | Data |
---|---|---|
b7bff2ba | 1 | /* Copyright (C) 2000, 2001, 2006, 2008, 2009 Free Software Foundation, Inc. |
ce212434 | 2 | * |
73be1d9e | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
4 | * modify it under the terms of the GNU Lesser General Public License |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
ce212434 | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
ce212434 | 12 | * |
73be1d9e MV |
13 | * You should have received a copy of the GNU Lesser General Public |
14 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
73be1d9e | 17 | */ |
ce212434 | 18 | |
dbb605f5 LC |
19 | #ifdef HAVE_CONFIG_H |
20 | # include <config.h> | |
21 | #endif | |
22 | ||
ce212434 GH |
23 | #include "libguile/_scm.h" |
24 | #include "libguile/eval.h" | |
25 | #include "libguile/feature.h" | |
26 | #include "libguile/gc.h" | |
27 | #include "libguile/numbers.h" | |
28 | #include "libguile/ports.h" | |
29 | #include "libguile/root.h" | |
30 | #include "libguile/strings.h" | |
31 | #include "libguile/struct.h" | |
32 | #include "libguile/validate.h" | |
33 | ||
34 | #include "libguile/values.h" | |
35 | ||
752af227 | 36 | SCM scm_values_vtable; |
ce212434 GH |
37 | |
38 | static SCM | |
39 | print_values (SCM obj, SCM pwps) | |
40 | { | |
41 | SCM values = scm_struct_ref (obj, SCM_INUM0); | |
42 | SCM port = SCM_PORT_WITH_PS_PORT (pwps); | |
43 | scm_print_state *ps = SCM_PRINT_STATE (SCM_PORT_WITH_PS_PS (pwps)); | |
44 | ||
9d47027e MV |
45 | scm_puts ("#<values ", port); |
46 | scm_iprin1 (values, port, ps); | |
47 | scm_puts (">", port); | |
48 | ||
ce212434 GH |
49 | return SCM_UNSPECIFIED; |
50 | } | |
51 | ||
52 | SCM_DEFINE (scm_values, "values", 0, 0, 1, | |
53 | (SCM args), | |
54 | "Delivers all of its arguments to its continuation. Except for\n" | |
647e35e2 MG |
55 | "continuations created by the @code{call-with-values} procedure,\n" |
56 | "all continuations take exactly one value. The effect of\n" | |
57 | "passing no value or more than one value to continuations that\n" | |
58 | "were not created by @code{call-with-values} is unspecified.") | |
ce212434 GH |
59 | #define FUNC_NAME s_scm_values |
60 | { | |
c014a02e | 61 | long n; |
ce212434 GH |
62 | SCM result; |
63 | ||
64 | SCM_VALIDATE_LIST_COPYLEN (1, args, n); | |
65 | if (n == 1) | |
66 | result = SCM_CAR (args); | |
67 | else | |
68 | { | |
752af227 | 69 | result = scm_make_struct (scm_values_vtable, SCM_INUM0, |
192de9a4 | 70 | scm_list_1 (args)); |
ce212434 GH |
71 | } |
72 | ||
73 | return result; | |
74 | } | |
75 | #undef FUNC_NAME | |
76 | ||
ce212434 GH |
77 | void |
78 | scm_init_values (void) | |
79 | { | |
df9ca8d8 | 80 | SCM print = scm_c_define_gsubr ("%print-values", 2, 0, 0, print_values); |
ce212434 | 81 | |
b7bff2ba | 82 | scm_values_vtable = scm_make_vtable (scm_from_locale_string ("pr"), print); |
ce212434 GH |
83 | |
84 | scm_add_feature ("values"); | |
85 | ||
ce212434 | 86 | #include "libguile/values.x" |
ce212434 GH |
87 | } |
88 | ||
89 | /* | |
90 | Local Variables: | |
91 | c-file-style: "gnu" | |
92 | End: | |
93 | */ |