* src/command.c (make_apply): New function.

Implemented the S and B combinators (no idea if they will turn out
to be useful), and a listen function.

Rev: src/command.c:1.2
Rev: src/command.h:1.4

src/command.c

@@ -23,9 +23,199 @@
 
 #include "command.h"
 
+#include "connection.h"
+#include "io.h"
+#include "xalloc.h"
+
+#define CLASS_DEFINE
+#include "command.h.x"
+#undef CLASS_DEFINE
+
+#include "command.c.x"
+
+/* CLASS:
+   (class
+     (name command_apply)
+     (super command_frame)
+     (vars
+       (f object command)))
+*/
+
+static int do_command_apply(struct command_continuation *s,
+			    struct lsh_object *value)
+{
+  CAST(command_apply, self, s);
+  return COMMAND_CALL(self->f, value, self->super.up);
+}
+
+struct command_continuation *
+make_apply(struct command *f, struct command_continuation *c)
+{
+  NEW(command_apply, res);
+  res->f = f;
+  res->super.up = c;
+  res->super.super.c = do_command_apply;
+
+  return &res->super.super;
+}
+    
+/* Combinators */
+
+/* Ix == x */
+static int do_command_I(struct command *ignored UNUSED,
+			struct lsh_object *arg,
+			struct command_continuation *c)			
+{
+  return COMMAND_RETURN(c, arg);
+}
+
+struct command command_I =
+{ STATIC_HEADER, do_command_I };
+
+/* ((S f) g)x == (f x)(g x) */
+
+/* Represents (S f) */
+/* CLASS:
+   (class
+     (name command_S_1)
+     (super command)
+     (vars
+       (f object command)))
+*/
+
+/* Represents ((S f) g) */
+/* CLASS:
+   (class
+     (name command_S_2)
+     (super command)
+     (vars
+       (f object command)
+       (g object command)))
+*/
+
+/* Continuation called after evaluating (f x) */
+/* CLASS:
+   (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));
+}
+
+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 int do_command_S_1(struct command *s,
+			  struct lsh_object *a,
+			  struct command_continuation *c)
+			  
+{
+  CAST(command_S_1, self, s);
+  CAST_SUBTYPE(command, arg, a);
+  NEW(command_S_2, res);
+  res->f = self->f;
+  res->g = arg;
+  
+  res->super.call = do_command_S_2;
+
+  return COMMAND_RETURN(c, &res->super.super);
+}
+
+static int do_command_S(struct command *ignored UNUSED,
+			struct lsh_object *a,
+			struct command_continuation *c)
+{
+  CAST_SUBTYPE(command, arg, a);
+  NEW(command_S_1, res);
+  res->f = arg;
+  res->super.call = do_command_S_1;
+
+  return COMMAND_RETURN(c, &res->super.super);
+}
+
+struct command command_S = { STATIC_HEADER, do_command_S };
+
+/* ((B x) y) z == (x (y z)) */
+
+/* Represents (B x) */
 /* CLASS:
    (class
-     (name compose_continuation)
+     (name command_B_1)
+     (super command)
+     (vars
+       (x object command)))
+*/
+
+/* Represents ((B x) y) */
+/* CLASS:
+   (class
+     (name command_B_2)
+     (super command)
+     (vars
+       (x object command)
+       (y object command)))
+*/
+
+static int do_command_B_2(struct command *s,
+			  struct lsh_object *z,
+			  struct command_continuation *c)
+{
+  CAST(command_B_2, self, s);
+  return COMMAND_CALL(self->y, z, make_apply(self->x, c));
+}
+
+static int do_command_B_1(struct command *s,
+			  struct lsh_object *a,
+			  struct command_continuation *c)
+{
+  CAST(command_B_1, self, s);
+  CAST_SUBTYPE(command, y, a);
+  NEW(command_B_2, res);
+  res->x = self->x;
+  res->y = y;
+  res->super.call = do_command_B_2;
+
+  return COMMAND_RETURN(c, &res->super.super);
+}
+
+static int do_command_B(struct command *ignored UNUSED,
+			struct lsh_object *a,
+			struct command_continuation *c)
+{
+  NEW(command_B_1, res);
+  CAST_SUBTYPE(command, x, a);
+  res->x = x;
+  res->super.call = do_command_B_1;
+
+  return COMMAND_RETURN(c, &res->super.super);
+}
+
+struct command command_B = { STATIC_HEADER, do_command_B };
+
+#if 0
+/* xxCLASS:
+   (class
+     (name command_compose_continuation)
      (super command_continuation)
      (vars
        (f object command)
@@ -49,7 +239,7 @@ make_compose_continuation(struct command *f, struct command_continuation *c)
   return &self->super;
 }
 
-/* CLASS:
+/* xxCLASS:
    (class
      (name command_compose)
      (super command)
@@ -64,4 +254,93 @@ int do_compose_call(struct command_continuation *c, lsh_object *value)
   return COMMAND_CALL(self->arg,
 		      make_compose_continuation(self->f, c));
 }
+#endif
+
+/* Returned by listen */
+/* CLASS:
+   (class
+     (name listen_value)
+     (vars
+       (fd . int)
+       (peername string)
+       (peerport . int)))
+*/
+
+/* CLASS:
+   (class
+     (name listen_command)
+     (super command)
+     (vars
+       (backend object io_backend)
+       (address . "struct sockaddr_in")))
+*/
+
+/* CLASS:
+   (class
+     (name listen_command_callback)
+     (super fd_listen_callback)
+     (vars
+       (c object command_continuation)))
+*/
+
+static int do_listen_continue(struct fd_listen_callback *s, int fd,
+			      size_t addr_len UNUSED,
+			      struct sockaddr *peer UNUSED )
+{
+  CAST(listen_command_callback, self, s);
+  NEW(listen_value, res);
+  res->fd = fd;
+  /* Parse peer addr */
+  return COMMAND_RETURN(self->c, &res->super);
+}
+
+static struct fd_listen_callback *
+make_listen_command_callback(struct command_continuation *c)
+{
+  NEW(listen_command_callback, closure);
+  closure->c = c;
+  closure->super.f = do_listen_continue;
+  
+  return &closure->super;
+}
+
+static int do_listen_call(struct command *s,
+			  struct lsh_object *arg,
+			  struct command_continuation *c)		  
+{
+  CAST(listen_command, self, s);
+  CAST(ssh_connection, connection, arg);
+  struct listen_fd *fd = io_listen(self->backend,
+				   &self->address,
+				   make_listen_command_callback(c));
+
+  if (!fd)
+    COMMAND_RETURN(c, NULL);
+  
+  REMEMBER_RESOURCE(connection->resources,
+		    &fd->super.super);
+
+  return LSH_OK | LSH_GOON;
+}
 
+struct command *make_listen_command(struct io_backend *backend,
+				    struct lsh_string *interface,
+				    UINT32 port)
+{
+  NEW(listen_command, self);
+  self->backend = backend;
+  if (!tcp_addr(&self->address,
+		interface->length,
+		interface->data,
+		port))
+    {
+      KILL(self);
+      return NULL;
+    }
+  self->super.call = do_listen_call;
+
+  return &self->super;
+}
+  
+  
+       

src/command.h

@@ -24,18 +24,21 @@
 #ifndef LSH_COMMAND_H_INCLUDED
 #define LSH_COMMAND_H_INCLUDED
 
-#include "lsh_object.h"
+#include "lsh.h"
 
 #include "list.h"
+#include "io.h"
 
 #include <stdarg.h>
 
+#define CLASS_DECLARE
 #include "command.h.x"
+#undef CLASS_DECLARE
 
 /* Continuation based command execution. A command can take one object
  * as argument, and returns one object. */
 
-/* CLASS
+/* CLASS:
    (class
      (name command_continuation)
      (vars
@@ -46,13 +49,33 @@
    (class
      (name command)
      (vars
-       (do method int "struct command_continuation *c"
-                      "struct lsh_object *arg")))
+       (call method int "struct lsh_object *arg"
+                        "struct command_continuation *c")))
 */
 
-#define COMMAND_CALL(f, c) ((f)->do((f), (c)))
-#define COMMAND_RETURN(c, v) ((c)->c((c), (struct lsh_object *) (v))) 
+#define COMMAND_CALL(f, a, c) ((f)->call((f), (a), (c)))
+#define COMMAND_RETURN(r, v) ((r)->c((r), (struct lsh_object *) (v))) 
+
+/* CLASS:
+   (class
+     (name command_frame)
+     (super command_continuation)
+     (vars
+       (up object command_continuation)))
+*/
+
+struct command_continuation *
+make_apply(struct command *f, struct command_continuation *c);  
+
+extern struct command command_I;
+extern struct command command_S;
+extern struct command command_B;
+
+struct command *make_listen_command(struct io_backend *backend,
+				    struct lsh_string *interface,
+				    UINT32 port);
 
+#if 0
 /* (lambda (x) (f (g x))) */
 struct command *command_compose(struct command *f, struct command *g);
 
@@ -61,5 +84,6 @@ struct command *command_andl(struct object_list *args);
 
 /* (lambda (x) (or (f1 x) (f2 x) ...)) */
 struct command *command_orl(struct object_list *args);
+#endif
 
 #endif /* LSH_COMMAND_H_INCLUDED */