sketching out what the repl needs to do.

2013-02-26 15:22:33 -07:00 · 2013-02-26 15:22:33 -07:00 · 2d99cea537
commit 2d99cea537
parent 808087612d
3 changed files with 132 additions and 0 deletions
--- a/whalesong/repl-prototype/htdocs/index.html
+++ b/whalesong/repl-prototype/htdocs/index.html
@ -0,0 +1,10 @@
+<!DOCTYPE html>
+<html>
+<head>
+<script src="collects/runtime.js"></script>
+<script src="collects/whalesong-lang.js"></script>
+</head>
+<body>
+<h1>Repl experiment</h1>
+</body>
+</html>
--- a/whalesong/repl-prototype/server.rkt
+++ b/whalesong/repl-prototype/server.rkt
@ -0,0 +1,57 @@
+#lang racket/base
+
+
+
+(require json
+         file/gzip
+         racket/runtime-path
+         racket/port
+         web-server/servlet-env
+         web-server/servlet
+         "write-runtime.rkt"
+         (for-syntax racket/base))
+
+(define-runtime-path htdocs (build-path "htdocs"))
+
+;; make-port-response: (values response/incremental output-port)
+;; Creates a response that's coupled to an output-port: whatever you
+;; write into the output will be pushed into the response.
+(define (make-port-response #:mime-type (mime-type #"application/octet-stream")
+                            #:with-gzip? (with-gzip? #f))
+  (define headers (if with-gzip?
+                      (list (header #"Content-Encoding" #"gzip"))
+                      (list)))
+  (define-values (in out) (make-pipe))
+  (values (response
+             200 #"OK"
+             (current-seconds)
+             mime-type
+             headers
+             (lambda (op)
+               (cond
+                [with-gzip?
+                 (gzip-through-ports in op #f (current-seconds))]
+                [else
+                 (copy-port in op)])))
+            out))
+
+
+
+(define (start req)
+  (define-values (response op) 
+    (make-port-response #:mime-type #"text/json"))
+  (define source (extract-binding/single 'src (request-bindings req)))
+  ;; Compile the program here...
+  ;; Send it back as json text....
+  (write-json '(1 2 3) op)
+  (close-output-port op)
+  response)
+  
+
+
+(write-repl-runtime-files)
+(serve/servlet start 
+               #:servlet-path "/compile"
+               #:extra-files-paths (list htdocs)
+               #:launch-browser? #f
+               #:port 8080)
--- a/whalesong/repl-prototype/write-runtime.rkt
+++ b/whalesong/repl-prototype/write-runtime.rkt
@ -0,0 +1,65 @@
+#lang racket
+
+
+(require racket/path
+         racket/runtime-path
+         "../make/make-structs.rkt"
+         "../js-assembler/package.rkt"
+         "../parameters.rkt"
+         (for-syntax racket/base))
+
+(provide write-repl-runtime-files)
+
+(define-runtime-path collects-path (build-path "htdocs" "collects"))
+(define-runtime-path whalesong-lang (build-path "../lang/whalesong.rkt"))
+
+
+
+;; write-repl-runtime-files: -> void
+;; Write out the support library necessary to run Whalesong programs.
+;; Includes the basic runtime as well as the language.
+(define (write-repl-runtime-files)
+
+  (unless (directory-exists? collects-path)
+    (make-directory collects-path))
+  
+  
+  (define written-js-paths '())
+  (define module-mappings (make-hash))
+  
+  
+  
+  (define make-output-js-filename
+    (lambda (module-name)
+      (define result
+        (build-path collects-path
+                    (string-append
+                     (regexp-replace #rx"[.](rkt|ss)$" (symbol->string module-name) "")
+                     ".js")))
+      (set! written-js-paths (cons result written-js-paths))
+      (fprintf (current-report-port)
+               (format "Writing program ~s\n" result))
+      
+      (when module-name
+        (hash-set! module-mappings module-name result))
+      result))
+  
+  
+  (call-with-output-file* (make-output-js-filename 'runtime)
+                          (lambda (op)
+                            (display (get-runtime) op))
+                          #:exists 'replace)
+  
+  (call-with-output-file* (make-output-js-filename 'whalesong-lang)
+                          (lambda (op)
+                            (display (get-inert-code (make-ModuleSource 
+                                                      (normalize-path whalesong-lang))
+                                                     make-output-js-filename)
+                                     op))
+                          #:exists 'replace)
+  
+  
+  ;(for/hash ([(key path) module-mappings])
+  ;  (values key (path->string (file-name-from-path path))))
+  
+  )