Commits

Moritz Heidkamp committed d29ae54

implement a clojure writer

Comments (0)

Files changed (2)

 (let loop ()
   (printf "~A=> ~!" (clojure-namespace-name (current-namespace)))
   (condition-case
-      (pp (clojure-eval (clojure-read)))
+      (clojure-write (clojure-eval (clojure-read))) 
     ((user-interrupt) (exit 1))
     (exn (sexpressive)
          (print-error-message exn)
          (read-char))                   ; just in case
     (exn () (print-error-message exn)))
+  (newline)
   (loop))
 (module clojure
 
-(clojure-read clojure-eval
+(clojure-read clojure-eval clojure-write
               
  clojure-namespace-name clojure-namespace-ref current-namespace
 
 
 (import chicken scheme)
 (use sexpressive sexpressive-clojure srfi-69
-     matchable data-structures environments extras)
+     matchable data-structures environments extras
+     ports srfi-13 srfi-1)
 
 (define-record clojure-namespace
   name module)
          ,name)))
     (else (error 'compile-def "invalid def syntax" (cons 'def def)))))
 
+(define-record-printer (hash-table h out)
+  (let ((s (string-trim-both
+            (with-output-to-string
+                (lambda ()
+                  (pp (append-map
+                       (lambda (kv) (list (car kv) (cdr kv)))
+                       (hash-table->alist h))))))))
+    (fprintf out "{~A}"
+             (substring s 1 (- (string-length s) 1)))))
+
 ;; compiles a Clojure form as returned by clojure-read to Scheme
 (define (compile form)
   (match form
     ((? eof-object?) (exit))
     ((? string?) form)
     (('quote expr) form)
+    ((? boolean?) form)
     ((? number?) form)
-    ((? clojure-symbol? sym)
-     (let ((var (clojure-symbol->symbol sym)))
-       (if (clojure-symbol-namespace sym)
-           (let ((mod (clojure-symbol-namespace->module-name sym)))
-             ;; TODO: replace static namespace list with dynamic one
-             (if (memq mod '(scheme chicken))
-                 var
-                 `(scheme/begin
-                   (scheme/require-library ,mod)
-                   (scheme/import (prefix ,mod ,(string->symbol (sprintf "~A/" mod))))
-                   ,var)))
-           var)))
-    ;; (('use (? clojure-symbol? namespaces ...))
-    ;;  (for-each namespace-import namespaces))
-    (((? clojure-symbol? sym) rest ...)
-     ;; TODO: handle namespaced symbols
-     (match (cons (clojure-symbol->symbol sym) rest)
-       (('def def ...) (compile-def def))
-       (('ns (? clojure-symbol? name))
-        (let ((ns (clojure-symbol->namespace-name name)))
-          (current-namespace
-           (clojure-namespace-ref ns))
-          `'(namespace ,ns)))
-       (else
-        (map compile form))))
-    (else (error 'compile "unknown form" form))))
+    ((? hash-table?)
+     (compile (list (make-clojure-symbol '(srfi-69) 'alist->hash-table)
+                    `',(hash-table->alist form))))
+    ((? clojure-keyword?)
+     (compile `(,(make-clojure-symbol '(clojure) 'make-clojure-keyword)
+                (,(make-clojure-symbol '(clojure) 'make-clojure-symbol)
+                 . ,(let ((sym (clojure-keyword-name form)))
+                      `(',(clojure-symbol-namespace sym)
+                        ',(clojure-symbol-name sym))))
+                ,(clojure-keyword-namespaced? form))))
+     ((? clojure-symbol? sym)
+      (let ((var (clojure-symbol->symbol sym)))
+        (if (clojure-symbol-namespace sym)
+            (let ((mod (clojure-symbol-namespace->module-name sym)))
+              ;; TODO: replace static namespace list with dynamic one
+              (if (memq mod '(scheme chicken))
+                  var
+                  `(scheme/begin
+                    (scheme/require-library ,mod)
+                    (scheme/import (prefix ,mod ,(string->symbol (sprintf "~A/" mod))))
+                    ,var)))
+            var)))
+     ;; (('use (? clojure-symbol? namespaces ...))
+     ;;  (for-each namespace-import namespaces))
+     (((? clojure-keyword? key) map)
+      (compile (list (make-clojure-symbol '(srfi-69) 'hash-table-ref) map key)))
+     (((? clojure-symbol? sym) rest ...)
+      ;; TODO: handle namespaced symbols
+      (match (cons (clojure-symbol->symbol sym) rest)
+        (('def def ...) (compile-def def))
+        (('ns (? clojure-symbol? name))
+         (let ((ns (clojure-symbol->namespace-name name)))
+           (current-namespace
+            (clojure-namespace-ref ns))
+           `'(namespace ,ns)))
+        (else
+         (map compile form))))
+     (else (error 'compile "unknown form" form))))
 
 (define (compile-file port)
   (let ((form (read port)))
 (define (clojure-eval expr)
   (with-current-namespace
    (lambda ()
-     (eval (compile expr)))))
+     (let ((res (eval (compile expr))))
+       (if (eq? (void) res)
+           'nil
+           res)))))
+
+(define (clojure-write exp)
+  (cond ((clojure-symbol? exp)
+         (write (clojure-symbol->symbol exp)))
+        ((clojure-keyword? exp)
+         (write (clojure-keyword->symbol exp)))
+        (else
+         (write exp))))
 
 )
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.