Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
LSH
lsh
Commits
90cb7878
Commit
90cb7878
authored
Mar 19, 1999
by
Niels Möller
Browse files
Moved implementation of combinators to a separate file.
Rev: src/combinators.c:1.1 Rev: src/command.c:1.12
parent
913fe8d0
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/combinators.c
0 → 100644
View file @
90cb7878
/* 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"
#include <assert.h>
/* Combinators */
/* Ix == x */
static
struct
lsh_object
*
do_simple_command_I
(
struct
command_simple
*
ignored
UNUSED
,
struct
lsh_object
*
arg
)
{
return
arg
;
}
struct
command_simple
command_I
=
STATIC_COMMAND_SIMPLE
(
do_simple_command_I
);
/* ((K x) y) == x */
/* Represents (K x) */
/* GABA:
(class
(name command_K_1)
(super command_simple)
(vars
(x object lsh_object)))
*/
static
struct
lsh_object
*
do_simple_command_K_1
(
struct
command_simple
*
s
,
struct
lsh_object
*
ignored
UNUSED
)
{
CAST
(
command_K_1
,
self
,
s
);
return
self
->
x
;
}
struct
command
*
make_command_K_1
(
struct
lsh_object
*
x
)
{
NEW
(
command_K_1
,
res
);
res
->
x
=
x
;
res
->
super
.
super
.
call
=
do_call_simple_command
;
res
->
super
.
call_simple
=
do_simple_command_K_1
;
return
&
res
->
super
.
super
;
}
static
struct
lsh_object
*
do_simple_command_K
(
struct
command_simple
*
ignored
UNUSED
,
struct
lsh_object
*
a
)
{
return
&
make_command_K_1
(
a
)
->
super
;
}
struct
command_simple
command_K
=
STATIC_COMMAND_SIMPLE
(
do_simple_command_K
);
/* ((S f) g)x == (f x)(g x) */
/* Continuation called after evaluating (f x) */
/* GABA:
(class
(name command_S_continuation)
(super command_frame)
(vars
(g object command)
(x object lsh_object)))
*/
static
int
do_command_S_continuation
(
struct
command_continuation
*
c
,
struct
lsh_object
*
value
)
{
CAST
(
command_S_continuation
,
self
,
c
);
CAST_SUBTYPE
(
command
,
op
,
value
);
return
COMMAND_CALL
(
self
->
g
,
self
->
x
,
make_apply
(
op
,
self
->
super
.
up
));
}
/* Represents ((S f) g) */
/* GABA:
(class
(name command_S_2)
(super command_simple)
(vars
(f object command)
(g object command)))
*/
static
int
do_command_S_2
(
struct
command
*
s
,
struct
lsh_object
*
x
,
struct
command_continuation
*
up
)
{
CAST
(
command_S_2
,
self
,
s
);
NEW
(
command_S_continuation
,
c
);
c
->
g
=
self
->
g
;
c
->
x
=
x
;
c
->
super
.
up
=
up
;
c
->
super
.
super
.
c
=
do_command_S_continuation
;
return
COMMAND_CALL
(
self
->
f
,
x
,
&
c
->
super
.
super
);
}
static
struct
lsh_object
*
do_simple_command_S_2
(
struct
command_simple
*
s
,
struct
lsh_object
*
x
)
{
CAST
(
command_S_2
,
self
,
s
);
CAST_SUBTYPE
(
command_simple
,
fs
,
self
->
f
);
CAST_SUBTYPE
(
command_simple
,
gs
,
self
->
g
);
CAST_SUBTYPE
(
command_simple
,
op
,
COMMAND_SIMPLE
(
fs
,
x
));
return
COMMAND_SIMPLE
(
op
,
COMMAND_SIMPLE
(
gs
,
x
));
}
struct
command
*
make_command_S_2
(
struct
command
*
f
,
struct
command
*
g
)
{
NEW
(
command_S_2
,
res
);
res
->
f
=
f
;
res
->
g
=
g
;
res
->
super
.
super
.
call
=
do_command_S_2
;
res
->
super
.
call_simple
=
do_simple_command_S_2
;
return
&
res
->
super
.
super
;
}
static
struct
lsh_object
*
collect_S_2
(
struct
collect_info_2
*
info
,
struct
lsh_object
*
f
,
struct
lsh_object
*
g
)
{
CAST_SUBTYPE
(
command
,
cf
,
f
);
CAST_SUBTYPE
(
command
,
cg
,
g
);
assert
(
!
info
);
return
&
make_command_S_2
(
cf
,
cg
)
->
super
;
}
struct
collect_info_2
collect_info_S_2
=
STATIC_COLLECT_2_FINAL
(
collect_S_2
);
struct
collect_info_1
command_S
=
STATIC_COLLECT_1
(
&
collect_info_S_2
);
/* ((B f) g) x == (f (g x)) */
/* Represents ((B f) g) */
/* GABA:
(class
(name command_B_2)
(super command_simple)
(vars
(f object command)
(g object command)))
*/
static
int
do_command_B_2
(
struct
command
*
s
,
struct
lsh_object
*
x
,
struct
command_continuation
*
c
)
{
CAST
(
command_B_2
,
self
,
s
);
return
COMMAND_CALL
(
self
->
g
,
x
,
make_apply
(
self
->
f
,
c
));
}
static
struct
lsh_object
*
do_simple_command_B_2
(
struct
command_simple
*
s
,
struct
lsh_object
*
x
)
{
CAST
(
command_B_2
,
self
,
s
);
CAST_SUBTYPE
(
command_simple
,
fs
,
self
->
f
);
CAST_SUBTYPE
(
command_simple
,
gs
,
self
->
g
);
return
COMMAND_SIMPLE
(
fs
,
COMMAND_SIMPLE
(
gs
,
x
));
}
static
struct
command
*
make_command_B_2
(
struct
command
*
f
,
struct
command
*
g
)
{
NEW
(
command_B_2
,
res
);
res
->
f
=
f
;
res
->
g
=
g
;
res
->
super
.
super
.
call
=
do_command_B_2
;
res
->
super
.
call_simple
=
do_simple_command_B_2
;
return
&
res
->
super
.
super
;
}
static
struct
lsh_object
*
collect_B_2
(
struct
collect_info_2
*
info
,
struct
lsh_object
*
f
,
struct
lsh_object
*
g
)
{
CAST_SUBTYPE
(
command
,
cf
,
f
);
CAST_SUBTYPE
(
command
,
cg
,
g
);
assert
(
!
info
);
return
&
make_command_B_2
(
cf
,
cg
)
->
super
;
}
struct
collect_info_2
collect_info_B_2
=
STATIC_COLLECT_2_FINAL
(
collect_B_2
);
struct
collect_info_1
command_B
=
STATIC_COLLECT_1
(
&
collect_info_B_2
);
/* ((C f) y) x == (f x) y */
/* Represents ((C f) g) */
/* GABA:
(class
(name command_C_2)
(super command_simple)
(vars
(f object command)
(y object command)))
*/
/* GABA:
(class
(name command_S_continuation)
(super command_frame)
(vars
(y object lsh_object)))
*/
static
int
do_command_B_continuation
(
struct
command_continuation
*
c
,
struct
lsh_object
*
value
)
{
CAST
(
command_B_continuation
,
self
,
c
);
CAST_SUBTYPE
(
command
,
op
,
value
);
return
COMMAND_CALL
(
op
,
self
->
y
,
self
->
super
.
up
);
}
static
int
do_command_C_2
(
struct
command
*
s
,
struct
lsh_object
*
x
,
struct
command_continuation
*
up
)
{
CAST
(
command_C_2
,
self
,
s
);
NEW
(
command_C_continuation
,
c
);
c
->
y
=
self
->
y
;
c
->
super
.
up
=
up
;
return
COMMAND_CALL
(
self
->
f
,
x
,
c
);
}
static
struct
lsh_object
*
do_simple_command_C_2
(
struct
command_simple
*
s
,
struct
lsh_object
*
x
)
{
CAST
(
command_C_2
,
self
,
s
);
CAST_SUBTYPE
(
command_simple
,
f
,
self
->
f
);
CAST_SUBTYPE
(
command_simple
,
v
,
COMMAND_SIMPLE
(
f
,
x
));
return
COMMAND_SIMPLE
(
v
,
self
->
y
);
}
static
struct
command
*
make_command_C_2
(
struct
command
*
f
,
struct
lsh_object
*
y
)
{
NEW
(
command_C_2
,
res
);
res
->
f
=
f
;
res
->
y
=
y
;
res
->
super
.
super
.
call
=
do_command_C_2
;
res
->
super
.
call_simple
=
do_simple_command_C_2
;
return
&
res
->
super
.
super
;
}
static
struct
lsh_object
*
collect_C_2
(
struct
collect_info_2
*
info
,
struct
lsh_object
*
f
,
struct
lsh_object
*
y
)
{
CAST_SUBTYPE
(
command
,
cf
,
f
);
assert
(
!
info
);
return
&
make_command_B_2
(
cf
,
y
)
->
super
;
}
struct
collect_info_2
collect_info_C_2
=
STATIC_COLLECT_2_FINAL
(
collect_C_2
);
struct
collect_info_1
command_C
=
STATIC_COLLECT_1
(
&
collect_info_C_2
);
src/command.c
View file @
90cb7878
/* command.
h
/* command.
c
*
* $Id$ */
...
...
@@ -202,232 +202,9 @@ make_collect_state_3(struct collect_info_3 *info,
return
&
self
->
super
.
super
.
super
;
}
/* Combinators */
/* Ix == x */
static
struct
lsh_object
*
do_simple_command_I
(
struct
command_simple
*
ignored
UNUSED
,
struct
lsh_object
*
arg
)
{
return
arg
;
}
struct
command_simple
command_I
=
STATIC_COMMAND_SIMPLE
(
do_simple_command_I
);
/* ((K x) y) == x */
/* Represents (K x) */
/* GABA:
(class
(name command_K_1)
(super command_simple)
(vars
(x object lsh_object)))
*/
static
struct
lsh_object
*
do_simple_command_K_1
(
struct
command_simple
*
s
,
struct
lsh_object
*
ignored
UNUSED
)
{
CAST
(
command_K_1
,
self
,
s
);
return
self
->
x
;
}
struct
command
*
make_command_K_1
(
struct
lsh_object
*
x
)
{
NEW
(
command_K_1
,
res
);
res
->
x
=
x
;
res
->
super
.
super
.
call
=
do_call_simple_command
;
res
->
super
.
call_simple
=
do_simple_command_K_1
;
return
&
res
->
super
.
super
;
}
static
struct
lsh_object
*
do_simple_command_K
(
struct
command_simple
*
ignored
UNUSED
,
struct
lsh_object
*
a
)
{
return
&
make_command_K_1
(
a
)
->
super
;
}
struct
command_simple
command_K
=
STATIC_COMMAND_SIMPLE
(
do_simple_command_K
);
/* ((S f) g)x == (f x)(g x) */
/* Continuation called after evaluating (f x) */
/* GABA:
(class
(name command_S_continuation)
(super command_frame)
(vars
(g object command)
(x object lsh_object)))
*/
static
int
do_command_S_continuation
(
struct
command_continuation
*
c
,
struct
lsh_object
*
value
)
{
CAST
(
command_S_continuation
,
self
,
c
);
CAST_SUBTYPE
(
command
,
op
,
value
);
return
COMMAND_CALL
(
self
->
g
,
self
->
x
,
make_apply
(
op
,
self
->
super
.
up
));
}
/* Represents ((S f) g) */
/* GABA:
(class
(name command_S_2)
(super command_simple)
(vars
(f object command)
(g object command)))
*/
static
int
do_command_S_2
(
struct
command
*
s
,
struct
lsh_object
*
x
,
struct
command_continuation
*
up
)
{
CAST
(
command_S_2
,
self
,
s
);
NEW
(
command_S_continuation
,
c
);
c
->
g
=
self
->
g
;
c
->
x
=
x
;
c
->
super
.
up
=
up
;
c
->
super
.
super
.
c
=
do_command_S_continuation
;
return
COMMAND_CALL
(
self
->
f
,
x
,
&
c
->
super
.
super
);
}
static
struct
lsh_object
*
do_simple_command_S_2
(
struct
command_simple
*
s
,
struct
lsh_object
*
x
)
{
CAST
(
command_S_2
,
self
,
s
);
CAST_SUBTYPE
(
command_simple
,
fs
,
self
->
f
);
CAST_SUBTYPE
(
command_simple
,
gs
,
self
->
g
);
CAST_SUBTYPE
(
command_simple
,
op
,
COMMAND_SIMPLE
(
fs
,
x
));
return
COMMAND_SIMPLE
(
op
,
COMMAND_SIMPLE
(
gs
,
x
));
}
struct
command
*
make_command_S_2
(
struct
command
*
f
,
struct
command
*
g
)
{
NEW
(
command_S_2
,
res
);
res
->
f
=
f
;
res
->
g
=
g
;
res
->
super
.
super
.
call
=
do_command_S_2
;
res
->
super
.
call_simple
=
do_simple_command_S_2
;
return
&
res
->
super
.
super
;
}
static
struct
lsh_object
*
collect_S_2
(
struct
collect_info_2
*
info
,
struct
lsh_object
*
f
,
struct
lsh_object
*
g
)
{
CAST_SUBTYPE
(
command
,
cf
,
f
);
CAST_SUBTYPE
(
command
,
cg
,
g
);
assert
(
!
info
);
return
&
make_command_S_2
(
cf
,
cg
)
->
super
;
}
struct
collect_info_2
collect_info_S_2
=
STATIC_COLLECT_2_FINAL
(
collect_S_2
);
struct
collect_info_1
command_S
=
STATIC_COLLECT_1
(
&
collect_info_S_2
);
#if 0
/* Represents (S f) */
/* GABA:
(class
(name command_S_1)
(super command_simple)
(vars
(f object command)))
*/
static struct lsh_object *
do_simple_command_S_1(struct command_simple *s,
struct lsh_object *a)
{
CAST(command_S_1, self, s);
CAST_SUBTYPE(command, arg, a);
return &make_command_S_2(self->f, arg)->super;
}
struct command *make_command_S_1(struct command *f)
{
NEW(command_S_1, res);
res->f = f;
res->super.super.call = do_call_simple_command;
res->super.call_simple = do_simple_command_S_1;
return &res->super.super;
}
static struct lsh_object *
do_simple_command_S(struct command_simple *ignored UNUSED,
struct lsh_object *a)
{
CAST_SUBTYPE(command, arg, a);
return &make_command_S_1(arg)->super;
}
struct command_simple command_S = STATIC_COMMAND_SIMPLE(do_simple_command_S);
struct lsh_object *gaba_apply_S_1(struct lsh_object *f)
{
CAST_SUBTYPE(command, cf, f);
return &make_command_S_1(cf)->super;
}
#endif
#if 0
/* ((B f) g) x == (f (g x)) */
/* Represents ((B f) g) */
/* GABA:
(class
(name command_B_2)
(super command_simple)
(vars
(f object command)
(g object command)))
*/
static int do_command_B_2(struct command *s,
struct lsh_object *x,
struct command_continuation *c)
{
CAST(command_B_2, self, s);
return COMMAND_CALL(self->g, x, make_apply(self->f, c));
}
static struct lsh_object *do_simple_command_B_2(struct command_simple *s,
struct lsh_object *x)
{
CAST(command_B_2, self, s);
CAST_SUBTYPE(command_simple, fs, self->f);
CAST_SUBTYPE(command_simple, gs, self->g);
return COMMAND_SIMPLE(fs, COMMAND_SIMPLE(gs, x));
}
static struct command *
make_command_B_2(struct command *f,
struct command *g)
{
NEW(command_B_2, res);
res->f = f;
res->g = g;
res->super.super.call = do_command_B_2;
res->super.call_simple = do_simple_command_B_2;
return &res->super.super;
}
/* Represents (B f) */
/* GABA:
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment