src/r7rs.ebnf

@@ -26,7 +26,8 @@ symbol = ordinary-symbol <intertoken-space>
 (* number *)
 number = num-10 <intertoken-space>
 
-num-10 = sign #"[0-9]+"
+num-10 = sign uinteger-10
+<uinteger-10> = #"[0-9]+"
 
 sign = ('+' | '-')?
 exactness = ('#i' | '#e')?
@@ -42,4 +43,11 @@ intraline-whitespace = #"[ \t\f]"
 line-ending = #"[\r\n]|\r\n"
 comment = <semicolon> #"[^\n\r]*"
 intertoken-space = atmosphere*
-directive = #"#!(no-)?fold-case"
+directive = #"#!(no-)?fold-case"
+
+(* library *)
+library-start = <intertoken-space> library
+library = <left-paren> <"define-library">
+          <intertoken-space> library-name <right-paren>
+library-name = <left-paren> library-name-part+ <intertoken-space> <right-paren>
+<library-name-part> = symbol | uinteger-10

src/scm.clj

@@ -121,20 +121,29 @@
 (defn read
   "`read` 작업의 결과로 생성된 콘텍스트 필드는 초기에 비어 있다. 이후
   `expand/expand` 작업을 통해 콘택스트 필드를 패울 수 있다."
-  [text & {:keys [syntax? instaparse]
+  [text & {:keys [syntax? instaparse library? throw?]
            :or {syntax? false
+                library? false
+                throw? false
                 instaparse {}}}]
   (let [r (insta/parse r7rs-parser text
-                       :start :datum-start
+                       :start (if library? :library-start :datum-start)
                        instaparse)]
     (if (insta/failure? r)
-      r
+      (if throw?
+        (throw (ex-info "reader error" {:err r}))
+        r)
       (insta/transform
        {:boolean (fn [x]
                    (match x
                      (:or "#t" "#true") true
                      (:or "#f" "#false") false))
         :datum-start identity
+        :library-start identity
+        :library-name list
+        :library (fn [lib-name & decls]
+                   #:library {:name lib-name
+                              :declarations decls})
         ;; 그라머에 datum을 감추지 않은 고러서 대신 여기 모든 datum을
         ;; 과정할 수 있었더다. 작업 한 개만으로 syntax object들 다
         ;; 만들 수 있어서 이럼은 더 좋다.

test/expand_test.clj

@@ -15,3 +15,19 @@
            (sut/nearest
             '#{a b c} '[#{d} #{d e} #{f}]))
         "undefined"))
+
+(t/deftest lookup-test
+  (t/is (= [:primitive 'lambda]
+           (sut/lookup #scm/stx [lambda #{}]
+                       {[:global 'lambda] [:primitive 'lambda]}
+                       {['lambda #{}] [:global 'lambda]})))
+  (t/is (= [:primitive 'lambda]
+           (sut/lookup #scm/stx [lambda #{a b c}]
+                       {[:global 'lambda] [:primitive 'lambda]}
+                       {['lambda #{}] [:global 'lambda]})))
+  (t/is (= [:var]
+           (sut/lookup #scm/stx [x #{a b c}]
+                       '{[:lexical x A] [:var]
+                         [:lexical x B] [:primitive lambda]}
+                       '{[x #{a b}] [:lexical x A]
+                         [x #{a}] [:lexical x B]}))))

test/scm_test.clj

@@ -12,8 +12,20 @@
     (t/is (= 'abc (sut/read "abc")))
     (t/is (= 'truth-nuke (sut/read "truth-nuke"))))
   (t/testing "list"
+    (t/is (= (list) (sut/read "()")))
     (t/is (= (list 1 2 3) (sut/read "(1 2 3)")))
-    (t/is (= (sut/improper-list 1 2 3) (sut/read "(1 2 . 3)")))))
+    (t/is (= (sut/improper-list 1 2 3) (sut/read "(1 2 . 3)"))))
+  (t/testing "number"
+    (t/is (= 123 (sut/read "123")))
+    (t/is (= 123 (sut/read "+123")))
+    (t/is (= -123 (sut/read "-123"))))
+  (t/testing "library"
+    (t/are [s] (thrown?
+                Exception
+                (sut/read s :throw? true
+                          :library? true))
+      "" "()"
+      "(define-library ())")))
 
 (t/deftest read-syntax-test
   (t/is (sut/unresolved? (sut/read-syntax "123")))