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