Honu:

- added top.ss, containing mzscheme-accessible compilation commands.
- line-wrapped tool.ss to max width 100.

svn: r896

collects/honu/tool.ss

@@ -86,13 +86,16 @@
                 (if (eof-object? (peek-char-or-special port))
                     eof
                     (let* ([parsed (level-parser port name)])
-                      (let-values ([(cruft-for-stx compiled-defns) (compile/defns tenv lenv parsed)])
+                      (let-values
+                          ([(cruft-for-stx compiled-defns) (compile/defns tenv lenv parsed)])
                         ;; if we wrap this in something special for the syntax-case below, then
                         ;; Check Syntax breaks (unsurprisingly), so we'll just do special
                         ;; wrappers for the interaction stuff.
-                        (datum->syntax-object #f (list 'begin cruft-for-stx 
-                                                       (datum->syntax-object #f (cons 'begin compiled-defns) #f))
-                                              #f)))))))
+                        (datum->syntax-object
+                         #f
+                         (list 'begin cruft-for-stx 
+                               (datum->syntax-object #f (cons 'begin compiled-defns) #f))
+                         #f)))))))
           (define/public (front-end/interaction port settings teachpack-cache)
             (let ([name (object-name port)])
               (lambda ()
@@ -161,8 +164,8 @@
           
           (super-instantiate ())))
       
-      ;; The following copies the Java mode to make one for Honu, but it's better right now than using
-      ;; the Scheme mode.  Ugh.
+      ;; The following copies the Java mode to make one for Honu, but it's better right now than
+      ;; using the Scheme mode.  Ugh.
       
       ;; matches-language : (union #f (listof string)) -> boolean
       (define (matches-language l)
@@ -218,7 +221,8 @@
                               (fold (lambda (v s)
                                       ;; if there are no objects, then we'll just print out
                                       ;; the list on the same line.
-                                      (string-append s ", " (format-honu-value v settings (+ indent 1))))
+                                      (string-append s ", "
+                                                     (format-honu-value v settings (+ indent 1))))
                                     (format-honu-value (car value) settings (+ indent 1))
                                     (cdr value))
                               ")"))]

collects/honu/top.ss

@@ -0,0 +1,78 @@
+(module top mzscheme
+
+  (require (lib "contract.ss")
+           (prefix honu: "parsers/parse.ss")
+           (prefix honu: "parsers/post-parsing.ss")
+           (prefix honu: "private/typechecker/typechecker.ss")
+           (prefix honu: "private/compiler/translate.ss")
+           (prefix honu: "tenv.ss")
+           (prefix honu: "tenv-utils.ss")
+           (prefix honu: "parameters.ss")
+           (prefix honu: "honu-context.ss")
+           "ast.ss"
+           )
+
+  (require-for-template (lib "contract.ss"))
+  
+  (define-syntax (define/provide stx)
+    (syntax-case stx ()
+        [(_ (NAME ARG ...) BODY ...)
+         #`(begin
+             (define (NAME ARG ...) BODY ...)
+             (provide NAME))]
+        [(_ NAME BODY ...)
+         #`(begin
+             (define NAME BODY ...)
+             (provide NAME))]
+        ))
+  
+  (define-syntax (def/pro/con stx)
+    (syntax-case stx ()
+        [(_ (NAME ARG ...) CONTRACT BODY ...)
+         #`(begin
+             (define (NAME ARG ...) BODY ...)
+             (provide/contract [NAME CONTRACT]))]
+        [(_ NAME CONTRACT BODY ...)
+         #`(begin
+             (define NAME BODY ...)
+             (provide/contract [NAME CONTRACT]))]
+        ))
+
+  (define type-syntax/c any/c)
+
+  (def/pro/con current-top-tenv parameter? (make-parameter (honu:empty-tenv)))
+  (def/pro/con current-top-lenv parameter? (make-parameter (honu:get-builtin-lenv)))
+
+  (def/pro/con (reset-env) (-> void?)
+    (current-top-tenv (honu:empty-tenv))
+    (current-top-lenv (honu:get-builtin-lenv)))
+  
+  (define-syntax (with-env stx)
+    (syntax-case stx ()
+      [(_ BODY ...)
+       #`(parameterize ([honu:current-type-environment (current-top-tenv)]
+                        [honu:current-lexical-environment (current-top-lenv)])
+           BODY ...)]))
+  
+  (def/pro/con (parse-file file) (path-string? . -> . (listof honu:defn?))
+    (with-env
+     (honu:post-parse-program
+      (honu:add-defns-to-tenv
+       (honu:parse-port (open-input-file file) file)))))
+
+  (def/pro/con (check-defns program) ((listof honu:defn?) . -> . (listof honu:defn?))
+    (with-env (honu:typecheck program)))
+
+  (def/pro/con (translate-defns program)
+    ((listof honu:defn?) . -> . (syntax/c any/c))
+    (with-env
+     (parameterize ([honu:current-compile-context honu:honu-compile-context])
+       (let-values
+           ([(annotations syntax) (honu:translate program)])
+         (namespace-syntax-introduce (datum->syntax-object #f (cons 'begin syntax) #f))))))
+
+  (def/pro/con (run-program file) (path-string? . -> . void?)
+    (reset-env)
+    (eval-syntax (translate-defns (check-defns (parse-file file)))))
+  
+  )