diff --git a/collects/honu/ast.ss b/collects/honu/ast.ss index ee572d5421..96037904fc 100644 --- a/collects/honu/ast.ss +++ b/collects/honu/ast.ss @@ -5,8 +5,16 @@ (define-syntax (define-honu-struct stx) (syntax-case stx () [(_ (id sup) (field ...)) - (with-syntax [(new-id (datum->syntax-object #'id (string->symbol (string-append "honu:" (symbol->string (syntax-e #'id)))) #'id #'id)) - (new-sup (datum->syntax-object #'sup (string->symbol (string-append "honu:" (symbol->string (syntax-e #'sup)))) #'sup #'sup))] + (with-syntax [(new-id + (datum->syntax-object + #'id + (string->symbol + (string-append "honu:" (symbol->string (syntax-e #'id)))) #'id #'id)) + (new-sup + (datum->syntax-object + #'sup + (string->symbol + (string-append "honu:" (symbol->string (syntax-e #'sup)))) #'sup #'sup))] #'(define-struct (new-id new-sup) (field ...) #f))] [(_ id (field ...)) (with-syntax [(new-id (datum->syntax-object #'id (string->symbol (string-append "honu:" (symbol->string (syntax-e #'id)))) #'id #'id))] diff --git a/collects/honu/compile.ss b/collects/honu/compile.ss index a41d2c529f..db4572c070 100644 --- a/collects/honu/compile.ss +++ b/collects/honu/compile.ss @@ -53,7 +53,9 @@ (parameterize ([current-compile-context honu-compile-context]) (values (translate-defn checked) #f)))] [else - (let-values ([(checked type) (typecheck-expression (wrap-lenv) (make-top-type #f) ast)]) + (let-values ([(checked type) + (typecheck-expression + (wrap-lenv) (make-top-type #f) ast)]) (parameterize ([current-compile-context honu-compile-context]) (values (translate-expression checked) type)))]))) ) diff --git a/collects/honu/parsers/parse.ss b/collects/honu/parsers/parse.ss index 129ee61de3..e5efb3d9bd 100644 --- a/collects/honu/parsers/parse.ss +++ b/collects/honu/parsers/parse.ss @@ -7,40 +7,6 @@ "../utils.ss" "../private/typechecker/type-utils.ss") - (define (make-struct-type-decls inits mfidefns) - (define (convert-to-decl d) - (cond - [(honu:formal? d) - (make-honu:field-decl (honu:ast-stx d) - (honu:formal-name d) - (honu:formal-type d))] - [(honu:init-field? d) - (make-honu:field-decl (honu:ast-stx d) - (honu:init-field-name d) - (honu:init-field-type d))] - [(honu:field? d) - (make-honu:field-decl (honu:ast-stx d) - (honu:field-name d) - (honu:field-type d))] - [(honu:method? d) - (make-honu:method-decl (honu:ast-stx d) - (honu:method-name d) - (honu:method-type d) - (map honu:formal-type (honu:method-formals d)))])) - (map convert-to-decl (append inits mfidefns))) - - (define (make-struct-exports typ inits members) - (define (grab-name d) - (cond - [(honu:formal? d) (honu:formal-name d)] - [(honu:init-field? d) (honu:init-field-name d)] - [(honu:field? d) (honu:field-name d)] - [(honu:method? d) (honu:method-name d)])) - (let ([binds (map (lambda (m) - (let ([name (grab-name m)]) - (make-honu:exp-bind name name))) (append inits members))]) - (list (make-honu:export #f typ binds)))) - (define (generate-honu-parser source-name) (define honu-parser (parser diff --git a/collects/honu/tenv.ss b/collects/honu/tenv.ss index f01760e9aa..daf5283cbc 100644 --- a/collects/honu/tenv.ss +++ b/collects/honu/tenv.ss @@ -22,7 +22,8 @@ (define-struct tenv:member (stx name type) #f) - ;; members will be a hashtable from member names to types -- if I ever get around to it + ;; members will be a hashtable from member names to types + ;; -- if I ever get around to it (define-struct (tenv:type tenv:entry) (supers members inherited) #f) (define-struct (tenv:class tenv:entry) (sub-type impls inits final? super) #f) (define-struct (tenv:mixin tenv:entry) (arg-type sub-type impls inits diff --git a/collects/honu/test.ss b/collects/honu/test.ss index 6870f64a4f..b648a9203a 100644 --- a/collects/honu/test.ss +++ b/collects/honu/test.ss @@ -25,7 +25,11 @@ ([exn:fail? (lambda (exn) `(error ,(exn-message exn)))]) (let* ([honu-path (if (path? file) file (string->path file))] [test-path (path-replace-suffix honu-path "-test.ss")]) + (unless (file-exists? honu-path) + (error 'test-file "~s not found" (path->string honu-path))) (top:run-program honu-path) + (unless (file-exists? test-path) + (error 'test-file "~s not found" (path->string test-path))) (load test-path)))) (define/c (run-tests) (-> (listof any/c))