Parse Typed Jerboa (import ...) clause

ober

dcea99929829e546920f2921e1bd1500f0b7d965

diff --git a/lib/jerboa/typed/parser.ss b/lib/jerboa/typed/parser.ss
index d766777..3f7b079 100644
--- a/lib/jerboa/typed/parser.ss
+++ b/lib/jerboa/typed/parser.ss
@@ -18,8 +18,8 @@
     expr-length expr-map expr->list
 
     typed-module? make-typed-module
-    typed-module-name typed-module-exports typed-module-declarations
-    typed-module-source
+    typed-module-name typed-module-exports typed-module-imports
+    typed-module-declarations typed-module-source
 
     typed-type-decl? make-typed-type-decl
     typed-type-decl-name typed-type-decl-source
@@ -52,7 +52,7 @@
           (only (jerboa core) def defstruct)
           (jerboa reader))
 
-  (defstruct typed-module (name exports declarations source))
+  (defstruct typed-module (name exports imports declarations source))
   (defstruct typed-type-decl (name source))
   (defstruct typed-field (name type mutable? source))
   (defstruct typed-record (name fields source))
@@ -175,6 +175,26 @@
           exports))
       exports))
 
+  (def (parse-import-form form)
+    (expect-proper-list 'parse-typed-library form)
+    (unless (and (pair? form) (eq? (car form) 'import))
+      (error 'parse-typed-library
+        "expected (import (module name) ...)"
+        form))
+    (map
+      (lambda (entry)
+        (let ([entry (strip-source-annotations entry)])
+          (unless (and (pair? entry) (symbol-list? entry))
+            (error 'parse-typed-library
+              "import entry must be a non-empty list of symbols"
+              entry))
+          entry))
+      (cdr form)))
+
+  (def (import-form? form)
+    (let ([form (strip-source-annotations form)])
+      (and (pair? form) (eq? (car form) 'import))))
+
   (def (typed-library-form? form)
     (let ([form (strip-source-annotations form)])
       (and (pair? form)
@@ -191,10 +211,18 @@
         (error 'parse-typed-library
           "expected (typed-library name (export ...) declarations ...)"
           form))
-      (let ([name (parse-module-name (cadr form))]
-            [exports (parse-export-form (caddr form))]
-            [declarations (map parse-typed-declaration (cdddr raw-form))])
-        (make-typed-module name exports declarations source))))
+      (let* ([name (parse-module-name (cadr form))]
+             [exports (parse-export-form (caddr form))]
+             [raw-tail (cdddr raw-form)]
+             [stripped-tail (cdddr form)]
+             [has-import? (and (pair? stripped-tail)
+                               (import-form? (car raw-tail)))]
+             [imports (if has-import?
+                        (parse-import-form (car stripped-tail))
+                        '())]
+             [decl-raw (if has-import? (cdr raw-tail) raw-tail)]
+             [declarations (map parse-typed-declaration decl-raw)])
+        (make-typed-module name exports imports declarations source))))
 
   (def (parse-typed-type type)
     (let ([type (strip-source-annotations type)])
diff --git a/tests/test-typed-parser.ss b/tests/test-typed-parser.ss
index b7daf00..8768684 100644
--- a/tests/test-typed-parser.ss
+++ b/tests/test-typed-parser.ss
@@ -139,6 +139,10 @@
   (typed-module-exports parsed)
   '(make-leaf split? split-size apply-op))
 
+(test "module imports default empty"
+  (typed-module-imports parsed)
+  '())
+
 (test "declaration count"
   (length declarations)
   5)
@@ -248,6 +252,42 @@
     '(def (f) : Nat
        #:effects (io))))
 
+(define import-form
+  '(typed-library (consumer)
+     (export call-it)
+     (import (provider one) (provider two))
+     (def (call-it (x : Nat)) : Nat x)))
+
+(test "typed-library accepts (import ...) clause"
+  (typed-module-imports (parse-typed-library import-form))
+  '((provider one) (provider two)))
+
+(test "import declarations stay in declarations list"
+  (length (typed-module-declarations (parse-typed-library import-form)))
+  1)
+
+(test "module without (import ...) still parses"
+  (typed-module-imports
+    (parse-typed-library
+      '(typed-library (no-import)
+         (export f)
+         (def (f (x : Nat)) : Nat x))))
+  '())
+
+(test-error "rejects import entry that is not a list"
+  (parse-typed-library
+    '(typed-library (bad)
+       (export f)
+       (import provider)
+       (def (f (x : Nat)) : Nat x))))
+
+(test-error "rejects empty import entry"
+  (parse-typed-library
+    '(typed-library (bad)
+       (export f)
+       (import ())
+       (def (f (x : Nat)) : Nat x))))
+
 (printf "~%Typed parser: ~a passed, ~a failed~%" pass fail)
 (when (> fail 0)
   (exit 1))