105 lines
3.3 KiB
Plaintext
105 lines
3.3 KiB
Plaintext
|
(defn ->kw [kw-str]
|
||
|
|
(keyword (slice kw-str 1)))
|
||
|
|
|
||
|
|
(defn word [str] [:word str])
|
||
|
|
|
||
|
|
(defn num [num] [:number (scan-number num)])
|
||
|
|
|
||
|
|
(defn kw [_ kw] [:keyword (->kw kw)])
|
||
|
|
|
||
|
|
(defn str [str] [:string str])
|
||
|
|
|
||
|
|
(defn bool [bool] (if (= bool "true") [:boolean true] [:boolean false]))
|
||
|
|
|
||
|
|
(defn nill [_] [:nil nil])
|
||
|
|
|
||
|
|
(defn not-empty? [x] (not (empty? x)))
|
||
|
|
|
||
|
|
(defn ifl [args] [:if ;args])
|
||
|
|
|
||
|
|
(defn letl [args] [:let ;args])
|
||
|
|
|
||
|
|
(defn block [args] [:block args])
|
||
|
|
|
||
|
|
(def errors @[])
|
||
|
|
|
||
|
|
(defn ? [x default] (if (nil? x) default x))
|
||
|
|
|
||
|
|
(defn panic [& args]
|
||
|
|
(def info (filter |(not= "" $) args))
|
||
|
|
(def [msg line col source] info)
|
||
|
|
(def error {:msg msg :line line :col col :source (? source "")})
|
||
|
|
(array/push errors error)
|
||
|
|
[:error error]
|
||
|
|
)
|
||
|
|
|
||
|
|
(do
|
||
|
|
(def ludus-grammar
|
||
|
|
~{:nil (cmt (<- "nil") ,nill)
|
||
|
|
:true (cmt (<- "true") ,bool)
|
||
|
|
:false (cmt (<- "false") ,bool)
|
||
|
|
:comment (* "&" (any (if-not (+ "\n" -1) 1)))
|
||
|
|
:wordchars (+ :w (set "_-/*?!"))
|
||
|
|
:reserved (+ "if" "then" "else" "let")
|
||
|
|
:word (cmt (<- (if-not :reserved (* (range "az") (any :wordchars)))) ,word)
|
||
|
|
:keyword (cmt (<- (* ":" :word)) ,kw)
|
||
|
|
:hex (range "09" "af" "AF")
|
||
|
|
:escape (* "\\" (+ (set `"'0?\abefnrtvz`)
|
||
|
|
(* "x" :hex :hex)
|
||
|
|
(* "u" [4 :hex])
|
||
|
|
(* "U" [6 :hex])
|
||
|
|
(error (constant "bad escape"))))
|
||
|
|
:string (cmt (* "\"" (<- (any (+ :escape (if-not "\"" 1)))) "\"") ,str)
|
||
|
|
:int (* (? "-") (range "19") (any (+ "_" (range "09"))))
|
||
|
|
:float (* (? "-") (+ :int "0") "." (any (+ "_" (range "09"))))
|
||
|
|
:zero "0"
|
||
|
|
:number (cmt (<- (+ :float :int :zero)) ,num)
|
||
|
|
:comment (* "&" (any (if-not (+ "\n" -1) 1)))
|
||
|
|
:atom (+ :nil :true :false :keyword :number :word)
|
||
|
|
:newline "\n"
|
||
|
|
:terminator (* (any :ws) (some (+ :newline ";")))
|
||
|
|
:separator (* (any :ws) (some (+ :newline ",")))
|
||
|
|
:ws (any (+ :comment (set " \t")))
|
||
|
|
:simple (+ :atom :string :word (* (constant "expected simple" :err-msg) :panic))
|
||
|
|
:then (+ (* (+ (some :ws) (any :newline)) (any :ws) "then" (some :ws)) (* (constant "expected then" :err-msg) :panic))
|
||
|
|
:else (+ (* (+ (some :ws) (any :newline)) (any :ws) "else" (some :ws)) (* (constant "expected else" :err-msg) :panic))
|
||
|
|
:panic (cmt (* (<- (-> :err-msg)) (<- (line)) (<- (column)) (<- (* (any (if-not (+ "\n" -1) 1))))) ,panic)
|
||
|
|
:non-binding (+ :atom :word :string :if :block
|
||
|
|
(* (constant "expected non-binding" :err-msg) :panic))
|
||
|
|
:tuple-term (* :number (some :separator))
|
||
|
|
:tuple (* "(" (any :separator) (any :tuple-term) ")")
|
||
|
|
:block (cmt (group (* "{" (some :line) (? :expression) "}")) ,block)
|
||
|
|
:if (cmt (group (* "if" (some :ws) :simple :then :non-binding :else :non-binding)) ,ifl)
|
||
|
|
:pattern (+ :atom :string (* (constant "expected pattern") :panic))
|
||
|
|
:equals (* (any :ws) "=" (any :ws))
|
||
|
|
:let (cmt (group (* "let" (some :ws) :pattern :equals :non-binding)) ,letl)
|
||
|
|
:expression (+ :atom :string :block :if :let
|
||
|
|
(* (constant "expected expression" :err-msg) :panic))
|
||
|
|
:empty (* :ws :terminator)
|
||
|
|
:line (* :ws :expression :ws :terminator)
|
||
|
|
:main :tuple})
|
||
|
|
|
||
|
|
(def simple-tuple ~{
|
||
|
|
:value (<- (range "az"))
|
||
|
|
:separator (+ "," "\n")
|
||
|
|
:ws (any (set " \t"))
|
||
|
|
:term (* :ws :value :ws :separator)
|
||
|
|
:tuple (group (* "(" (any :term) (? :value) :ws ")"))
|
||
|
|
:main :tuple
|
||
|
|
})
|
||
|
|
|
||
|
|
|
||
|
|
# :empty/:line/:block are still giving me grief
|
||
|
|
# also, somehow line & column numbers ar
|
||
|
|
(def source
|
||
|
|
``
|
||
|
|
( a, b ,c,d )
|
||
|
|
``
|
||
|
|
)
|
||
|
|
|
||
|
|
|
||
|
|
(peg/match simple-tuple source)
|
||
|
|
)
|
||
|
|
|
||
|
|
|