combinators.c 5.54 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
/* combinators.c
 *
 * Builtin combinator functions (S, K, ...)
 *
 * $Id$ */

/* lsh, an implementation of the ssh protocol
 *
 * Copyright (C) 1998 Niels Möller
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License as
 * published by the Free Software Foundation; either version 2 of the
 * License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

#include "command.h"
27
#include "werror.h"
Niels Möller's avatar
Niels Möller committed
28
#include "xalloc.h"
29
30
31

#include <assert.h>

Niels Möller's avatar
Niels Möller committed
32
33
#include "combinators.c.x"

34
35
36
/* Combinators */

/* Ix == x */
37
38
39
40
41
42
43
44
DEFINE_COMMAND(command_I)
     (struct command *s UNUSED,
      struct lsh_object *a,
      struct command_continuation *c,
      struct exception_handler *e UNUSED)
{
  COMMAND_RETURN(c, a);
}
45
46
47


/* ((K x) y) == x */
48
DEFINE_COMMAND2(command_K)
49
50
     (struct command_2 *s UNUSED,
      struct lsh_object *x,
51
52
53
54
55
56
57
      struct lsh_object *y UNUSED,
      struct command_continuation *c,
      struct exception_handler *e UNUSED)
{
  COMMAND_RETURN(c, x);
}
      
58

Niels Möller's avatar
Niels Möller committed
59
/* ((S f) g) x == (f x)(g x) */
60
61

/* Receives the value of (f x) */
62
63
64
65
66
67
68
69
70
/* GABA:
   (class
     (name command_S_continuation)
     (super command_frame)
     (vars
       (g object command)
       (x object lsh_object)))
*/

Niels Möller's avatar
Niels Möller committed
71
72
73
static void
do_command_S_continuation(struct command_continuation *c,
			  struct lsh_object *value)
74
75
76
{
  CAST(command_S_continuation, self, c);
  CAST_SUBTYPE(command, op, value);
Niels Möller's avatar
Niels Möller committed
77
78
79
  COMMAND_CALL(self->g, self->x,
	       make_apply(op, self->super.up, self->super.e),
	       self->super.e);
80
81
}

82
83
84
static struct command_continuation *
make_command_S_continuation(struct command *g,
			    struct lsh_object *x,
85
86
			    struct command_continuation *up,
			    struct exception_handler *e)
87
88
{
  NEW(command_S_continuation, c);
89
  c->g = g;
90
91
  c->x = x;
  c->super.up = up;
92
  c->super.e = e;
93
  c->super.super.c = do_command_S_continuation;
94
95
96
97

  return &c->super.super;
}

98
99
100
101
102
103
104
105
106
107
108
109
110
111
DEFINE_COMMAND3(command_S)
     (struct lsh_object *f,
      struct lsh_object *g,
      struct lsh_object *x,
      struct command_continuation *c,
      struct exception_handler *e)
{
  CAST_SUBTYPE(command, cf, f);
  CAST_SUBTYPE(command, cg, g);

  COMMAND_CALL(cf, x,
	       make_command_S_continuation(cg, x, c, e),
	       e);
}
112

Niels Möller's avatar
Niels Möller committed
113
/* S' k f g x == k (f x) (g x) */
114

Niels Möller's avatar
Niels Möller committed
115
116
117
118
119
120
121
122
123
124
125
126
DEFINE_COMMAND4(command_Sp)
     (struct lsh_object *k,
      struct lsh_object *f,
      struct lsh_object *g,
      struct lsh_object *x,
      struct command_continuation *c,
      struct exception_handler *e)
{
  CAST_SUBTYPE(command, ck, k);
  CAST_SUBTYPE(command, cf, f);
  CAST_SUBTYPE(command, cg, g);

127
128
  trace("command_Sp\n");
  
Niels Möller's avatar
Niels Möller committed
129
130
131
132
133
134
  COMMAND_CALL(cf, x,
	       make_apply(ck,
			  make_command_S_continuation(cg,
						      x, c, e),
			  e),
	       e);
135
136
}

Niels Möller's avatar
Niels Möller committed
137

138
/* B f g x == f (g x) */
Niels Möller's avatar
Niels Möller committed
139
140
141
142
143
144
145
146
147
DEFINE_COMMAND3(command_B)
     (struct lsh_object *f,
      struct lsh_object *g,
      struct lsh_object *x,
      struct command_continuation *c,
      struct exception_handler *e)
{
  CAST_SUBTYPE(command, cf, f);
  CAST_SUBTYPE(command, cg, g);
148

149
150
151
  trace("command_B, f = %xi, cf = %xi, g = %xi, cg = %xi\n",
        f, cf, g, cg);
  
Niels Möller's avatar
Niels Möller committed
152
153
154
155
  COMMAND_CALL(cg, x,
	       make_apply(cf, c, e), e);
}

156

Niels Möller's avatar
Niels Möller committed
157
158
159
160
161
162
163
164
165
166
167
168
/* B' k f g x == k (f (g x)) */
DEFINE_COMMAND4(command_Bp)
     (struct lsh_object *k,
      struct lsh_object *f,
      struct lsh_object *g,
      struct lsh_object *x,
      struct command_continuation *c,
      struct exception_handler *e)
{
  CAST_SUBTYPE(command, ck, k);
  CAST_SUBTYPE(command, cf, f);
  CAST_SUBTYPE(command, cg, g);
169

170
171
  trace("command_Bp\n");

Niels Möller's avatar
Niels Möller committed
172
173
174
175
176
  COMMAND_CALL(cg, x,
	       make_apply(cf,
			  make_apply(ck, c, e), e),
	       e);
}
177

Niels Möller's avatar
Niels Möller committed
178

179
180
181
182
/* ((C f) y) x == (f x) y  */

/* GABA:
   (class
Niels Möller's avatar
Niels Möller committed
183
     (name command_C_continuation)
184
185
186
187
188
     (super command_frame)
     (vars
       (y object lsh_object)))
*/

Niels Möller's avatar
Niels Möller committed
189
190
191
static void
do_command_C_continuation(struct command_continuation *c,
			  struct lsh_object *value)
192
{
Niels Möller's avatar
Niels Möller committed
193
  CAST(command_C_continuation, self, c);
194
  CAST_SUBTYPE(command, op, value);
195
  
Niels Möller's avatar
Niels Möller committed
196
  COMMAND_CALL(op, self->y, self->super.up, self->super.e);
197
198
}

199
200
static struct command_continuation *
make_command_C_continuation(struct lsh_object *y,
201
202
			    struct command_continuation *up,
			    struct exception_handler *e)
203
204
{
  NEW(command_C_continuation, c);
205
  c->y = y;
206
  c->super.up = up;
207
  c->super.e = e;
Niels Möller's avatar
Niels Möller committed
208
209
  c->super.super.c = do_command_C_continuation;
  
210
211
212
  return &c->super.super;
}

213
214
215
216
217
218
DEFINE_COMMAND3(command_C)
     (struct lsh_object *f,
      struct lsh_object *y,
      struct lsh_object *x,
      struct command_continuation *c,
      struct exception_handler *e)
219
{
220
  CAST_SUBTYPE(command, cf, f);
221

222
  trace("command_C\n");
223

224
225
226
  COMMAND_CALL(cf, x,
	       make_command_C_continuation(y, c, e),
	       e);
227
228
}

229

230
231
232
233
234
/* C' k f y x == k (f x) y */
DEFINE_COMMAND4(command_Cp)
     (struct lsh_object *k,
      struct lsh_object *f,
      struct lsh_object *y,
235
      struct lsh_object *x,
236
237
      struct command_continuation *c,
      struct exception_handler *e)
238
{
239
  CAST_SUBTYPE(command, ck, k);
240
  CAST_SUBTYPE(command, cf, f);
241
242

  trace("command_Cp\n");
Niels Möller's avatar
Niels Möller committed
243
244
245
246
247

#if 0
  werror("command_Cp: k: %t, f: %t, y: %t, x: %t\n",
	 k, f, y, x);
#endif
248
  
249
250
251
252
  COMMAND_CALL(cf, x,
	       make_apply(ck,
			  make_command_C_continuation(y, c, e), e),
	       e);
253
}