164 lines
4.4 KiB
Clojure
164 lines
4.4 KiB
Clojure
(ns scm
|
|
(:require [instaparse.core :as insta]
|
|
[clojure.java.io :as io]
|
|
[clojure.core.match :refer [match]]
|
|
[clojure.string :as str]
|
|
[clojure.spec.alpha :as s])
|
|
(:import clojure.lang.ILookup)
|
|
(:refer-clojure :exclude [read]))
|
|
|
|
|
|
;;; syntax objects
|
|
|
|
(defprotocol ISyntax
|
|
(syntax-e [this])
|
|
(syntax-context [this]))
|
|
|
|
(defn syntax? [x]
|
|
(satisfies? ISyntax x))
|
|
|
|
(deftype Syntax [datum ctx]
|
|
Object
|
|
(equals [x y]
|
|
(or (identical? x y)
|
|
(and (satisfies? ISyntax y)
|
|
(.equals datum (syntax-e y))
|
|
(.equals ctx (syntax-context y)))))
|
|
ISyntax
|
|
(syntax-e [this] datum)
|
|
(syntax-context [this] ctx))
|
|
|
|
(defn unresolved? [stx]
|
|
(= (syntax-context stx) ::unresolved))
|
|
|
|
(defn resolved? [stx]
|
|
(not (unresolved? stx)))
|
|
|
|
(def ^:dynamic *print-ctx?* true)
|
|
|
|
;; does not respect `*print-dup*` lol
|
|
(defmethod print-method Syntax [this writer]
|
|
(binding [*out* writer]
|
|
(pr (tagged-literal
|
|
'scm/stx
|
|
(if (and *print-ctx?* (resolved? this))
|
|
[(syntax-e this) (syntax-context this)]
|
|
(syntax-e this))))))
|
|
|
|
(defmethod clojure.pprint/simple-dispatch Syntax [x]
|
|
(clojure.pprint/simple-dispatch
|
|
(tagged-literal
|
|
'scm/stx
|
|
(if (and *print-ctx?* (resolved? x))
|
|
[(syntax-e x) (syntax-context x)]
|
|
(syntax-e x)))))
|
|
|
|
(defn stx-reader [x]
|
|
(if-let [[datum ctx] (and (vector? x) x)]
|
|
(->Syntax datum ctx)
|
|
(->Syntax x ::unresolved)))
|
|
|
|
(defn datum->syntax
|
|
([datum]
|
|
(->Syntax datum ::unresolved))
|
|
([datum ctxt-donor]
|
|
(->Syntax datum (syntax-context ctxt-donor))))
|
|
|
|
(defn identifier?
|
|
"x가 신택스이고 x의 내용이 심볼이면 true를 생선함."
|
|
[x]
|
|
(and (syntax? x) (-> x syntax-e symbol?)))
|
|
|
|
(defn constant? [x]
|
|
(or (and (syntax? x) (-> x syntax-e constant?))
|
|
(number? x)
|
|
(string? x)
|
|
(boolean? x)))
|
|
|
|
|
|
;;; 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
|
|
"`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]
|
|
(datum->syntax x))
|
|
: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)))
|