from:"David Thompson"

[PATCH] Add unboxed floating point comparison instructions.

2016-12-13 Thread David Thompson

This patch adds 5 new VM instructions (br-if-f64-<, br-if-f64-<=,
br-if-f64-=, br-if-f64->, br-if-f64->=) and a compiler optimization to
perform unboxed floating point number comparisons where possible.

Take this contrived example code:

(lambda ()
  (let ((foo (f64vector 1 2 3)))
(< (f64vector-ref foo 0)
   (f64vector-ref foo 1

Here is the disassembly without the optimization:

   0(assert-nargs-ee/locals 1 6);; 7 slots (0 args)   at (unknown 
file):131:3
   1(make-short-immediate 6 1028)   ;; #t
   2(toplevel-box 5 104 88 102 #t)  ;; `f64vector'
   7(box-ref 3 5)
   8(make-short-immediate 2 6)  ;; 1
   9(make-short-immediate 1 10) ;; 2
  10(make-short-immediate 0 14) ;; 3
  11(handle-interrupts)   at (unknown 
file):132:37
  12(call 3 4)
  14(receive 1 3 7)
  16(load-u64 4 0 0)  at (unknown 
file):133:31
  19(bv-f64-ref 4 5 4)
  20(f64->scm 4 4)
  21(load-u64 3 0 8)  at (unknown 
file):134:31
  24(bv-f64-ref 5 5 3)
  25(f64->scm 5 5)
  26(br-if-< 4 5 #f 4)  ;; -> L1  at (unknown 
file):133:28
  29(make-short-immediate 6 4)  ;; #f
L1:
  30(handle-interrupts)
  31(mov 5 6)
  32(return-values 2)   ;; 1 value

And here is the disassembly with the optimization:

   0(assert-nargs-ee/locals 1 6);; 7 slots (0 args)   at (unknown 
file):1:3
   1(make-short-immediate 6 1028)   ;; #t
   2(toplevel-box 5 102 86 100 #t)  ;; `f64vector'
   7(box-ref 3 5)   
   8(make-short-immediate 2 6)  ;; 1
   9(make-short-immediate 1 10) ;; 2
  10(make-short-immediate 0 14) ;; 3
  11(handle-interrupts)   at (unknown 
file):2:37
  12(call 3 4)  
  14(receive 1 3 7) 
  16(load-u64 4 0 0)  at (unknown 
file):3:31
  19(bv-f64-ref 4 5 4)  
  20(load-u64 3 0 8)  at (unknown 
file):4:31
  23(bv-f64-ref 5 5 3)  
  24(br-if-f64-< 4 5 #f 4)  ;; -> #f  at (unknown 
file):3:28
  27(make-short-immediate 6 4)  ;; #f
  28(handle-interrupts) 
  29(mov 5 6)   
  30(return-values 2)   ;; 1 value

Much better!  The f64->scm instructions have been eliminated.  This
greatly improves performance for things like realtime simulations that
do lots of floating point vector and matrix arithmetic.

Many thanks to Andy for already implementing this optimization for u64s
which I shamelessly copied from and for the additional guidance on IRC.

>From 5f97216c1d19e9302903235da6e89b164d10ba30 Mon Sep 17 00:00:00 2001
From: David Thompson <dthomps...@worcester.edu>
Date: Mon, 12 Dec 2016 22:46:08 -0500
Subject: [PATCH] Add unboxed floating point comparison instructions.

* libguile/vm-engine.c (BR_F64_ARITHMETIC): New preprocessor macro.
(br_if_f64_ee, br_if_f64_lt, br_if_f64_le, br_if_f64_gt, br_if_f64_ge):
New VM instructions.
* module/language/cps/compile-bytecode.scm (compile-function): Emit f64
comparison instructions.
* module/language/cps/effects-analysis.scm: Define effects for f64
primcalls.
* module/language/cps/primitives.scm (*branching-primcall-arities*): Add
arities for f64 primcalls.
* module/language/cps/specialize-numbers.scm (specialize-f64-comparison):
New procedure.
(specialize-operations): Specialize f64 comparisons.
* module/language/cps/type-fold.scm: Define branch folder aliases for
f64 primcalls.
* module/language/cps/types.scm: Define type checkers and comparison
inferrers for f64 primcalls.
(/f64, define-f64-comparison-inferrer): New syntax.
(infer-f64-comparison-ranges): New procedure.
* module/system/vm/assembler.scm (emit-br-if-f64-=, emit-br-if-f64-<)
(emit-br-if-f64-<=, emit-br-if-f64->, emit-br-if-f64->=): Export.
* module/system/vm/disassembler.scm (code-annotation): Add annotations
for f64 comparison instructions.
---
 libguile/vm-engine.c   | 68 +++---
 module/language/cps/compile-bytecode.scm   |  7 ++-
 module/language/cps/effects-analysis.scm   |  5 +++
 module/language/cps/primitives.scm |  7 ++-
 module/language/cps/specialize-numbers.scm | 49 +++--
 module/language/cps/type-fold.scm  |  5 +++
 module/language/cps/types.scm  | 30 +
 module/system/vm/assembler.scm |  5 +++
 module/system/vm/disassembler.scm  |  2 +
 9 files changed, 157 insertions(+), 21 deletions(-)

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 4406845..6a7ba51 100644
--- a/libguile/vm-engine.c
+++

Attempting to unbox struct fields

2016-02-28 Thread David Thompson

Hello wingo and list,

A couple days ago on #guile, I started a conversation about optimizing
some record types I use for linear algebra to take advantage of unboxed
arithmetic in the upcoming Guile 2.2.  Andy informed me of a temporary
hack I could try, but then said that The Right Thing is for Guile to
unbox struct fields.  So, I thought since Andy wrote such a nice post on
his blog about about Guile compiler tasks [0] that maybe I would give it
a try!  I have gone about as far as I can on my own (not far), and seek
the guiding light of the Guile maintainers to help unblock me.

The task is as follows, quoting from the above mentioned blog post:

Guile's "structs", on which records are implemented, support unboxed
values, but these values are untyped, not really integrated with the
record layer, and always boxed in the VM. Your task would be to
design a language facility that allows us to declare records with
typed fields, and to store unboxed values in those fields, and to
cause access to their values to emit boxing/unboxing instructions
around them. The optimizer will get rid of those boxing/unboxing
instructions if it can. Good luck!

I took an exploratory romp around the codebase and here's what I've
learned:

- Guile indeed supports unboxed fields in the struct implementation.
  Currently it only supports unboxed unsigned integers, but there's some
  preprocessor magic that can be removed to enable unboxed signed
  integers and doubles:

  switch (field_type)
  {
  case 'u':
data[p] = SCM_NUM2ULONG (3, val);
break;
  
  #if 0
  case 'i':
data[p] = SCM_NUM2LONG (3, val);
break;
  
  case 'd':
*((double *)&(data[p])) = scm_num2dbl (val, (char *)SCM_ARG3);
break;
  #endif

  ...

- It's easy enough to create a vtable with unboxed fields:

(define vtable (make-vtable "uwuw"))
(define s (make-struct vtable 123 456))
(struct-ref s 0) ;; => 123

- struct-ref/immediate and struct-set!/immediate are the VM operations
  for reading from/writing to structs

- Roughly speaking, in the case of unboxed unsigned integers, one would
  want to insert a scm->u64 instruction before setting the value of an
  unboxed field, and one would want to insert a u64->scm instructor
  after getting the value of an unboxed field.

- In TreeIL, struct refs and sets are primcalls, and when compiling to
  CPS they receive some special treatment to unbox the index component
  of the respective operations.  This might be the procedure that will
  insert the boxing/unboxing instructions for the struct fields, but I'm
  not sure.

Now that I've learned a little bit, I have a bunch of questions that I
cannot yet answer:

- Is it possible to know the layout of a vtable at compile time?

- If so, where is that information stored?

- If not, does this mean that TreeIL needs to be changed to be able to
store typed struct field data in order to generate the correct CPS?

- Can the TreeIL format even be reasonably changed since its a public
interface that people target when writing their own language
implementations?

Basically, how could I possibly get my hands on the vtable information
at compile time?

Help would be very much appreciated!

Thanks,

-- 
David Thompson
GPG Key: 0FF1D807

[0] http://wingolog.org/archives/2016/02/04/guile-compiler-tasks

Re: [PATCH] ice-9: Add JSON module.

2015-08-15 Thread David Thompson

Noticed a couple of small issues after I sent the initial patch that
I've fixed in my local git branch:

David Thompson da...@gnu.org writes:

 +(define-module (ice-9 json)
 +  #:use-module (ice-9 match)
 +  #:use-module (srfi srfi-1)
 +  #:export (read-json write-json))

No need to import SRFI-1.

 +(define (read-zeroes port)
 +  Read a sequence of zeroes from PORT.
 +  (let loop ((result '()))
 +(match (peek-char port)
 +  ((? eof-object?)
 +   result)
 +  (#\0
 +   (read-char port)
 +   (loop (cons 0 result)))
 +  (else result

Never used.  Removed.

-- 
David Thompson
GPG Key: 0FF1D807

[PATCH] ice-9: Add JSON module.

2015-08-15 Thread David Thompson

Hello Guilers,

JSON is an commonly encountered format when writing web applications,
much like XML, and I think it would be a good idea if the core Guile
distribution had an SXML equivalent for JSON.  This patch introduces
such an interface in the (ice-9 json) module.

With (ice-9 json), this expression:

(@ (name . Eva Luator)
   (age . 24)
   (schemer . #t)
   (hobbies hacking cycling surfing))

serializes to this JSON (except not pretty-printed):

{
  name: Eva Luator,
  age: 24,
  schemer: true,
  hobbies: [
hacking,
cycling,
surfing
  ]
}

Thanks to Mark Weaver and Chris Webber for helping come to a consensus
on a good syntax for JSON objects.

From 2d4d8607aedaede98f413a84f135d8798d506233 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 15 Aug 2015 14:09:23 -0400
Subject: [PATCH] ice-9: Add JSON module.

* module/ice-9/json.scm: New file.
* module/Makefile.am (ICE_9_SOURCES): Add it.
* test-suite/tests/json.test: New file.
* test-suite/Makefile.am (SCM_TESTS): Add it.
* doc/ref/guile.texi (Guile Modules): Add JSON section.
* doc/ref/json.texi: New file.
* doc/ref/Makefile.am (guile_TEXINFOS): Add it.
---
 doc/ref/Makefile.am|   3 +-
 doc/ref/guile.texi |   2 +
 doc/ref/json.texi  |  62 +++
 module/Makefile.am |   3 +-
 module/ice-9/json.scm  | 395 +
 test-suite/Makefile.am |   1 +
 test-suite/tests/json.test | 149 +
 7 files changed, 613 insertions(+), 2 deletions(-)
 create mode 100644 doc/ref/json.texi
 create mode 100644 module/ice-9/json.scm
 create mode 100644 test-suite/tests/json.test

diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am
index 31c26a7..5dfc019 100644
--- a/doc/ref/Makefile.am
+++ b/doc/ref/Makefile.am
@@ -95,7 +95,8 @@ guile_TEXINFOS = preface.texi			\
 		 goops.texi			\
 		 goops-tutorial.texi		\
 		 guile-invoke.texi		\
-		 effective-version.texi
+		 effective-version.texi		\
+		 json.texi
 
 ETAGS_ARGS = $(info_TEXINFOS) $(guile_TEXINFOS)
 
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index db815eb..468d3a5 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -375,6 +375,7 @@ available through both Scheme and C interfaces.
 * Statprof::An easy-to-use statistical profiler.
 * SXML::Parsing, transforming, and serializing XML.
 * Texinfo Processing::  Munging documents written in Texinfo.
+* JSON::Parsing and serializing JSON.
 @end menu
 
 @include slib.texi
@@ -397,6 +398,7 @@ available through both Scheme and C interfaces.
 @include statprof.texi
 @include sxml.texi
 @include texinfo.texi
+@include json.texi
 
 @include goops.texi
 
diff --git a/doc/ref/json.texi b/doc/ref/json.texi
new file mode 100644
index 000..43dba4d
--- /dev/null
+++ b/doc/ref/json.texi
@@ -0,0 +1,62 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C) 2015  Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+@c
+
+@node JSON
+@section JSON
+
+@cindex json
+@cindex (ice-9 json)
+
+The @code{(ice-9 json)} module provides procedures for parsing and
+serializing JSON, the JavaScript Object Notation data interchange
+format.  For example, the JSON document:
+
+@example
+@verbatim
+{
+  name: Eva Luator,
+  age: 24,
+  schemer: true,
+  hobbies: [
+hacking,
+cycling,
+surfing
+  ]
+}
+@end verbatim
+@end example
+
+may be represented with the following s-expression:
+
+@example
+@verbatim
+(@ (name . Eva Luator)
+   (age . 24)
+   (schemer . #t)
+   (hobbies hacking cycling surfing))
+@end verbatim
+@end example
+
+Strings, real numbers, @code{#t}, @code{#f}, @code{#nil}, lists, and
+association lists may be serialized as JSON.  Association lists
+serialize to objects, and regular lists serialize to arrays.  To
+distinguish regular lists from association lists, the @code{@@} symbol
+is used to ``tag'' the association list as a JSON object, as in the
+above example.  The keys of association lists may be either strings or
+symbols.
+
+@deffn {Scheme Procedure} read-json port
+
+Parse JSON-encoded text from @var{port} and return its s-expression
+representation.
+
+@end deffn
+
+@deffn {Scheme Procedure} write-json exp port
+
+Write the expression @var{exp} as JSON-encoded text to @var{port}.
+
+@end deffn
diff --git a/module/Makefile.am b/module/Makefile.am
index 7e96de7..6380953 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -256,7 +256,8 @@ ICE_9_SOURCES = \
   ice-9/list.scm \
   ice-9/serialize.scm \
   ice-9/local-eval.scm \
-  ice-9/unicode.scm
+  ice-9/unicode.scm \
+  ice-9/json.scm
 
 srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
 
diff --git a/module/ice-9/json.scm b/module/ice-9/json.scm
new file mode 100644
index 000..3850ee4
--- /dev/null
+++ b/module/ice-9/json.scm
@@ -0,0 +1,395

[PATCH] web: http: Accept blank Content-Type headers.

2015-07-23 Thread David Thompson

Hello,

I encountered a bug in the HTTP header parsing bug when trying to
download a file via Guix.  The response had a Content-Type header, but
with no value, like so:

Content-Type: 

From reading the W3C spec[0], an unknown Content-Type header can be
treated as if it were an application/octet-stream type.  I'm unsure if
that means even Content-Type values that have invalid syntax should be
accepted or not, so I didn't try to handle them.  I'm not even sure if
we should be translating the empty string to application/octet-stream.
I know that it shouldn't throw an excpetion, but maybe it should just
return the empty list and the user can decide how to interpret it?

Anyway, here's a patch to get the ball rolling.

From c9994a7b94ab2c43adfea2980da99515e6292e16 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Thu, 23 Jul 2015 22:07:53 -0400
Subject: [PATCH] web: http: Accept blank Content-Type headers.

* module/web/http.scm (parse-media-type): Return
  'application/octet-stream' when given the empty string.
* test-suite/tests/web-http.test (entity headers): Add test.
---
 module/web/http.scm| 10 +++---
 test-suite/tests/web-http.test |  1 +
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index f8aa8db..6f0f6fd 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -271,9 +271,13 @@ as an ordered alist.
 (and idx (= idx (string-rindex str #\/))
  (not (string-index str separators-without-slash)
 (define (parse-media-type str)
-  (if (validate-media-type str)
-  (string-symbol str)
-  (bad-header-component 'media-type str)))
+  (cond
+   ((string-null? str)
+'application/octet-stream)
+   ((validate-media-type str)
+(string-symbol str))
+   (else
+(bad-header-component 'media-type str
 
 (define* (skip-whitespace str #:optional (start 0) (end (string-length str)))
   (let lp ((i start))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index c59674f..0675dbc 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -267,6 +267,7 @@
   (pass-if-parse content-range bytes */30 '(bytes * 30))
   (pass-if-parse content-type foo/bar '(foo/bar))
   (pass-if-parse content-type foo/bar; baz=qux '(foo/bar (baz . qux)))
+  (pass-if-parse content-type  '(application/octet-stream))
   (pass-if-parse expires Tue, 15 Nov 1994 08:12:31 GMT
  (string-date Tue, 15 Nov 1994 08:12:31 +
  ~a, ~d ~b ~Y ~H:~M:~S ~z))
-- 
2.4.3


-- 
David Thompson
GPG Key: 0FF1D807

[PATCH] socket: Add AF_NETLINK support.

2015-05-03 Thread David Thompson

Hello Guile hackers,

This is my first attempt at providing support for AF_NETLINK sockets in
Guile, based on a preliminary patch that Ludovic sent me.  Netlink
sockets are supported only on Linux.  The ultimate goal of this work is
to be able to create virtual ethernet devices from Scheme code.

There are no tests yet and I'm not sure if I went overboard by defining
all of the numerous netlink families and multicast group constants.
Feedback requested! :)

This patch is for stable-2.0.

Thanks,

From 3fed7633ee4556907408c55ae29c12641ad6d80c Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sun, 3 May 2015 09:35:49 -0400
Subject: [PATCH] socket: Add AF_NETLINK support.

* libguile/socket.c (scm_fill_sockaddr, _scm_from_sockaddr,
  scm_to_sockaddr): Add AF_NETLINK cases.
  (AF_NETLINK, PF_NETLINK, NETLINK_ROUTE, NETLINK_USERSOCK,
  NETLINK_FIREWALL, NETLINK_SOCK_DIAG, NETLINK_NFLOG, NETLINK_XFRM,
  NETLINK_SELINUX, NETLINK_ISCSI, NETLINK_AUDIT, NETLINK_FIB_LOOKUP,
  NETLINK_CONNECTOR, NETLINK_NETFILTER, NETLINK_IP6_FW, NETLINK_DNRTMSG,
  NETLINK_UEVENT, NETLINK_GENERIC, NETLINK_SCSITRANSPORT,
  NETLINK_ECRYPTFS, NETLINK_RDMA, NETLINK_CRYPTO, RTNLGRP_NONE,
  RTNGRP_LINK, RTNGRP_NOTIFY, RTNGRP_NEIGH, RTNGRP_TC,
  RTNGRP_IPV4_IFADDR, RTNGRP_IPV4_MROUTE, RTNGRP_IPV4_ROUTE,
  RTNGRP_IPV4_RULE, RTNGRP_IPV6_IFADDR, RTNGRP_IPV6_MROUTE,
  RTNGRP_IPV6_ROUTE, RTNGRP_IPV6_IFINFO, RTNGRP_DECnet_IFADDR,
  RTNGRP_DECnet_ROUTE, RTNGRP_DECnet_RULE, RTNGRP_IPV6_PREFIX,
  RTNGRP_IPV6_RULE, RTNGRP_ND_USEROPT, RTNGRP_PHONET_IFADDR,
  RTNGRP_PHONET_ROUTE, RTNGRP_DCB, RTNGRP_IPV4_NETCONF,
  RTNGRP_IPV6_NETCONF, RTNGRP_MDB): New Scheme variables.
* module/ice-9/networking.scm (sockaddr:pid, sockaddr:groups): New
  procedures.
* doc/ref/posix.texi (make-socket-address, connect, bind): Document
  AF_NETLINK usage.
  (sockaddr:pid, sockaddr:groups): Document new procedures.
  (socket): Document PF_NETLINK family constant.
---
 doc/ref/posix.texi  |  17 
 libguile/socket.c   | 203 
 module/ice-9/networking.scm |   2 +
 3 files changed, 222 insertions(+)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index ad5460c..33fe185 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2950,6 +2950,7 @@ created with,
 @deffn {Scheme Procedure} make-socket-address AF_INET ipv4addr port
 @deffnx {Scheme Procedure} make-socket-address AF_INET6 ipv6addr port [flowinfo [scopeid]]
 @deffnx {Scheme Procedure} make-socket-address AF_UNIX path
+@deffnx {Scheme Procedure} make-socket-address AF_NETLINK pid groups
 @deffnx {C Function} scm_make_socket_address (family, address, arglist)
 Return a new socket address object.  The first argument is the address
 family, one of the @code{AF} constants, then the arguments vary
@@ -2964,6 +2965,9 @@ arguments may be given (both integers, default 0).
 
 For @code{AF_UNIX} the argument is a filename (a string).
 
+For @code{AF_NETLINK}, the arguments are a process ID and a multicast
+groups bitmask.  This socket type is only available on Linux.
+
 The C function @code{scm_make_socket_address} takes the @var{family}
 and @var{address} arguments directly, then @var{arglist} is a list of
 further arguments, being the port for IPv4, port and optional flowinfo
@@ -3004,6 +3008,16 @@ For an @code{AF_INET6} socket address object @var{sa}, return the
 scope ID value.
 @end deffn
 
+@deffn {Scheme Procedure} sockaddr:pid sa
+For an @code{AF_NETLINK} socket address object @var{sa}, return the
+process ID number.
+@end deffn
+
+@deffn {Scheme Procedure} sockaddr:groups sa
+For an @code{AF_NETLINK} socket address object @var{sa}, return the
+multicast groups bitmask.
+@end deffn
+
 @tpindex @code{struct sockaddr}
 @tpindex @code{sockaddr}
 The functions below convert to and from the C @code{struct sockaddr}
@@ -3075,6 +3089,7 @@ the system,
 @defvar PF_UNIX
 @defvarx PF_INET
 @defvarx PF_INET6
+@defvarx PF_NETLINK
 @end defvar
 
 The possible values for @var{style} are as follows, again where
@@ -3213,6 +3228,7 @@ The return value is unspecified.
 @deffnx {Scheme Procedure} connect sock AF_INET ipv4addr port
 @deffnx {Scheme Procedure} connect sock AF_INET6 ipv6addr port [flowinfo [scopeid]]
 @deffnx {Scheme Procedure} connect sock AF_UNIX path
+@deffnx {Scheme Procedure} connect sock AF_NETLINK pid groups
 @deffnx {C Function} scm_connect (sock, fam, address, args)
 Initiate a connection on socket port @var{sock} to a given address.
 The destination is either a socket address object, or arguments the
@@ -3229,6 +3245,7 @@ same as @code{make-socket-address} would take to make such an object
 @deffnx {Scheme Procedure} bind sock AF_INET ipv4addr port
 @deffnx {Scheme Procedure} bind sock AF_INET6 ipv6addr port [flowinfo [scopeid]]
 @deffnx {Scheme Procedure} bind sock AF_UNIX path
+@deffnx {Scheme Procedure} bind sock AF_NETLINK pid groups
 @deffnx {C Function} scm_bind (sock, fam, address, args)
 Bind socket port @var{sock

Handling HTTP Upgrade requests

2015-02-21 Thread David Thompson

I've been tinkering with adding WebSockets[0] support to Guile's HTTP
arsenal.  The first blocking issue I've come across is that an HTTP
server must be able to detect the Upgrade header[1] and change
protocols.  In my case, once a client thread accepts a WebSocket
connection, it should speak the WebSocket protocol, not HTTP.

Here's an example of a backtrace that you'd see after a successful
WebSocket handshake, when the client tries to actually make use of the
socket:

In ice-9/boot-9.scm:
   171:12  3 (with-throw-handler #t #procedure 1720560 at web/... #)
In web/server/http.scm:
   126:17  2 (#procedure 1720560 at web/server/http.scm:125:15 ())
In web/request.scm:
   204:31  1 (read-request #closed: file 0 ())
In ice-9/boot-9.scm:
   106:20  0 (#procedure 10ce380 at ice-9/boot-9.scm:97:6 (thr... ...)
ERROR: Bad request: Bad Request-Line: \x81\x86B\x93�Q

Does anyone have an idea about how to approach this problem?

Thanks in advance!

[0] http://www.websocket.org/
[1] http://en.wikipedia.org/wiki/HTTP/1.1_Upgrade_header

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

Re: WebSockets

2015-02-20 Thread David Thompson

Digging up this old thread. :)

Neil Jerram n...@ossau.homelinux.net writes:

 I'm interested in adding support for WebSockets 
 (http://tools.ietf.org/html/rfc6455) to Guile's web modules.  Is anyone 
 else interested in - or possibly already working on - that?

Did you ever decide to work on this?  I'm also interested in getting
WebSockets support into Guile.

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

MIME type guessing module

2014-12-31 Thread David Thompson

Hello Guile hackers,

Recently I've taken to writing simple web servers in Guile.  Each time I
write one I wish that core Guile came with a procedure to guess the mime
type of a file.  Such a procedure would be very useful when serving
arbitrary static files from disk.

However, I can't figure out the best way to implement it.  Here are 3
possible ways of guessing a MIME type:

1) Use a lookup table that maps file extensions to MIME types.  This is
the simplest method as it would only test file extensions.  Python does
this, see: https://docs.python.org/2/library/mimetypes.html

2) Use pipes to read the output of the 'file' utility.  The guessing
will be more accurate because 'file' inspects a file's contents to make
better guesses.

3) Use the FFI to call libmagic.  Same benefits as above, but better
because we can use the FFI instead of subprocesses and pipes.

2 and 3 both have the disadvantage of requiring an additional
dependency, which seems hard to justify for such a minor feature.

I wrote a simple static file server (inspired by Python's
SimpleHTTPServer) that I would like to contribute once this blocker is
resolved.

Thoughts?  Would this be useful at all?

Thanks,

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

Re: inotify ffi

2014-11-11 Thread David Thompson

Eli Zaretskii e...@gnu.org writes:

 Why not use the glib file monitoring instead?  It is much more
 portable, and has an inotify back-end AFAIK.

If you're only after inotify, glib seems like a heavy dependency.

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

Re: inotify ffi

2014-11-11 Thread David Thompson

Eli Zaretskii e...@gnu.org writes:

 But inotify is practically a single-OS solution.  How does it make
 sense for Guile to support file notifications only on one platform?
 That effectively limits packages that use Guile as an extension
 language to that single platform.

From what I could see, this is a third-party library, not one intended
for Guile core.  If such support were to be added to Guile core, I would
agree that it should be cross-platform.

I'm interested in file notifications for a project of mine, but I'm not
sure I would want to introduce glib as a dependency if I'm only using
that one feature.

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

[ANN] guile-toxcore

2014-09-12 Thread David Thompson

Hello guilers,

A couple months ago I started a project to create Guile bindings for
Tox, the free software Skype replacement.  So far, I have wrapped the
core, group chat, and file transfer functions.  Audio/video functions
still need to be wrapped.  Tox is still under heavy development with no
official stable release, so work is also needed to keep this library in
sync with the libtoxcore project.

One of my goals with this project is to write a bot that users can add
as a friend and use to test text/audio/video chat.  Currently, I have a
working text chat echo bot.

I was going to wait to announce this until it was more complete, but
I've been busy with other projects.  Help is welcomed. :)

The source code is hosted on Gitorious:

https://gitorious.org/guile-toxcore/guile-toxcore

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

Re: [ANN] guile-toxcore

2014-09-12 Thread David Thompson

David Thompson dthomps...@worcester.edu writes:

 One of my goals with this project is to write a bot that users can add
 as a friend and use to test text/audio/video chat.  Currently, I have a
 working text chat echo bot.

Here's the config for the example client (examples/client.scm) that
provides the echo bot functionality:

  (use-modules (tox util))
  
  (define tox-bootstrap-nodes
'(((ip . 192.254.75.98)
   (id . 951C88B7E75C867418ACDB5D273821372BB5BD652740BCDF623A4FA293E75D2F)
   (port . 33445)
   (ipv6? . #t))
  ((ip . 144.76.60.215)
   (id . 04119E835DF3E78BACF0F84235B300546AF8B936F035185E2A8E9E0A67C8924F)
   (port . 33445)
   (ipv6? . #t))
  ((ip . 23.226.230.47)
   (id . A09162D68618E742FFBCA1C2C70385E6679604B2D80EA6E84AD0996A1AC8A074)
   (port . 33445)
   (ipv6? . #t))
  ((ip . 37.187.20.216)
   (id . 4FD54CFD426A338399767E56FD0F44F5E35FA8C38C8E87C8DC3FEAC0160F8E17)
   (port . 33445)
   (ipv6? . #t))
  ((ip . 54.199.139.199)
   (id . 7F9C31FE850E97CEFD4C4591DF93FC757C7C12549DDD55F8EEAECC34FE76C029)
   (port . 33445)
   (ipv6? . #f))
  ((ip . 37.59.102.176)
   (id . B98A2CEAA6C6A2FADC2C3632D284318B60FE5375CCB41EFA081AB67F500C1B0B)
   (port . 33445)
   (ipv6? . #t))
  ((ip . 192.210.149.121)
   (id . F404ABAA1C99A9D37D61AB54898F56793E1DEF8BD46B1038B9D822E8460FAB67)
   (port . 33445)
   (ipv6? . #f))
  ((ip . 37.187.46.132)
   (id . 5EB67C51D3FF5A9D528D242B669036ED2A30F8A60E674C45E7D43010CB2E1331)
   (port . 33445)
   (ipv6? . #t
  
  (define (tox-friend-names tox)
(map (lambda (friend-number)
   (tox-friend-name tox friend-number))
 (tox-friend-list tox)))
  
  (set-tox-name tox Tox Test Bot)
  (set-tox-status-message tox Hanging around)
  
  (add-hook! tox-friend-request-hook
 (lambda (tox public-key message)
   (format #t
   Friend request:\nClient ID: ~a\nMessage: ~a\n\n
   (bytevector-hex-string public-key)
   message)
 (tox-add-friend-no-request tox public-key)))
  
  (add-hook! tox-message-hook
 (lambda (tox friend message)
   (let ((name (tox-friend-name tox friend))
 (response (format #f I received the message: \~a\
   message)))
 (format #t ~a says: ~a\n name message)
 (tox-send-message tox friend response

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

Re: [FEATURE Request] Built-in server should support a thunk as body

2014-08-25 Thread David Thompson

Hi Nala,

Nala Ginrut nalagin...@gmail.com writes:

 I'm trying to handle static file with our sendfile, but I realized it's
 impossible to call it in the handler of run-server.
 Although sanitize-response supports procedure as body, it never let me
 use sendfile at any chance, because the final writing operation should
 be delayed to server-impl-write. If I do it in advanced (in
 sanitize-response), the body will appear before the http header, which
 is wrong way.

 My suggestion is to support thunk as body, the thunk included body
 writing operation, and sanitize-response will pass it to the next step
 without any cooking. When server-impl-write detected it's a thunk, it'll
 call it directly to write the body rather than calling
 write-response-body.

 Of course, in this way, users have to pass Content-Length manually in
 build-response. Consider the size of file will be confirmed when calling
 sendfile, it's easy to do that.

 In short, my approach is some kind of lazy evaluation for body handling.

 I can format a patch if it's agreed.

 Comments?

I'm currently writing a web application using Guile's built-in HTTP
server.  To serve static files, I build a response like:

  (values `((content-type . (text/css)))
  (call-with-input-file file-name get-bytevector-all))

Since the response body can be a string, bytevector, or lambda, I tried
using sendfile:

  (values `((content-type . (text/css)))
  (lambda (output)
(call-with-input-file file-name
  (lambda (input)
(sendfile output input file-size)

However, it didn't work because 'output' is a string port, but sendfile
requires file ports.

Does your proposal give us access to a file port that we can write to?
I'm still learning to use Guile's HTTP modules and serving static files
was something that confused me for awhile.

-- 
David Thompson
Web Developer - Free Software Foundation - http://fsf.org
GPG Key: 0FF1D807
Support the FSF: https://fsf.org/donate

Re: Welcome Mark as new co-maintainer

2014-05-27 Thread David Thompson

Ludovic Courtès l...@gnu.org writes:

 Hello Guilers,

 I’m happy to announce that Mark H. Weaver has now been officially
 appointed as Guile co-maintainer by the GNU Project overseers, along
 with Andy and myself.

 Mark has been doing excellent work on Guile for several years,
 tirelessly looking for improvements, fearlessly treading into scary
 places like psyntax and I/O ports, so I’m glad to have him officially
 on board now.

 Welcome, Mark!  :-)

 Ludo’.

Awesome news!

Mark has helped me understand Guile concepts and improve myself as a
programmer on numerous occasions since I first joined #guile about 2
years ago.  I wouldn't be the avid Guiler that I am today without him.

Congrats, Mark!

- Dave

Re: [PATCH] Test for weak pairs in hash-for-each

2014-03-11 Thread David Thompson

David Thompson dthomps...@worcester.edu writes:

Hello,

Updated patch attached that fixes a small style issue.

- Dave

From 1bbf073905bc12f80b0a32fc6311163a0b0ab849 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 8 Mar 2014 17:15:52 -0500
Subject: [PATCH] Test for deleted weak pairs in hash-for-each.

* libguile/hashtab.c (hash-for-each): Test for deleted weak pairs.
* test-suite/tests/hash.test: Add test case.
---
 libguile/hashtab.c |  4 +++-
 test-suite/tests/hash.test | 12 
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 9107ce5..44db051 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -1464,7 +1464,9 @@ scm_internal_hash_for_each_handle (scm_t_hash_handle_fn fn, void *closure,
 	  handle = SCM_CAR (ls);
 	  if (!scm_is_pair (handle))
 	SCM_WRONG_TYPE_ARG (SCM_ARG3, buckets);
-	  fn (closure, handle);
+  if (!SCM_HASHTABLE_WEAK_P (table)
+  || !SCM_WEAK_PAIR_DELETED_P (handle))
+fn (closure, handle);
 	  ls = SCM_CDR (ls);
 	}
 }
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index 64d10bb..4c21d71 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -347,3 +347,15 @@
 
 (pass-if (equal? 2 (hash-count (lambda (k v)
  (string? v)) table)
+
+;;;
+;;; weak key hash table
+;;;
+
+(with-test-prefix weak key hash table
+  (pass-if hash-for-each after gc
+(let ((table (make-weak-key-hash-table)))
+  (hashq-set! table (list 'foo) 'bar)
+  (gc)
+  ;; Iterate over deleted weak ref without crashing.
+  (unspecified? (hash-for-each (lambda (key value) key) table)
-- 
1.8.5.3

[PATCH] Test for weak pairs in hash-for-each

2014-03-08 Thread David Thompson

Hello all,

This patch fixes a segfault that occurs when iterating over a weak hash
table with deleted weak pairs.

WDYT?

- Dave

From 531c773dae023f15e0719d76a4352064e3681a7b Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 8 Mar 2014 17:15:52 -0500
Subject: [PATCH] Test for deleted weak pairs in hash-for-each.

* libguile/hashtab.c (hash-for-each): Test for deleted weak pairs.
* test-suite/tests/hash.test: Add test case.
---
 libguile/hashtab.c |  4 +++-
 test-suite/tests/hash.test | 12 
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 9107ce5..c5277c1 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -1464,7 +1464,9 @@ scm_internal_hash_for_each_handle (scm_t_hash_handle_fn fn, void *closure,
 	  handle = SCM_CAR (ls);
 	  if (!scm_is_pair (handle))
 	SCM_WRONG_TYPE_ARG (SCM_ARG3, buckets);
-	  fn (closure, handle);
+  if (!SCM_HASHTABLE_WEAK_P (table) ||
+  !SCM_WEAK_PAIR_DELETED_P (handle))
+fn (closure, handle);
 	  ls = SCM_CDR (ls);
 	}
 }
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index 64d10bb..4c21d71 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -347,3 +347,15 @@
 
 (pass-if (equal? 2 (hash-count (lambda (k v)
  (string? v)) table)
+
+;;;
+;;; weak key hash table
+;;;
+
+(with-test-prefix weak key hash table
+  (pass-if hash-for-each after gc
+(let ((table (make-weak-key-hash-table)))
+  (hashq-set! table (list 'foo) 'bar)
+  (gc)
+  ;; Iterate over deleted weak ref without crashing.
+  (unspecified? (hash-for-each (lambda (key value) key) table)
-- 
1.8.5.3

Re: Fwd: PATCH - Add cooperative REPL server module

2014-01-22 Thread David Thompson

Mark H Weaver m...@netris.org writes:

 Hi David,

 Your latest patch looks great to me.  I have only one request:
 please update the docstrings of 'spawn-coop-repl-server' and
 'poll-coop-repl-server' to match their current descriptions in
 the manual, except without texinfo markup, as usual.

Done.  Updated patch attached.

 Other than that, I think the patch is ready to push, although of course
 MVars have to go in first.  Now it's my turn to write docs, and tests
 :)

Yay! Thanks.

Thanks again!
Mark

- Dave

From 9ec93726bf96c38ff1a6b704269578f1a1081962 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sun, 19 Jan 2014 13:16:02 -0500
Subject: [PATCH] Add cooperative REPL server module.

* module/system/repl/coop-server.scm: New module.

* module/system/repl/repl.scm (start-repl): Extract body to start-repl*.
  (start-repl*): New procedure.
  (run-repl): Extract body to run-repl*.
  (run-repl*): New procedure.

* module/system/repl/server.scm (run-server): Extract body to
  run-server*.
  (run-server*): New procedure.

* doc/ref/api-evaluation.texi: Add docs.

* module/Makefile.am: Add system/repl/coop-server.scm to SYSTEM_SOURCES.
---
 doc/ref/api-evaluation.texi|  45 +++
 module/Makefile.am |   3 +-
 module/system/repl/coop-server.scm | 160 +
 module/system/repl/repl.scm|  11 ++-
 module/system/repl/server.scm  |   5 +-
 5 files changed, 220 insertions(+), 4 deletions(-)
 create mode 100644 module/system/repl/coop-server.scm

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 7d67d9a..27585e6 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -23,6 +23,7 @@ loading, evaluating, and compiling Scheme code at run time.
 * Local Evaluation::Evaluation in a local lexical environment.
 * Local Inclusion:: Compile-time inclusion of one file in another.
 * REPL Servers::Serving a REPL over a socket.
+* Cooperative REPL Servers::REPL server for single-threaded applications.
 @end menu
 
 
@@ -1281,6 +1282,50 @@ with no arguments.
 Closes the connection on all running server sockets.
 @end deffn
 
+@node Cooperative REPL Servers
+@subsection Cooperative REPL Servers
+
+@cindex Cooperative REPL server
+
+The procedures in this section are provided by
+@lisp
+(use-modules (system repl coop-server))
+@end lisp
+
+Whereas ordinary REPL servers run in their own threads (@pxref{REPL
+Servers}), sometimes it is more convenient to provide REPLs that run at
+specified times within an existing thread, for example in programs
+utilizing an event loop or in single-threaded programs.  This allows for
+safe access and mutation of a program's data structures from the REPL,
+without concern for thread synchronization.
+
+Although the REPLs are run in the thread that calls
+@code{spawn-coop-repl-server} and @code{poll-coop-repl-server},
+dedicated threads are spawned so that the calling thread is not blocked.
+The spawned threads read input for the REPLs and to listen for new
+connections.
+
+Cooperative REPL servers must be polled periodically to evaluate any
+pending expressions by calling @code{poll-coop-repl-server} with the
+object returned from @code{spawn-coop-repl-server}.  The thread that
+calls @code{poll-coop-repl-server} will be blocked for as long as the
+expression takes to be evaluated or if the debugger is entered.
+
+@deffn {Scheme Procedure} spawn-coop-repl-server [server-socket]
+Create and return a new cooperative REPL server object, and spawn a new
+thread to listen for connections on @var{server-socket}.  Proper
+functioning of the REPL server requires that
+@code{poll-coop-repl-server} be called periodically on the returned
+server object.
+@end deffn
+
+@deffn {Scheme Procedure} poll-coop-repl-server coop-server
+Poll the cooperative REPL server @var{coop-server} and apply a pending
+operation if there is one, such as evaluating an expression typed at the
+REPL prompt.  This procedure must be called from the same thread that
+called @code{spawn-coop-repl-server}.
+@end deffn
+
 @c Local Variables:
 @c TeX-master: guile.texi
 @c End:
diff --git a/module/Makefile.am b/module/Makefile.am
index 8a7befd..b7960dc 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -360,7 +360,8 @@ SYSTEM_SOURCES =\
   system/repl/common.scm			\
   system/repl/command.scm			\
   system/repl/repl.scm\
-  system/repl/server.scm
+  system/repl/server.scm			\
+  system/repl/coop-server.scm
 
 LIB_SOURCES =	\
   statprof.scm	\
diff --git a/module/system/repl/coop-server.scm b/module/system/repl/coop-server.scm
new file mode 100644
index 000..41759c9
--- /dev/null
+++ b/module/system/repl/coop-server.scm
@@ -0,0 +1,160 @@
+;;; Cooperative REPL server
+
+;; Copyright (C)  2014 Free Software Foundation, Inc.
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under

Re: Fwd: PATCH - Add cooperative REPL server module

2014-01-21 Thread David Thompson

) at threads.c:1019
#24 0x76cf8b83 in GC_inner_start_routine () from 
/usr/lib/x86_64-linux-gnu/libgc.so.1
#25 0x76cf3e72 in GC_call_with_stack_base () from 
/usr/lib/x86_64-linux-gnu/libgc.so.1
#26 0x772fae0e in start_thread (arg=0x74ea2700) at 
pthread_create.c:311
#27 0x770300fd in clone () at 
../sysdeps/unix/sysv/linux/x86_64/clone.S:113

 Please see below for comments.

Thanks for the further review.  Updated patch attached.  My technical
writing skills aren't what they should be, so an extra thanks for
helping with the documentation.

- Dave

From 952e2b3f199031896996b33bc058e42586cbc69e Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sun, 19 Jan 2014 13:16:02 -0500
Subject: [PATCH] Add cooperative REPL server module.

* module/system/repl/coop-server.scm: New module.

* module/system/repl/repl.scm (start-repl): Extract body to start-repl*.
  (start-repl*): New procedure.
  (run-repl): Extract body to run-repl*.
  (run-repl*): New procedure.

* module/system/repl/server.scm (run-server): Extract body to
  run-server*.
  (run-server*): New procedure.

* doc/ref/api-evaluation.texi: Add docs.

* module/Makefile.am: Add system/repl/coop-server.scm to SYSTEM_SOURCES.
---
 doc/ref/api-evaluation.texi|  45 +++
 module/Makefile.am |   3 +-
 module/system/repl/coop-server.scm | 156 +
 module/system/repl/repl.scm|  11 ++-
 module/system/repl/server.scm  |   5 +-
 5 files changed, 216 insertions(+), 4 deletions(-)
 create mode 100644 module/system/repl/coop-server.scm

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 7d67d9a..27585e6 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -23,6 +23,7 @@ loading, evaluating, and compiling Scheme code at run time.
 * Local Evaluation::Evaluation in a local lexical environment.
 * Local Inclusion:: Compile-time inclusion of one file in another.
 * REPL Servers::Serving a REPL over a socket.
+* Cooperative REPL Servers::REPL server for single-threaded applications.
 @end menu
 
 
@@ -1281,6 +1282,50 @@ with no arguments.
 Closes the connection on all running server sockets.
 @end deffn
 
+@node Cooperative REPL Servers
+@subsection Cooperative REPL Servers
+
+@cindex Cooperative REPL server
+
+The procedures in this section are provided by
+@lisp
+(use-modules (system repl coop-server))
+@end lisp
+
+Whereas ordinary REPL servers run in their own threads (@pxref{REPL
+Servers}), sometimes it is more convenient to provide REPLs that run at
+specified times within an existing thread, for example in programs
+utilizing an event loop or in single-threaded programs.  This allows for
+safe access and mutation of a program's data structures from the REPL,
+without concern for thread synchronization.
+
+Although the REPLs are run in the thread that calls
+@code{spawn-coop-repl-server} and @code{poll-coop-repl-server},
+dedicated threads are spawned so that the calling thread is not blocked.
+The spawned threads read input for the REPLs and to listen for new
+connections.
+
+Cooperative REPL servers must be polled periodically to evaluate any
+pending expressions by calling @code{poll-coop-repl-server} with the
+object returned from @code{spawn-coop-repl-server}.  The thread that
+calls @code{poll-coop-repl-server} will be blocked for as long as the
+expression takes to be evaluated or if the debugger is entered.
+
+@deffn {Scheme Procedure} spawn-coop-repl-server [server-socket]
+Create and return a new cooperative REPL server object, and spawn a new
+thread to listen for connections on @var{server-socket}.  Proper
+functioning of the REPL server requires that
+@code{poll-coop-repl-server} be called periodically on the returned
+server object.
+@end deffn
+
+@deffn {Scheme Procedure} poll-coop-repl-server coop-server
+Poll the cooperative REPL server @var{coop-server} and apply a pending
+operation if there is one, such as evaluating an expression typed at the
+REPL prompt.  This procedure must be called from the same thread that
+called @code{spawn-coop-repl-server}.
+@end deffn
+
 @c Local Variables:
 @c TeX-master: guile.texi
 @c End:
diff --git a/module/Makefile.am b/module/Makefile.am
index 8a7befd..b7960dc 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -360,7 +360,8 @@ SYSTEM_SOURCES =\
   system/repl/common.scm			\
   system/repl/command.scm			\
   system/repl/repl.scm\
-  system/repl/server.scm
+  system/repl/server.scm			\
+  system/repl/coop-server.scm
 
 LIB_SOURCES =	\
   statprof.scm	\
diff --git a/module/system/repl/coop-server.scm b/module/system/repl/coop-server.scm
new file mode 100644
index 000..4c8dc77
--- /dev/null
+++ b/module/system/repl/coop-server.scm
@@ -0,0 +1,156 @@
+;;; Cooperative REPL server
+
+;; Copyright (C)  2014 Free Software Foundation, Inc.
+
+;; This library is free software

PATCH - Add cooperative REPL server module

2014-01-19 Thread David Thompson


Hey all,

Attached is a patch to add a cooperative REPL server to Guile.  This
new type of REPL server allows programs that run an event loop (like a
game or a simulation) to make use of a REPL server that doesn't present
a common pitfall of multithreaded programs: Crashing when 2 threads
write to the same resource at the same time.  The cooperative REPL
ensures that evaluation only happens within the context of a single
thread, and the user can control when evaluation is allowed to happen.

By cooperative, I mean that the client REPL's are run as coroutines
using prompts.  All of the REPL's run within the same thread, the thread
that calls (spawn-coop-server) and later (poll-coop-server).  Reading
user input is passed off to another thread and the REPL prompt is
aborted.  To actually evaluate code, the user must call
(poll-coop-server) periodically.  Only one REPL can evaluate code at a
time.

Things seem to be working well.  I did basic tests by connecting to the
server via telnet and later (when I was confident that I wouldn't crash
Emacs) via Geiser.

This patch is built on top of Mark Weaver's patch to add the (ice-9
mvars) module.

What do you think?

- Dave Thompson

From 6c23c19610c1ab884d0a8ba2f3d1a94d72022303 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sun, 19 Jan 2014 13:16:02 -0500
Subject: [PATCH] Add cooperative REPL server module.

* module/system/repl/coop-server.scm: New module.

* module/system/repl/repl.scm (start-repl): Extract body to start-repl*.
(start-repl*): New procedure.

* module/system/repl/server.scm (run-server): Extract body to
  run-server*.
  (run-server*): New procedure.

* doc/ref/api-evaluation.texi: Add docs.
---
 doc/ref/api-evaluation.texi|  46 +++--
 module/system/repl/coop-server.scm | 133 +
 module/system/repl/repl.scm|   9 ++-
 module/system/repl/server.scm  |   3 +
 4 files changed, 183 insertions(+), 8 deletions(-)
 create mode 100644 module/system/repl/coop-server.scm

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 63b1d60..2fa3e62 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -1234,11 +1234,6 @@ to evaluate an installed file from source, instead of relying on the
 
 @cindex REPL server
 
-The procedures in this section are provided by
-@lisp
-(use-modules (system repl server))
-@end lisp
-
 When an application is written in Guile, it is often convenient to
 allow the user to be able to interact with it by evaluating Scheme
 expressions in a REPL.
@@ -1248,6 +1243,11 @@ which permits interaction over a local or TCP connection.  Guile itself
 uses them internally to implement the @option{--listen} switch,
 @ref{Command-line Options}.
 
+To use the REPL server, include the following module:
+@lisp
+(use-modules (system repl server))
+@end lisp
+
 @deffn {Scheme Procedure} make-tcp-server-socket [#:host=#f] @
   [#:addr] [#:port=37146]
 Return a stream socket bound to a given address @var{addr} and port
@@ -1275,6 +1275,42 @@ with no arguments.
 Closes the connection on all running server sockets.
 @end deffn
 
+For some programs, the regular REPL server may be inadequate.  For
+example, the main thread of a realtime simulation runs a loop that
+processes user input and integrates the simulation.  Using the regular
+REPL server, the main thread and a REPL client thread could attempt to
+write to the same resource at the same time, causing the program to
+crash.  Additionally, some programs rely on thread-specific context, so
+evaluating code in another thread does not have the desired effect.  The
+cooperative REPL server solves this problem by running all of the client
+REPLs within the same thread.  In order to prevent blocking, the
+responsibility of reading user input is passed to another thread.  To
+integrate this server within a loop, the loop must poll the server
+periodically to evaluate any pending expressions.
+
+The interface is essentially the same as the regular REPL server module,
+but with slightly different procedure names.
+
+To use the cooperative REPL server, include the following module:
+@lisp
+(use-modules (system repl coop-server))
+@end lisp
+
+@deffn {Scheme Procedure} run-coop-server [server-socket]
+@deffnx {Scheme Procedure} spawn-coop-server [server-socket]
+Create and run a cooperative REPL server, making it available over the
+given @var{server-socket}.  If @var{server-socket} is not provided, it
+defaults to the socket created by calling @code{make-tcp-server-socket}
+with no arguments.
+
+@code{run-coop-server} runs the server in the current thread, whereas
+@code{spawn-coop-server} runs the server in a new thread.
+@end deffn
+
+@deffn {Scheme Procedure} poll-coop-server
+Poll the server and evaluate a pending expression if there is one.
+@end deffn
+
 @c Local Variables:
 @c TeX-master: guile.texi
 @c End:
diff --git a/module/system/repl/coop

Re: [PATCH] Add procedures to convert alists into hash tables

2013-11-18 Thread David Thompson

On 11/18/2013 03:32 PM, Ludovic Courtès wrote:
 David Thompson dthomps...@worcester.edu skribis:
 
 From 03f604cc3dfffb816cfe66a355e36ede337749f1 Mon Sep 17 00:00:00 2001
 From: David Thompson dthomps...@worcester.edu
 Date: Sat, 19 Oct 2013 22:43:37 -0400
 Subject: [PATCH] Add procedures to convert alists into hash tables.

 * module/ice-9/hash-table.scm: New module.

 * test-suite/tests/hash.test (alist conversion): Add tests.

 * doc/ref/api-compound.texi (Hash Table Reference): Add docs.
 
 Agreed with Mark’s comment, but otherwise looks good to me.
 
 +(define-syntax-rule (define-alist-converter name hash-set-proc)
 +  (define (name alist)
 
 [...]
 
 +(define (alist-hashx-table hash assoc alist)
 +  Convert @var{alist} into a hash table with custom @var{hash} and
 +@var{assoc} procedures.
 
 Currently Texinfo markup in docstrings is left uninterpreted so it
 can/should be avoided (it may change in the future, but the future’s not
 now ;-)).
 
 Thanks!
 
 Ludo’.
 

Fixed texi docs and docstrings.

- Dave
From 37571c1a11d53cee176bf93ddd539f0dd91f3669 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 19 Oct 2013 22:43:37 -0400
Subject: [PATCH] Add procedures to convert alists into hash tables.

* module/ice-9/hash-table.scm: New module.

* test-suite/tests/hash.test (alist conversion): Add tests.

* doc/ref/api-compound.texi (Hash Table Reference): Add docs.

---
 doc/ref/api-compound.texi   | 21 +
 module/Makefile.am  |  1 +
 module/ice-9/hash-table.scm | 45 +
 test-suite/tests/hash.test  | 38 +-
 4 files changed, 104 insertions(+), 1 deletion(-)
 create mode 100644 module/ice-9/hash-table.scm

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 94e0145..0b14c48 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -3829,6 +3829,27 @@ then it can use @var{size} to avoid rehashing when initial entries are
 added.
 @end deffn

+@deffn {Scheme Procedure} alist-hash-table alist
+@deffnx {Scheme Procedure} alist-hashq-table alist
+@deffnx {Scheme Procedure} alist-hashv-table alist
+@deffnx {Scheme Procedure} alist-hashx-table hash assoc alist
+Convert @var{alist} into a hash table. When keys are repeated in
+@var{alist}, the leftmost association takes precedence.
+
+@example
+(use-modules (ice-9 hash-table))
+(alist-hash-table '((foo . 1) (bar . 2)))
+@end example
+
+When converting to an extended hash table, custom @var{hash} and
+@var{assoc} procedures must be provided.
+
+@example
+(alist-hashx-table hash assoc '((foo . 1) (bar . 2)))
+@end example
+
+@end deffn
+
 @deffn {Scheme Procedure} hash-table? obj
 @deffnx {C Function} scm_hash_table_p (obj)
 Return @code{#t} if @var{obj} is a abstract hash table object.
diff --git a/module/Makefile.am b/module/Makefile.am
index e8dcd4a..8a7befd 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -207,6 +207,7 @@ ICE_9_SOURCES = \
   ice-9/format.scm \
   ice-9/futures.scm \
   ice-9/getopt-long.scm \
+  ice-9/hash-table.scm \
   ice-9/hcons.scm \
   ice-9/i18n.scm \
   ice-9/iconv.scm \
diff --git a/module/ice-9/hash-table.scm b/module/ice-9/hash-table.scm
new file mode 100644
index 000..ca9d2fd
--- /dev/null
+++ b/module/ice-9/hash-table.scm
@@ -0,0 +1,45 @@
+ hash-table.scm --- Additional hash table procedures
+ Copyright (C) 2013 Free Software Foundation, Inc.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ This library 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
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (ice-9 hash-table)
+  #:export (alist-hash-table
+alist-hashq-table
+alist-hashv-table
+alist-hashx-table))
+
+(define-syntax-rule (define-alist-converter name hash-set-proc)
+  (define (name alist)
+Convert ALIST into a hash table.
+(let ((table (make-hash-table)))
+  (for-each (lambda (pair)
+  (hash-set-proc table (car pair) (cdr pair)))
+(reverse alist))
+  table)))
+
+(define-alist-converter alist-hash-table hash-set!)
+(define-alist-converter alist-hashq-table hashq-set!)
+(define-alist-converter alist-hashv-table hashv-set!)
+
+(define (alist-hashx-table hash assoc alist)
+  Convert ALIST into a hash table with custom HASH

Re: [PATCH] Add procedures to convert alists into hash tables

2013-11-17 Thread David Thompson

On 11/06/2013 07:54 AM, Ludovic Courtès wrote:
 Mark H Weaver m...@netris.org skribis:
 
 Thompson, David dthomps...@worcester.edu writes:

 On Tue, Oct 29, 2013 at 8:38 AM, Ludovic Courtès l...@gnu.org wrote:
 I think it would make sense to implement them in Scheme, say in
 ice-9/hash-table.scm, which could be either a separate module or a file
 included from boot-9.scm.

 WDYT?

 Does anyone else feel that this is a better approach?

 FWIW, I think Ludovic is right.  There's no compelling reason to write
 these procedures in C, and it would be good to reduce the amount of C
 code for several reasons.  However, unlike ttn, I think it would be good
 to have these procedures in core Guile.
 
 Agreed.
 
 David: would you be willing to do that?  Apologies for my late comment,
 and for the extra work involved.  Your contributions are appreciated!
 
 Thanks,
 Ludo’.
 

Finally got around to updating this patch. I opted for adding a
standalone module named (ice-9 hash-table) rather than including it from
boot-9.

How did I do?

- Dave
From 30b122a2638689e919f8b6722905ed5fa51e2138 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 19 Oct 2013 22:43:37 -0400
Subject: [PATCH] Add procedures to convert alists into hash tables.

* module/ice-9/hash-table.scm: New module.

* test-suite/tests/hash.test (alist conversion): Add tests.

* doc/ref/api-compound.texi (Hash Table Reference): Add docs.
---
 doc/ref/api-compound.texi   | 21 +
 module/ice-9/hash-table.scm | 45 +
 test-suite/tests/hash.test  | 38 +-
 3 files changed, 103 insertions(+), 1 deletion(-)
 create mode 100644 module/ice-9/hash-table.scm

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 94e0145..9e5e649 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -3829,6 +3829,27 @@ then it can use @var{size} to avoid rehashing when initial entries are
 added.
 @end deffn
 
+@deffn {Scheme Procedure} alist-hash-table alist
+@deffnx {Scheme Procedure} alist-hashq-table alist
+@deffnx {Scheme Procedure} alist-hashv-table alist
+@deffnx {Scheme Procedure} alist-hashx-table hash assoc alist
+Convert @var{alist} into a hash table. When keys are repeated in
+@var{alist}, the leftmost association takes precedence.
+
+@example
+(use-modules (ice-9 hash-table))
+(alist-hash-table '((foo . 1) (bar . 2)))
+@end example
+
+When converting to an extended hash table, custom @var{hash} and
+@var{assoc} procedures must be provided.
+
+@example
+(alist-hash-table hash assoc '((foo . 1) (bar . 2)))
+@end example
+
+@end deffn
+
 @deffn {Scheme Procedure} hash-table? obj
 @deffnx {C Function} scm_hash_table_p (obj)
 Return @code{#t} if @var{obj} is a abstract hash table object.
diff --git a/module/ice-9/hash-table.scm b/module/ice-9/hash-table.scm
new file mode 100644
index 000..6b0fa04
--- /dev/null
+++ b/module/ice-9/hash-table.scm
@@ -0,0 +1,45 @@
+ hash-table.scm --- Additional hash table procedures
+ Copyright (C) 2013 Free Software Foundation, Inc.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ This library 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
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (ice-9 hash-table)
+  #:export (alist-hash-table
+alist-hashq-table
+alist-hashv-table
+alist-hashx-table))
+
+(define-syntax-rule (define-alist-converter name hash-set-proc)
+  (define (name alist)
+Convert @var{alist} into a hash table.
+(let ((table (make-hash-table)))
+  (for-each (lambda (pair)
+  (hash-set-proc table (car pair) (cdr pair)))
+(reverse alist))
+  table)))
+
+(define-alist-converter alist-hash-table hash-set!)
+(define-alist-converter alist-hashq-table hashq-set!)
+(define-alist-converter alist-hashv-table hashv-set!)
+
+(define (alist-hashx-table hash assoc alist)
+  Convert @var{alist} into a hash table with custom @var{hash} and
+@var{assoc} procedures.
+  (let ((table (make-hash-table)))
+(for-each (lambda (pair)
+(hashx-set! hash assoc table (car pair) (cdr pair)))
+  (reverse alist))
+table))
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index 3bd4004..ad247f5 100644
--- a/test-suite/tests

Re: [PATCH] Add procedures to convert alists into hash tables

2013-11-17 Thread David Thompson

On 11/17/2013 08:50 PM, David Thompson wrote:
 Finally got around to updating this patch. I opted for adding a
 standalone module named (ice-9 hash-table) rather than including it from
 boot-9.
 
 How did I do?
 
 - Dave
 

Forgot to add the new module file to Makefile.am.

Updated patch attached.

- Dave
From 03f604cc3dfffb816cfe66a355e36ede337749f1 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 19 Oct 2013 22:43:37 -0400
Subject: [PATCH] Add procedures to convert alists into hash tables.

* module/ice-9/hash-table.scm: New module.

* test-suite/tests/hash.test (alist conversion): Add tests.

* doc/ref/api-compound.texi (Hash Table Reference): Add docs.
---
 doc/ref/api-compound.texi   | 21 +
 module/Makefile.am  |  1 +
 module/ice-9/hash-table.scm | 45 +
 test-suite/tests/hash.test  | 38 +-
 4 files changed, 104 insertions(+), 1 deletion(-)
 create mode 100644 module/ice-9/hash-table.scm

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 94e0145..9e5e649 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -3829,6 +3829,27 @@ then it can use @var{size} to avoid rehashing when initial entries are
 added.
 @end deffn
 
+@deffn {Scheme Procedure} alist-hash-table alist
+@deffnx {Scheme Procedure} alist-hashq-table alist
+@deffnx {Scheme Procedure} alist-hashv-table alist
+@deffnx {Scheme Procedure} alist-hashx-table hash assoc alist
+Convert @var{alist} into a hash table. When keys are repeated in
+@var{alist}, the leftmost association takes precedence.
+
+@example
+(use-modules (ice-9 hash-table))
+(alist-hash-table '((foo . 1) (bar . 2)))
+@end example
+
+When converting to an extended hash table, custom @var{hash} and
+@var{assoc} procedures must be provided.
+
+@example
+(alist-hash-table hash assoc '((foo . 1) (bar . 2)))
+@end example
+
+@end deffn
+
 @deffn {Scheme Procedure} hash-table? obj
 @deffnx {C Function} scm_hash_table_p (obj)
 Return @code{#t} if @var{obj} is a abstract hash table object.
diff --git a/module/Makefile.am b/module/Makefile.am
index e8dcd4a..8a7befd 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -207,6 +207,7 @@ ICE_9_SOURCES = \
   ice-9/format.scm \
   ice-9/futures.scm \
   ice-9/getopt-long.scm \
+  ice-9/hash-table.scm \
   ice-9/hcons.scm \
   ice-9/i18n.scm \
   ice-9/iconv.scm \
diff --git a/module/ice-9/hash-table.scm b/module/ice-9/hash-table.scm
new file mode 100644
index 000..6b0fa04
--- /dev/null
+++ b/module/ice-9/hash-table.scm
@@ -0,0 +1,45 @@
+ hash-table.scm --- Additional hash table procedures
+ Copyright (C) 2013 Free Software Foundation, Inc.
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 3 of the License, or (at your option) any later version.
+
+ This library 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
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with this library; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+(define-module (ice-9 hash-table)
+  #:export (alist-hash-table
+alist-hashq-table
+alist-hashv-table
+alist-hashx-table))
+
+(define-syntax-rule (define-alist-converter name hash-set-proc)
+  (define (name alist)
+Convert @var{alist} into a hash table.
+(let ((table (make-hash-table)))
+  (for-each (lambda (pair)
+  (hash-set-proc table (car pair) (cdr pair)))
+(reverse alist))
+  table)))
+
+(define-alist-converter alist-hash-table hash-set!)
+(define-alist-converter alist-hashq-table hashq-set!)
+(define-alist-converter alist-hashv-table hashv-set!)
+
+(define (alist-hashx-table hash assoc alist)
+  Convert @var{alist} into a hash table with custom @var{hash} and
+@var{assoc} procedures.
+  (let ((table (make-hash-table)))
+(for-each (lambda (pair)
+(hashx-set! hash assoc table (car pair) (cdr pair)))
+  (reverse alist))
+table))
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index 3bd4004..ad247f5 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -18,7 +18,8 @@
 
 (define-module (test-suite test-numbers)
   #:use-module (test-suite lib)
-  #:use-module (ice-9 documentation))
+  #:use-module (ice-9 documentation)
+  #:use-module (ice-9 hash-table))
 
 ;;;
 ;;; hash
@@ -81,6 +82,41 @@
   (write (make-hash-table 100)))
 
 ;;;
+;;; alist

[PATCH] Add procedures to convert alists into hash tables

2013-10-20 Thread David Thompson


Hello all,

When looking through the different hash table implementations available 
(Guile, SRFI-69, and RNRS) I found a useful SRFI-69 procedure that had 
no equivalent in Guile's native hash table API: alist-hash-table.


This patch is an attempt to add that. It works for all four types of 
hash tables: equal?, eq?, eqv? and custom.


- Dave
From e303098404321cbe2b978d526ee2737137a5d5b1 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 19 Oct 2013 22:43:37 -0400
Subject: [PATCH] Add procedures to convert alists into hash tables.

* libguile/hashtab.c (scm_alist_to_hash_table, scm_alist_to_hashq_table,
  scm_alist_to_hashv_table, scm_alist_to_hashx_table): Add the
  equivalent of SRFI-69's alist-hash-table procedure for the native
  hash table implementation.

* test-suite/tests/hash.test (alist-hash-table): Add tests.

* doc/ref/api-compound.texi (alist-hash-table): Add docs.
---
 doc/ref/api-compound.texi  | 18 ++
 libguile/hashtab.c | 61 ++
 libguile/hashtab.h |  6 +
 test-suite/tests/hash.test | 27 
 4 files changed, 112 insertions(+)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 94e0145..9794e28 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -3829,6 +3829,24 @@ then it can use @var{size} to avoid rehashing when initial entries are
 added.
 @end deffn
 
+@deffn {Scheme Procedure} alist-hash-table alist [size]
+@deffnx {Scheme Procedure} alist-hashq-table alist [size]
+@deffnx {Scheme Procedure} alist-hashv-table alist [size]
+@deffnx {Scheme Procedure} alist-hashx-table hash assoc alist [size]
+@deffnx {C Function} scm_alist_to_hash_table (alist, size)
+@deffnx {C Function} scm_alist_to_hashq_table (alist, size)
+@deffnx {C Function} scm_alist_to_hashv_table (alist, size)
+@deffnx {C Function} scm_alist_to_hashx_table (alist, size)
+Convert @var{alist} into a hash table with minimum number of buckets
+@var{n}. When keys are repeated in @var{alist}, the leftmost association
+takes precedence.
+
+@example
+(alist-hash-table '((foo . 1) (bar . 2)))
+@end example
+
+@end deffn
+
 @deffn {Scheme Procedure} hash-table? obj
 @deffnx {C Function} scm_hash_table_p (obj)
 Return @code{#t} if @var{obj} is a abstract hash table object.
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 88cb199..c215269 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -423,6 +423,67 @@ SCM_DEFINE (scm_make_hash_table, make-hash-table, 0, 1, 0,
 }
 #undef FUNC_NAME
 
+#define SCM_ALIST_TO_HASH_TABLE(alist, n, hash_set_fn) \
+  SCM hash_table; \
+  SCM_VALIDATE_LIST (1, alist); \
+  hash_table = scm_make_hash_table (n); \
+  while (!scm_is_null (alist)) { \
+SCM pair = SCM_CAR (alist); \
+hash_set_fn (hash_table, scm_car (pair), scm_cdr (pair));   \
+alist = SCM_CDR (alist); \
+  } \
+  return hash_table;
+
+SCM_DEFINE (scm_alist_to_hash_table, alist-hash-table, 1, 1, 0,
+	(SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hash_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hash_set_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashq_table, alist-hashq-table, 1, 1, 0,
+	(SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hashq_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hashq_set_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashv_table, alist-hashv-table, 1, 1, 0,
+	(SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hashv_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hashv_set_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashx_table, alist-hashx-table, 3, 1, 0,
+	(SCM hash, SCM assoc, SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hashx_table
+{
+  SCM hash_table;
+  SCM_VALIDATE_LIST (3, alist);
+  hash_table = scm_make_hash_table (n);
+
+  while (!scm_is_null (alist)) {
+SCM pair = SCM_CAR (alist);
+scm_hashx_set_x (hash, assoc, hash_table, scm_car (pair), scm_cdr (pair));
+alist = SCM_CDR (alist);
+  }
+
+  return hash_table;
+}
+#undef FUNC_NAME
+
 /* The before-gc C hook only runs if GC_set_start_callback is available,
so if not, fall back on a finalizer-based implementation.  */
 static int
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index dcebcb8..da4f28c 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -101,6 +101,12 @@ SCM_API SCM scm_make_weak_key_hash_table (SCM k);
 SCM_API SCM scm_make_weak_value_hash_table (SCM k);
 SCM_API SCM scm_make_doubly_weak_hash_table (SCM k);
 
+SCM_API SCM

Re: [PATCH] Add procedures to convert alists into hash tables

2013-10-20 Thread David Thompson


On 10/20/2013 10:14 AM, David Thompson wrote:

Hello all,

When looking through the different hash table implementations 
available (Guile, SRFI-69, and RNRS) I found a useful SRFI-69 
procedure that had no equivalent in Guile's native hash table API: 
alist-hash-table.


This patch is an attempt to add that. It works for all four types of 
hash tables: equal?, eq?, eqv? and custom.


- Dave

Found an inconsistency in the docs. Updated patch attached.

- Dave
From 46b7905727ad2efed2dc1d1aca4d4ad00d8f48c5 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sat, 19 Oct 2013 22:43:37 -0400
Subject: [PATCH] Add procedures to convert alists into hash tables.

* libguile/hashtab.c (scm_alist_to_hash_table, scm_alist_to_hashq_table,
  scm_alist_to_hashv_table, scm_alist_to_hashx_table): Add the
  equivalent of SRFI-69's alist-hash-table procedure for the native
  hash table implementation.

* test-suite/tests/hash.test (alist-hash-table): Add tests.

* doc/ref/api-compound.texi (alist-hash-table): Add docs.
---
 doc/ref/api-compound.texi  | 18 ++
 libguile/hashtab.c | 61 ++
 libguile/hashtab.h |  6 +
 test-suite/tests/hash.test | 27 
 4 files changed, 112 insertions(+)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 94e0145..06115be 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -3829,6 +3829,24 @@ then it can use @var{size} to avoid rehashing when initial entries are
 added.
 @end deffn
 
+@deffn {Scheme Procedure} alist-hash-table alist [size]
+@deffnx {Scheme Procedure} alist-hashq-table alist [size]
+@deffnx {Scheme Procedure} alist-hashv-table alist [size]
+@deffnx {Scheme Procedure} alist-hashx-table hash assoc alist [size]
+@deffnx {C Function} scm_alist_to_hash_table (alist, size)
+@deffnx {C Function} scm_alist_to_hashq_table (alist, size)
+@deffnx {C Function} scm_alist_to_hashv_table (alist, size)
+@deffnx {C Function} scm_alist_to_hashx_table (hash, assoc, alist, size)
+Convert @var{alist} into a hash table with minimum number of buckets
+@var{size}. When keys are repeated in @var{alist}, the leftmost
+association takes precedence.
+
+@example
+(alist-hash-table '((foo . 1) (bar . 2)))
+@end example
+
+@end deffn
+
 @deffn {Scheme Procedure} hash-table? obj
 @deffnx {C Function} scm_hash_table_p (obj)
 Return @code{#t} if @var{obj} is a abstract hash table object.
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 88cb199..c215269 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -423,6 +423,67 @@ SCM_DEFINE (scm_make_hash_table, make-hash-table, 0, 1, 0,
 }
 #undef FUNC_NAME
 
+#define SCM_ALIST_TO_HASH_TABLE(alist, n, hash_set_fn) \
+  SCM hash_table; \
+  SCM_VALIDATE_LIST (1, alist); \
+  hash_table = scm_make_hash_table (n); \
+  while (!scm_is_null (alist)) { \
+SCM pair = SCM_CAR (alist); \
+hash_set_fn (hash_table, scm_car (pair), scm_cdr (pair));   \
+alist = SCM_CDR (alist); \
+  } \
+  return hash_table;
+
+SCM_DEFINE (scm_alist_to_hash_table, alist-hash-table, 1, 1, 0,
+	(SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hash_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hash_set_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashq_table, alist-hashq-table, 1, 1, 0,
+	(SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hashq_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hashq_set_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashv_table, alist-hashv-table, 1, 1, 0,
+	(SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hashv_table
+{
+  SCM_ALIST_TO_HASH_TABLE (alist, n, scm_hashv_set_x);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_alist_to_hashx_table, alist-hashx-table, 3, 1, 0,
+	(SCM hash, SCM assoc, SCM alist, SCM n),
+Convert @var{alist} into a hash table with minimum number of 
+buckets @var{n}.)
+#define FUNC_NAME s_scm_alist_to_hashx_table
+{
+  SCM hash_table;
+  SCM_VALIDATE_LIST (3, alist);
+  hash_table = scm_make_hash_table (n);
+
+  while (!scm_is_null (alist)) {
+SCM pair = SCM_CAR (alist);
+scm_hashx_set_x (hash, assoc, hash_table, scm_car (pair), scm_cdr (pair));
+alist = SCM_CDR (alist);
+  }
+
+  return hash_table;
+}
+#undef FUNC_NAME
+
 /* The before-gc C hook only runs if GC_set_start_callback is available,
so if not, fall back on a finalizer-based implementation.  */
 static int
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index dcebcb8..da4f28c 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -101,6 +101,12 @@ SCM_API SCM scm_make_weak_key_hash_table

Re: A more generic REPL server

2013-10-06 Thread David Thompson


On 10/06/2013 06:08 AM, Chaos Eternal wrote:

Is this thing a threadless repl server?
if so, i suggest that the code be separated and can be easily
integrated into other project.

the guile-scsh badly needs such a feature.


It's not exactly threadless. There is one server thread that waits for 
clients, and for each client there is one thread that waits for user 
input. The difference is that the client REPL is executed in the main 
thread, sans reading user input. I use my own coroutine and scheduler 
modules to do it in guile-2d. I call it the cooperative REPL.


I agree that it would be nice to extract this into something that more 
people could use. The modules in question are (2d coroutine), (2d 
agenda), and (2d repl coop-repl).


https://github.com/davexunit/guile-2d/blob/master/2d/coroutine.scm
https://github.com/davexunit/guile-2d/blob/master/2d/agenda.scm
https://github.com/davexunit/guile-2d/blob/repl-v2/2d/repl/coop-repl.scm

Thoughts?

A more generic REPL server

2013-10-04 Thread David Thompson

Hello all,

As some of you know, I am writing my own custom REPL that fits nicely
with my game framework, guile-2d. I just finished hacking (system repl
server) to suit my needs and things seem to be working well.

Looking upon the diff, I see that I only changed the serve-client
procedure. Thus, I think it would be a good idea to build some
abstraction that allows custom REPLs to be run, not just start-repl in
(system repl repl).

Here is the original serve-client method:

(define (serve-client client addr)
  (with-continuation-barrier
   (lambda ()
 (with-input-from-port client
   (lambda ()
 (with-output-to-port client
   (lambda ()
 (with-error-to-port client
   (lambda ()
 (with-fluids ((*repl-stack* '()))
   (start-repl))
  (close-socket! client))

And here is my version:

(define (serve-client client addr)
  (agenda-schedule
   (colambda ()
 (with-input-from-port client
   (lambda ()
 (with-output-to-port client
   (lambda ()
 (with-error-to-port client
   (lambda ()
 (with-fluids ((*repl-stack* '()))
   (start-repl
   (close-socket! client

In this snippet, start-repl comes from a guile-2d module, not (system
repl repl).

There's an abstraction lurking here, but I'm not quite sure what it is.
I've removed the continuation barrier, changed the start-repl procedure,
and wrapped everything in a form that creates a coroutine. I tried
simply adding an additional argument to spawn-server that specifies the
procedure used to serve the client. However, close-socket! is private,
and I don't think it would be a good idea to expose it.

Can anyone think of a good way to generalize this?

Thanks,

- Dave

Re: [PATCH] Add read-wrapper REPL option

2013-10-03 Thread David Thompson

On 09/29/2013 06:10 PM, David Thompson wrote:
 Guile-2D needs a REPL that runs within its event loop without blocking
 when reading user input. Mark Weaver has helped me add a new REPL
 option, read-wrapper, that can be used by Guile-2D to push the read
 operation into another thread while the main thread's event loop
 continues to run as normal. This avoids the problem of thread safety
 with the normal REPL server.
 
 I think that this could be useful for other programs that run in an
 event loop. Perhaps Emacsy?
 
 - Dave Thompson

Here is an updated patch. I've updated prompting-meta-read to preserve
the REPL stack when the reader thunk is called, in the case of the thunk
being called outside of the current thread.
From b7cae3fb33d2cc059c4016709e4d0630eee1610d Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sun, 29 Sep 2013 18:01:31 -0400
Subject: [PATCH] Add read-wrapper REPL option.

* module/system/repl/common.scm (repl-default-options): Add read-wrapper
  REPL option.

* module/system/repl/repl.scm (prompting-meta-read): Use read-wrapper
  REPL option.
---
 module/system/repl/common.scm |  4 
 module/system/repl/repl.scm   | 35 ++-
 2 files changed, 26 insertions(+), 13 deletions(-)

diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 5da7c48..030d5de 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -125,6 +125,10 @@ See http://www.gnu.org/licenses/lgpl.html, for more details.)
((not print) #f)
((procedure? print) print)
(else (error Invalid print procedure print)
+ (read-wrapper
+  ,(lambda (thunk)
+ (thunk))
+  #f)
  (value-history
   ,(value-history-enabled?)
   ,(lambda (x)
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 1649556..97adf72 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -107,20 +107,29 @@
 ;; to be able to re-use the existing readline machinery.
 ;;
 ;; Catches read errors, returning *unspecified* in that case.
+;;
+;; The reader thunk is passed into the read-wrapper procedure. The state
+;; of the stack is maintained, in case of the thunk being called outside
+;; of the current thread.
 (define (prompting-meta-read repl)
-  (catch #t
-(lambda ()
-  (repl-reader (lambda () (repl-prompt repl))
-   (meta-reader (repl-language repl) (current-module
-(lambda (key . args)
-  (case key
-((quit)
- (apply throw key args))
-(else
- (format (current-output-port) While reading expression:\n)
- (print-exception (current-output-port) #f key args)
- (flush-all-input)
- *unspecified*)
+  (let ((read-wrapper (repl-option-ref repl 'read-wrapper))
+(stack (fluid-ref *repl-stack*)))
+(read-wrapper
+ (lambda ()
+   (with-fluids ((*repl-stack* stack))
+ (catch #t
+   (lambda ()
+ (repl-reader (lambda () (repl-prompt repl))
+  (meta-reader (repl-language repl) (current-module
+   (lambda (key . args)
+ (case key
+   ((quit)
+(apply throw key args))
+   (else
+(format (current-output-port) While reading expression:\n)
+(print-exception (current-output-port) #f key args)
+(flush-all-input)
+*unspecified*)
 
 
 
-- 
1.8.4.rc3

[PATCH] Add read-wrapper REPL option

2013-09-29 Thread David Thompson

Guile-2D needs a REPL that runs within its event loop without blocking
when reading user input. Mark Weaver has helped me add a new REPL
option, read-wrapper, that can be used by Guile-2D to push the read
operation into another thread while the main thread's event loop
continues to run as normal. This avoids the problem of thread safety
with the normal REPL server.

I think that this could be useful for other programs that run in an
event loop. Perhaps Emacsy?

- Dave Thompson
From 57e11747ee43d42e09b5c80e545f12728c75fbf5 Mon Sep 17 00:00:00 2001
From: David Thompson dthomps...@worcester.edu
Date: Sun, 29 Sep 2013 18:01:31 -0400
Subject: [PATCH] Add read-wrapper REPL option.

* module/system/repl/common.scm (repl-default-options): Add read-wrapper
  REPL option.

* module/system/repl/repl.scm (prompting-meta-read): Use read-wrapper
  REPL option.
---
 module/system/repl/common.scm |  4 
 module/system/repl/repl.scm   | 29 -
 2 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 5da7c48..030d5de 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -125,6 +125,10 @@ See http://www.gnu.org/licenses/lgpl.html, for more details.)
((not print) #f)
((procedure? print) print)
(else (error Invalid print procedure print)
+ (read-wrapper
+  ,(lambda (thunk)
+ (thunk))
+  #f)
  (value-history
   ,(value-history-enabled?)
   ,(lambda (x)
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 1649556..23c624a 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -108,19 +108,22 @@
 ;;
 ;; Catches read errors, returning *unspecified* in that case.
 (define (prompting-meta-read repl)
-  (catch #t
-(lambda ()
-  (repl-reader (lambda () (repl-prompt repl))
-   (meta-reader (repl-language repl) (current-module
-(lambda (key . args)
-  (case key
-((quit)
- (apply throw key args))
-(else
- (format (current-output-port) While reading expression:\n)
- (print-exception (current-output-port) #f key args)
- (flush-all-input)
- *unspecified*)
+  (let ((read-wrapper (repl-option-ref repl 'read-wrapper)))
+(read-wrapper
+ (lambda ()
+   (catch #t
+ (lambda ()
+   (repl-reader (lambda () (repl-prompt repl))
+(meta-reader (repl-language repl) (current-module
+ (lambda (key . args)
+   (case key
+ ((quit)
+  (apply throw key args))
+ (else
+  (format (current-output-port) While reading expression:\n)
+  (print-exception (current-output-port) #f key args)
+  (flush-all-input)
+  *unspecified*
 
 
 
-- 
1.8.4.rc3

[PATCH] Add unboxed floating point comparison instructions.

Attempting to unbox struct fields

Re: [PATCH] ice-9: Add JSON module.

[PATCH] ice-9: Add JSON module.

[PATCH] web: http: Accept blank Content-Type headers.

[PATCH] socket: Add AF_NETLINK support.

Handling HTTP Upgrade requests

Re: WebSockets

MIME type guessing module

Re: inotify ffi

Re: inotify ffi

[ANN] guile-toxcore

Re: [ANN] guile-toxcore

Re: [FEATURE Request] Built-in server should support a thunk as body

Re: Welcome Mark as new co-maintainer

Re: [PATCH] Test for weak pairs in hash-for-each

[PATCH] Test for weak pairs in hash-for-each

Re: Fwd: PATCH - Add cooperative REPL server module

Re: Fwd: PATCH - Add cooperative REPL server module

PATCH - Add cooperative REPL server module

Re: [PATCH] Add procedures to convert alists into hash tables

Re: [PATCH] Add procedures to convert alists into hash tables

Re: [PATCH] Add procedures to convert alists into hash tables

[PATCH] Add procedures to convert alists into hash tables

Re: [PATCH] Add procedures to convert alists into hash tables

Re: A more generic REPL server

A more generic REPL server

Re: [PATCH] Add read-wrapper REPL option

[PATCH] Add read-wrapper REPL option

29 matches

Site Navigation

Mail list logo

Footer information