diff --git a/src/r7rs.ebnf b/src/r7rs.ebnf index fd47ea7..706aea0 100644 --- a/src/r7rs.ebnf +++ b/src/r7rs.ebnf @@ -8,18 +8,20 @@ right-paren = ')' dot = '.' (* datum *) - = simple-datum | compound-datum +datum-start = datum + +datum = simple-datum | compound-datum = boolean | symbol | number | string = any-list (* list *) - = proper-list | improper-list -proper-list = datum* + = list | improper-list +list = datum* improper-list = datum+ datum (* symbol *) symbol = ordinary-symbol - = #"[\P{Lu}\P{Ll}\P{Lt}\P{Lm}\P{Lo}\P{Nl}\P{No}\P{Pd}\P{Pc}\P{Sc}\P{Po}\P{Sm}\P{Sk}\P{So}\P{Co}\u200c\u200d&&[^;|\".,#]][\P{Lu}\P{Ll}\P{Lt}\P{Lm}\P{Lo}\P{Nl}\P{No}\P{Pd}\P{Pc}\P{Sc}\P{Po}\P{Sm}\P{Sk}\P{So}\P{Co}\u200c\u200d\P{Nd}\P{Me}\P{Mc}.&&[^;|\",#]]*" + = #"[\p{Lu}\p{Ll}\p{Lt}\p{Lm}\p{Lo}\p{Nl}\p{No}\p{Pd}\p{Pc}\p{Sc}\p{Po}\p{Sm}\p{Sk}\p{So}\p{Co}\u200c\u200d&&[^;|\".,#]][\p{Lu}\p{Ll}\p{Lt}\p{Lm}\p{Lo}\p{Nl}\p{No}\p{Pd}\p{Pc}\p{Sc}\p{Po}\p{Sm}\p{Sk}\p{So}\p{Co}\u200c\u200d\p{Nd}\p{Me}\p{Mc}.&&[^;|\",#]]*" (* number *) number = num-10 diff --git a/src/scm.clj b/src/scm.clj index 9fad3bd..2bf1249 100644 --- a/src/scm.clj +++ b/src/scm.clj @@ -2,34 +2,36 @@ (:require [instaparse.core :as insta] [clojure.java.io :as io] [clojure.core.match :refer [match]] - [clojure.string :as str]) + [clojure.string :as str] + [clojure.spec.alpha :as s]) + (:import clojure.lang.ILookup) (:refer-clojure :exclude [read])) ;;; syntax objects -(defprotocol IStx +(defprotocol ISyntax (stx-datum [this]) (stx-context [this])) (defn syntax? [x] - (instance? IStx x)) + (instance? ISyntax x)) -(deftype Stx [datum ctx] +(deftype Syntax [datum ctx] Object (equals [x y] (or (identical? x y) - (and (instance? IStx y) + (and (instance? ISyntax y) (.equals datum (stx-datum y)) (.equals ctx (stx-context y))))) - IStx + ISyntax (stx-datum [this] datum) (stx-context [this] ctx)) (def ^:dynamic *print-ctx?* true) ;; does not respect `*print-dup*` lol -(defmethod print-method Stx [this writer] +(defmethod print-method Syntax [this writer] (binding [*out* writer] (pr (tagged-literal 'scm/stx @@ -37,7 +39,7 @@ [(stx-datum this) (stx-context this)] (stx-datum this)))))) -(defmethod clojure.pprint/simple-dispatch Stx [x] +(defmethod clojure.pprint/simple-dispatch Syntax [x] (clojure.pprint/simple-dispatch (tagged-literal 'scm/stx @@ -46,32 +48,97 @@ (stx-datum x))))) (defn stx-reader [[datum ctx]] - (->Stx datum ctx)) + (->Syntax datum ctx)) + +(defn datum->syntax + ([datum] + (->Syntax datum nil)) + ([datum ctxt-donor] + (->Syntax datum (stx-context ctxt-donor)))) + + +;;; improper list + +(deftype ImproperList [initial dot] + Object + (equals [x y] + (or (identical? x y) + (and (instance? ImproperList y) + (.equals initial (:initial y)) + (.equals dot (:dot y))))) + clojure.lang.ILookup + (valAt [this k] + (.valAt this k nil)) + (valAt [this k not-found] + (case k + :initial initial + :dot dot + not-found))) + +(defn improper-list? [x] + (instance? ImproperList x)) + +(defn improper-list [& xs] + (assert (<= 2 (count xs)) + "improper list에는 최소 두 개 이상의 요소가 있어야 합니다") + (->ImproperList (butlast xs) (last xs))) + +;; does not respect `*print-dup*` lol +(defmethod print-method ImproperList [this writer] + (print-method (concat (:initial this) + (list '. (:dot this))) + writer)) + +(defmethod clojure.pprint/simple-dispatch ImproperList [this] + (clojure.pprint/simple-dispatch + (concat (:initial this) + (list '. (:dot this))))) ;;; r⁷rs reader (insta/defparser r7rs-parser (io/resource "r7rs.ebnf")) -(defn read [s & {:as opts}] - (->> (insta/parse r7rs-parser s opts) - (insta/transform - {:boolean (fn [x] - [:boolean - (match x - (:or "#t" "#true") true - (:or "#f" "#false") false)]) - :string (fn [& els] - (apply str - (for [e els] - (match e - "\\\\" "\\" - "\\\"" "\"" - "\\n" "\n" - _ e)))) - :sign (fn - ([] identity) - ([x] (match x "-" - "+" identity))) - :num-10 (fn [sign digits] - (sign (parse-long digits)))}))) +(defn read + "`read` 작업의 결과로 생성된 콘텍스트 필드는 초기에 비어 있다. 이후 + `expand/expand` 작업을 통해 콘택스트 필드를 패울 수 있다." + [& {:keys [syntax? instaparse] + :or {syntax? false + instaparse {}}}] + (let [r (insta/parse r7rs-parser (slurp *in*) + :start :datum-start + instaparse)] + (if (insta/failure? r) + r + (insta/transform + {:boolean (fn [x] + (match x + (:or "#t" "#true") true + (:or "#f" "#false") false)) + :datum-start identity + ;; 그라머에 datum을 감추지 않은 고러서 대신 여기 모든 datum을 + ;; 과정할 수 있었더다. 작업 한 개만으로 syntax object들 다 + ;; 만들 수 있어서 이럼은 더 좋다. + :datum (fn [x] + (->Syntax x ::no-scopes)) + :number identity + :symbol symbol + :string (fn [& els] + (apply str + (for [e els] + (match (into [] e) + [\\ \\] \\ + [\\ \"] \\ + [\\ \n] \newline + [c] c)))) + :list list + :improper-list improper-list + :sign (fn + ([] identity) + ([x] (match x "-" - "+" identity))) + :num-10 (fn [sign digits] + (sign (parse-long digits)))} + r)))) +(defn read-syntax [& {:as opts}] + (read (merge {:syntax? true} opts)))