From a4e068d09b79e7a608fc1d478578c30ca30bca08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Tue, 22 Sep 2026 08:02:54 -0600 Subject: [PATCH] --- src/r7rs.ebnf | 12 ++++++++++-- src/scm.clj | 15 ++++++++++++--- test/expand_test.clj | 16 ++++++++++++++++ test/scm_test.clj | 14 +++++++++++++- 4 files changed, 51 insertions(+), 6 deletions(-) diff --git a/src/r7rs.ebnf b/src/r7rs.ebnf index 706aea0..c100772 100644 --- a/src/r7rs.ebnf +++ b/src/r7rs.ebnf @@ -26,7 +26,8 @@ symbol = ordinary-symbol (* number *) number = num-10 -num-10 = sign #"[0-9]+" +num-10 = sign uinteger-10 + = #"[0-9]+" sign = ('+' | '-')? exactness = ('#i' | '#e')? @@ -42,4 +43,11 @@ intraline-whitespace = #"[ \t\f]" line-ending = #"[\r\n]|\r\n" comment = #"[^\n\r]*" intertoken-space = atmosphere* -directive = #"#!(no-)?fold-case" \ No newline at end of file +directive = #"#!(no-)?fold-case" + +(* library *) +library-start = library +library = <"define-library"> + library-name +library-name = library-name-part+ + = symbol | uinteger-10 diff --git a/src/scm.clj b/src/scm.clj index c66ea2c..4d69096 100644 --- a/src/scm.clj +++ b/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들 다 ;; 만들 수 있어서 이럼은 더 좋다. diff --git a/test/expand_test.clj b/test/expand_test.clj index 426c895..781eccf 100644 --- a/test/expand_test.clj +++ b/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]})))) diff --git a/test/scm_test.clj b/test/scm_test.clj index ea05bf8..178d690 100644 --- a/test/scm_test.clj +++ 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")))