[Gd-chatter] r11740 - in trunk: fundev/sources/environment/dswank fundev/sources/registry/generic libraries/programming-tools/lisp-reader libraries/registry/generic

[andreas at gwydiondylan.org]

Author: andreas
Date: Fri Mar 21 02:43:31 2008
New Revision: 11740

Added:
   trunk/fundev/sources/environment/dswank/
   trunk/fundev/sources/environment/dswank/dswank-exports.dylan   (contents, props changed)
   trunk/fundev/sources/environment/dswank/dswank.dylan   (contents, props changed)
   trunk/fundev/sources/environment/dswank/dswank.lid   (contents, props changed)
   trunk/fundev/sources/registry/generic/dswank   (contents, props changed)
   trunk/libraries/programming-tools/lisp-reader/
   trunk/libraries/programming-tools/lisp-reader/lisp-reader-exports.dylan   (contents, props changed)
   trunk/libraries/programming-tools/lisp-reader/lisp-reader.dylan   (contents, props changed)
   trunk/libraries/programming-tools/lisp-reader/lisp-reader.lid   (contents, props changed)
   trunk/libraries/registry/generic/lisp-reader   (contents, props changed)
Log:
job: fd

Support for talking to slime mode in emacs.



Added: trunk/fundev/sources/environment/dswank/dswank-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/environment/dswank/dswank-exports.dylan	Fri Mar 21 02:43:31 2008
@@ -0,0 +1,17 @@
+module: dylan-user
+
+define library dswank
+  use common-dylan;
+  use io;
+  use network;
+  use lisp-reader;
+end library;
+
+define module dswank
+  use common-dylan;
+  use lisp-reader;
+  use format;
+  use streams;
+  use standard-io;
+  use sockets;
+end module;

Added: trunk/fundev/sources/environment/dswank/dswank.dylan
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/environment/dswank/dswank.dylan	Fri Mar 21 02:43:31 2008
@@ -0,0 +1,80 @@
+module: dswank
+synopsis: 
+author: 
+copyright: 
+
+define constant $emacs-commands = make(<table>);
+
+define macro emacs-command-definer
+  {
+   define emacs-command ?:name (?args:*)
+     ?:body
+   end
+} => {
+   define function ?name (?args);
+     ?body
+   end;
+   $emacs-commands[":" ## ?#"name"] := ?name;
+ }
+end;
+
+define emacs-command emacs-rex (command, package, thread-id, request-id)
+  // do funky stuff
+  block()
+    let function = $swank-functions[command.head];
+    let result = apply(function, command.tail);
+    list(#":return", list(#":ok", result), request-id);
+  exception(e :: <error>)
+    list(#":return", #(#":abort"), request-id);
+  end;
+end;
+
+define constant $swank-functions = make(<table>);
+
+define macro swank-function-definer
+  {
+   define swank-function ?:name (?args:*)
+     ?:body
+   end
+} => {
+   define function ?name (?args);
+     ?body
+   end;
+   $swank-functions["swank:" ## ?#"name"] := ?name;
+ }
+end;
+
+define swank-function connection-info ()
+  #(#":pid", 23, 
+    #":style", #":fd-handler",
+    #":lisp-implementation", #(#":type", "dylan",
+                               #":name", "opendylan",
+                               #":version", "1.0beta5"),
+    #":version", "2008-01-27");
+end;
+
+define swank-function find-definitions-for-emacs (symbol-name)
+  list(list(symbol-name, #(#":file", "/home/andreas/trunk/fundev/sources/environment/dswank/dswank.dylan", #":position", 0)));
+end;
+
+define function main()
+  start-sockets();
+  let socket = make(<server-socket>, port: 3456);
+  let stream = accept(socket);
+  while(#t)
+    let length = string-to-integer(read(stream, 6), base: 16);
+    let line = read(stream, length);
+    format(*standard-error*, "%s\n", line);
+    let expr = read-lisp(make(<string-stream>, direction: #"input", contents: line));
+    let function = $emacs-commands[expr.head];
+    let result = apply(function, expr.tail);
+    let newstream = make(<string-stream>, direction: #"output");
+    print-s-expression(newstream, result);
+    let s-expression = stream-contents(newstream);
+    format(*standard-error*, "%s\n", s-expression);
+    let siz = integer-to-string(s-expression.size, base: 16, size: 6);
+    format(stream, "%s%s", siz, s-expression);
+  end;
+end;
+
+main();
\ No newline at end of file

Added: trunk/fundev/sources/environment/dswank/dswank.lid
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/environment/dswank/dswank.lid	Fri Mar 21 02:43:31 2008
@@ -0,0 +1,4 @@
+library: dswank
+executable: dswank
+files: dswank-exports
+  dswank

Added: trunk/fundev/sources/registry/generic/dswank
==============================================================================
--- (empty file)
+++ trunk/fundev/sources/registry/generic/dswank	Fri Mar 21 02:43:31 2008
@@ -0,0 +1 @@
+abstract://dylan/environment/dswank/dswank.lid
\ No newline at end of file

Added: trunk/libraries/programming-tools/lisp-reader/lisp-reader-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/programming-tools/lisp-reader/lisp-reader-exports.dylan	Fri Mar 21 02:43:31 2008
@@ -0,0 +1,17 @@
+module: dylan-user
+
+define library lisp-reader
+  use common-dylan;
+  use io;
+
+  export lisp-reader;
+end library;
+
+define module lisp-reader
+  use common-dylan;
+  use streams;
+  use format;
+  use standard-io;
+
+  export read-lisp, print-s-expression;
+end module;

Added: trunk/libraries/programming-tools/lisp-reader/lisp-reader.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/programming-tools/lisp-reader/lisp-reader.dylan	Fri Mar 21 02:43:31 2008
@@ -0,0 +1,113 @@
+module: lisp-reader
+synopsis: 
+author: 
+copyright: 
+
+define constant $whitespace = one-of('\t', ' ', '\n', '\r');
+define constant $end-of-symbol = type-union($whitespace, singleton(')'));
+
+define function skip-whitespace (stream :: <stream>) => ();
+  if (~ stream-at-end?(stream))
+    let el = peek(stream);
+    if (instance?(el, $whitespace))
+      read-element(stream);
+      skip-whitespace(stream);
+    end;
+  end;
+end;
+
+define function read-lisp (stream :: <stream>) => (result);
+  skip-whitespace(stream);
+  let ele = peek(stream);
+  let result =
+    select (ele)
+      '(' => read-s-expression(stream);
+      '"' => read-string(stream);
+      '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'
+        => read-number(stream);
+      otherwise => read-symbol(stream);
+    end;
+  result;
+end;
+
+define function read-s-expression (stream :: <stream>) => (result :: <list>);
+  read-element(stream); // consume '('
+  let result = #();
+  skip-whitespace(stream);
+  while (peek(stream) ~== ')')
+    result := pair(read-lisp(stream), result);
+  end;
+  read-element(stream); // consume ')'
+  reverse(result);
+end;
+
+define function read-string (stream :: <stream>) => (result :: <string>)
+  read-element(stream); // consume "
+  let result = "";
+  skip-whitespace(stream);
+  while (peek(stream) ~== '"')
+    let c = read-element(stream);
+    if (c == '\\')
+      c := read-element(stream);
+      c := select(c)
+             't' => '\t';
+             'r' => '\r';
+             'n' => '\n';
+             otherwise => c;
+           end;
+    end;
+    result := add!(result, c);
+  end;
+  read-element(stream); // consume "
+  result;
+end;
+
+define function read-word (stream :: <stream>) => (result :: <string>)
+  let result = "";
+  skip-whitespace(stream);
+  while (~stream-at-end?(stream) & ~instance?(peek(stream), $end-of-symbol))
+    result := add!(result, read-element(stream));
+  end;
+  result;
+end;
+
+define function read-number (stream :: <stream>) => (result :: <integer>)
+  string-to-integer(read-word(stream));
+end;
+
+define function read-symbol (stream :: <stream>) => (result :: <symbol>)
+  as(<symbol>, read-word(stream));
+end;
+
+define function test ()
+  while(#t)
+    let line = read-line(*standard-input*);
+    let stream = make(<string-stream>, direction: #"input", contents: line);
+    let expr = read-lisp(stream);
+    format(*standard-output*, "%=\n", expr);
+  end;
+end;
+
+//test();
+
+define method print-s-expression (stream :: <stream>, expression :: <integer>)
+  format(stream, "%d", expression);
+end;
+
+define method print-s-expression (stream :: <stream>, expression :: <symbol>)
+  format(stream, "%s", expression);
+end;
+
+define method print-s-expression (stream :: <stream>, expression :: <string>)
+  format(stream, "%=", expression);
+end;
+
+define method print-s-expression (stream :: <stream>, expression :: <list>)
+  format(stream, "(");
+  for (e in expression)
+    print-s-expression(stream, e);
+    format(stream, " ");
+  end;
+  format(stream, ")");  
+end;
+

Added: trunk/libraries/programming-tools/lisp-reader/lisp-reader.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/programming-tools/lisp-reader/lisp-reader.lid	Fri Mar 21 02:43:31 2008
@@ -0,0 +1,4 @@
+library: lisp-reader
+executable: lisp-reader
+files: lisp-reader-exports
+  lisp-reader

Added: trunk/libraries/registry/generic/lisp-reader
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/lisp-reader	Fri Mar 21 02:43:31 2008
@@ -0,0 +1 @@
+abstract://dylan/programming-tools/lisp-reader/lisp-reader.lid
\ No newline at end of file