Commit | Line | Data |
---|---|---|
2b829bbb | 1 | /* Copyright (C) 2000, 2001, 2006 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 GH |
17 | |
18 | #include "libguile/_scm.h" | |
19 | #include "libguile/eval.h" | |
20 | #include "libguile/feature.h" | |
21 | #include "libguile/gc.h" | |
22 | #include "libguile/numbers.h" | |
23 | #include "libguile/ports.h" | |
24 | #include "libguile/root.h" | |
25 | #include "libguile/strings.h" | |
26 | #include "libguile/struct.h" | |
27 | #include "libguile/validate.h" | |
28 | ||
29 | #include "libguile/values.h" | |
30 | ||
752af227 | 31 | SCM scm_values_vtable; |
ce212434 GH |
32 | |
33 | static SCM | |
34 | print_values (SCM obj, SCM pwps) | |
35 | { | |
36 | SCM values = scm_struct_ref (obj, SCM_INUM0); | |
37 | SCM port = SCM_PORT_WITH_PS_PORT (pwps); | |
38 | scm_print_state *ps = SCM_PRINT_STATE (SCM_PORT_WITH_PS_PS (pwps)); | |
39 | ||
9d47027e MV |
40 | scm_puts ("#<values ", port); |
41 | scm_iprin1 (values, port, ps); | |
42 | scm_puts (">", port); | |
43 | ||
ce212434 GH |
44 | return SCM_UNSPECIFIED; |
45 | } | |
46 | ||
47 | SCM_DEFINE (scm_values, "values", 0, 0, 1, | |
48 | (SCM args), | |
49 | "Delivers all of its arguments to its continuation. Except for\n" | |
647e35e2 MG |
50 | "continuations created by the @code{call-with-values} procedure,\n" |
51 | "all continuations take exactly one value. The effect of\n" | |
52 | "passing no value or more than one value to continuations that\n" | |
53 | "were not created by @code{call-with-values} is unspecified.") | |
ce212434 GH |
54 | #define FUNC_NAME s_scm_values |
55 | { | |
c014a02e | 56 | long n; |
ce212434 GH |
57 | SCM result; |
58 | ||
59 | SCM_VALIDATE_LIST_COPYLEN (1, args, n); | |
60 | if (n == 1) | |
61 | result = SCM_CAR (args); | |
62 | else | |
63 | { | |
752af227 | 64 | result = scm_make_struct (scm_values_vtable, SCM_INUM0, |
192de9a4 | 65 | scm_list_1 (args)); |
ce212434 GH |
66 | } |
67 | ||
68 | return result; | |
69 | } | |
70 | #undef FUNC_NAME | |
71 | ||
ce212434 GH |
72 | void |
73 | scm_init_values (void) | |
74 | { | |
9a441ddb MV |
75 | SCM print = scm_c_define_subr ("%print-values", scm_tc7_subr_2, |
76 | print_values); | |
ce212434 | 77 | |
752af227 | 78 | scm_values_vtable |
cc95e00a MV |
79 | = scm_permanent_object ( |
80 | scm_make_vtable_vtable (scm_from_locale_string ("pr"), | |
81 | SCM_INUM0, SCM_EOL)); | |
82 | ||
752af227 | 83 | SCM_SET_STRUCT_PRINTER (scm_values_vtable, print); |
ce212434 GH |
84 | |
85 | scm_add_feature ("values"); | |
86 | ||
ce212434 | 87 | #include "libguile/values.x" |
ce212434 GH |
88 | } |
89 | ||
90 | /* | |
91 | Local Variables: | |
92 | c-file-style: "gnu" | |
93 | End: | |
94 | */ |