mirror of
https://github.com/kanaka/mal.git
synced 2024-08-17 01:30:26 +03:00
Add step 1
This commit is contained in:
sogaiu
parent
f625d1bca7
commit
132c5854f7
86
impls/fennel/printer.fnl
Normal file
86
impls/fennel/printer.fnl
Normal file
@ -0,0 +1,86 @@
|
||||
(local t (require :types))
|
||||
|
||||
(fn escape
|
||||
[a-str]
|
||||
(pick-values 1
|
||||
(-> a-str
|
||||
(string.gsub "\\" "\\\\")
|
||||
(string.gsub "\"" "\\\"")
|
||||
(string.gsub "\n" "\\n"))))
|
||||
|
||||
(fn code*
|
||||
[ast buf print_readably]
|
||||
(let [value (t.get-value ast)]
|
||||
(if (t.nil?* ast)
|
||||
(table.insert buf value)
|
||||
;;
|
||||
(t.boolean?* ast)
|
||||
(table.insert buf (if value "true" "false"))
|
||||
;;
|
||||
(t.number?* ast)
|
||||
(table.insert buf (tostring value))
|
||||
;;
|
||||
(t.keyword?* ast)
|
||||
(table.insert buf value)
|
||||
;;
|
||||
(t.symbol?* ast)
|
||||
(table.insert buf value)
|
||||
;;
|
||||
(t.string?* ast)
|
||||
(if print_readably
|
||||
(do
|
||||
(table.insert buf "\"")
|
||||
(table.insert buf (escape value))
|
||||
(table.insert buf "\""))
|
||||
(table.insert buf value))
|
||||
;;
|
||||
(t.list?* ast)
|
||||
(do
|
||||
(table.insert buf "(")
|
||||
(var remove false)
|
||||
(each [idx elt (ipairs value)]
|
||||
(code* elt buf print_readably)
|
||||
(table.insert buf " ")
|
||||
(set remove true))
|
||||
(when remove
|
||||
(table.remove buf))
|
||||
(table.insert buf ")"))
|
||||
;;
|
||||
(t.vector?* ast)
|
||||
(do
|
||||
(table.insert buf "[")
|
||||
(var remove false)
|
||||
(each [idx elt (ipairs value)]
|
||||
(code* elt buf print_readably)
|
||||
(table.insert buf " ")
|
||||
(set remove true))
|
||||
(when remove
|
||||
(table.remove buf))
|
||||
(table.insert buf "]"))
|
||||
;;
|
||||
(t.hash-map?* ast)
|
||||
(do
|
||||
(table.insert buf "{")
|
||||
(var remove false)
|
||||
(each [idx elt (ipairs value)]
|
||||
(code* elt buf print_readably)
|
||||
(table.insert buf " ")
|
||||
(set remove true))
|
||||
(when remove
|
||||
(table.remove buf))
|
||||
(table.insert buf "}")))
|
||||
buf))
|
||||
|
||||
(fn pr_str
|
||||
[ast print_readably]
|
||||
(let [buf []]
|
||||
(code* ast buf print_readably)
|
||||
(table.concat buf)))
|
||||
|
||||
(comment
|
||||
|
||||
(pr_str (t.make-number 1) false)
|
||||
|
||||
)
|
||||
|
||||
{:pr_str pr_str}
|
||||
200
impls/fennel/reader.fnl
Normal file
200
impls/fennel/reader.fnl
Normal file
@ -0,0 +1,200 @@
|
||||
(local t (require :types))
|
||||
(local u (require :utils))
|
||||
|
||||
(local lpeg (require :lpeg))
|
||||
|
||||
(local P lpeg.P)
|
||||
|
||||
(local S lpeg.S)
|
||||
|
||||
(local C lpeg.C)
|
||||
|
||||
(local V lpeg.V)
|
||||
|
||||
(local Cmt lpeg.Cmt)
|
||||
|
||||
(fn unescape
|
||||
[a-str]
|
||||
(pick-values 1
|
||||
(-> a-str
|
||||
(string.gsub "\\\\" "\u{029e}") ;; temporarily hide
|
||||
(string.gsub "\\\"" "\"")
|
||||
(string.gsub "\\n" "\n")
|
||||
(string.gsub "\u{029e}" "\\")))) ;; now replace
|
||||
|
||||
(local grammar
|
||||
{1 "main"
|
||||
"main" (^ (V "input") 1)
|
||||
"input" (+ (V "gap") (V "form"))
|
||||
"gap" (+ (V "ws") (V "comment"))
|
||||
"ws" (^ (S " \f\n\r\t,") 1)
|
||||
"comment" (* ";"
|
||||
(^ (- (P 1) (S "\r\n"))
|
||||
0))
|
||||
"form" (+ (V "boolean") (V "nil")
|
||||
(V "number") (V "keyword") (V "symbol") (V "string")
|
||||
(V "list") (V "vector") (V "hash-map")
|
||||
(V "deref") (V "quasiquote") (V "quote")
|
||||
(V "splice-unquote")
|
||||
(V "unquote")
|
||||
(V "with-meta"))
|
||||
"name-char" (- (P 1)
|
||||
(S " \f\n\r\t,[]{}()'`~^@\";"))
|
||||
"nil" (Cmt (C (* (P "nil")
|
||||
(- (V "name-char"))))
|
||||
(fn [s i a]
|
||||
(values i t.mal-nil)))
|
||||
"boolean" (Cmt (C (* (+ (P "false") (P "true"))
|
||||
(- (V "name-char"))))
|
||||
(fn [s i a]
|
||||
(values i (if (= a "true")
|
||||
t.mal-true
|
||||
t.mal-false))))
|
||||
"number" (Cmt (C (^ (- (P 1)
|
||||
(S " \f\n\r\t,[]{}()'`~^@\";"))
|
||||
1))
|
||||
(fn [s i a]
|
||||
(let [result (tonumber a)]
|
||||
(if result
|
||||
(values i (t.make-number result))
|
||||
nil))))
|
||||
"keyword" (Cmt (C (* ":"
|
||||
(^ (V "name-char") 0)))
|
||||
(fn [s i a]
|
||||
(values i (t.make-keyword a))))
|
||||
"symbol" (Cmt (^ (V "name-char") 1)
|
||||
(fn [s i a]
|
||||
(values i (t.make-symbol a))))
|
||||
"string" (* (P "\"")
|
||||
(Cmt (C (* (^ (- (P 1)
|
||||
(S "\"\\"))
|
||||
0)
|
||||
(^ (* (P "\\")
|
||||
(P 1)
|
||||
(^ (- (P 1)
|
||||
(S "\"\\"))
|
||||
0))
|
||||
0)))
|
||||
(fn [s i a]
|
||||
(values i (t.make-string (unescape a)))))
|
||||
(+ (P "\"")
|
||||
(P (fn [s i]
|
||||
(error "unbalanced \"")))))
|
||||
"list" (* (P "(")
|
||||
(Cmt (C (^ (V "input") 0))
|
||||
(fn [s i a ...]
|
||||
(values i (t.make-list [...]))))
|
||||
(+ (P ")")
|
||||
(P (fn [s i]
|
||||
(error "unbalanced )")))))
|
||||
"vector" (* (P "[")
|
||||
(Cmt (C (^ (V "input") 0))
|
||||
(fn [s i a ...]
|
||||
(values i (t.make-vector [...]))))
|
||||
(+ (P "]")
|
||||
(P (fn [s i]
|
||||
(error "unbalanced ]")))))
|
||||
"hash-map" (* (P "{")
|
||||
(Cmt (C (^ (V "input") 0))
|
||||
(fn [s i a ...]
|
||||
(values i (t.make-hash-map [...]))))
|
||||
(+ (P "}")
|
||||
(P (fn [s i]
|
||||
(error "unbalanced }")))))
|
||||
"deref" (Cmt (C (* (P "@")
|
||||
(V "form")))
|
||||
(fn [s i ...]
|
||||
(let [content [(t.make-symbol "deref")]]
|
||||
(table.insert content (. [...] 2))
|
||||
(values i (t.make-list content)))))
|
||||
"quasiquote" (Cmt (C (* (P "`")
|
||||
(V "form")))
|
||||
(fn [s i ...]
|
||||
(let [content [(t.make-symbol "quasiquote")]]
|
||||
(table.insert content (. [...] 2))
|
||||
(values i (t.make-list content)))))
|
||||
"quote" (Cmt (C (* (P "'")
|
||||
(V "form")))
|
||||
(fn [s i ...]
|
||||
(let [content [(t.make-symbol "quote")]]
|
||||
(table.insert content (. [...] 2))
|
||||
(values i (t.make-list content)))))
|
||||
"splice-unquote" (Cmt (C (* (P "~@")
|
||||
(V "form")))
|
||||
(fn [s i ...]
|
||||
(let [content [(t.make-symbol "splice-unquote")]]
|
||||
(table.insert content (. [...] 2))
|
||||
(values i (t.make-list content)))))
|
||||
"unquote" (Cmt (C (* (P "~")
|
||||
(V "form")))
|
||||
(fn [s i ...]
|
||||
(let [content [(t.make-symbol "unquote")]]
|
||||
(table.insert content (. [...] 2))
|
||||
(values i (t.make-list content)))))
|
||||
"with-meta" (Cmt (C (* (P "^")
|
||||
(V "form")
|
||||
(^ (V "gap") 1)
|
||||
(V "form")))
|
||||
(fn [s i ...]
|
||||
(let [content [(t.make-symbol "with-meta")]]
|
||||
(table.insert content (. [...] 3))
|
||||
(table.insert content (. [...] 2))
|
||||
(values i (t.make-list content)))))
|
||||
})
|
||||
|
||||
(comment
|
||||
|
||||
(lpeg.match grammar "; hello")
|
||||
|
||||
(lpeg.match grammar "nil")
|
||||
|
||||
(lpeg.match grammar "true")
|
||||
|
||||
(lpeg.match grammar "false")
|
||||
|
||||
(lpeg.match grammar "1.2")
|
||||
|
||||
(lpeg.match grammar "(+ 1 1)")
|
||||
|
||||
(lpeg.match grammar "[:a :b :c]")
|
||||
|
||||
(lpeg.match grammar "\"hello there\"")
|
||||
|
||||
(lpeg.match grammar "\"hello\" there\"")
|
||||
|
||||
)
|
||||
|
||||
(fn read_str
|
||||
[a-str]
|
||||
(let [(ok? result) (pcall lpeg.match grammar a-str)]
|
||||
(if ok?
|
||||
(let [res-type (type result)]
|
||||
(if (= res-type "table")
|
||||
result
|
||||
(u.throw* t.mal-nil)))
|
||||
(u.throw*
|
||||
(t.make-string result)))))
|
||||
|
||||
(comment
|
||||
|
||||
(read_str "; hello")
|
||||
|
||||
(read_str "nil")
|
||||
|
||||
(read_str "true")
|
||||
|
||||
(read_str "false")
|
||||
|
||||
(read_str "1.2")
|
||||
|
||||
(read_str "(+ 1 1)")
|
||||
|
||||
(read_str "[:a :b :c]")
|
||||
|
||||
(read_str "\"hello there\"")
|
||||
|
||||
(read_str "\"hello\" there\"")
|
||||
|
||||
)
|
||||
|
||||
{:read_str read_str}
|
||||
39
impls/fennel/step1_read_print.fnl
Normal file
39
impls/fennel/step1_read_print.fnl
Normal file
@ -0,0 +1,39 @@
|
||||
(local printer (require :printer))
|
||||
(local reader (require :reader))
|
||||
(local t (require :types))
|
||||
|
||||
(fn READ
|
||||
[code-str]
|
||||
(reader.read_str code-str))
|
||||
|
||||
(fn EVAL
|
||||
[ast]
|
||||
ast)
|
||||
|
||||
(fn PRINT
|
||||
[ast]
|
||||
(printer.pr_str ast true))
|
||||
|
||||
(fn rep
|
||||
[code-str]
|
||||
(PRINT (EVAL (READ code-str))))
|
||||
|
||||
(fn handle-error
|
||||
[err]
|
||||
(if (t.nil?* err)
|
||||
(print)
|
||||
(= "string" (type err))
|
||||
(print err)
|
||||
(print (.. "Error: " (PRINT err)))))
|
||||
|
||||
(var done false)
|
||||
|
||||
(while (not done)
|
||||
(io.write "user> ")
|
||||
(io.flush)
|
||||
(let [input (io.read)]
|
||||
(if (not input)
|
||||
(set done true)
|
||||
(xpcall (fn []
|
||||
(print (rep input)))
|
||||
handle-error))))
|
||||
122
impls/fennel/types.fnl
Normal file
122
impls/fennel/types.fnl
Normal file
@ -0,0 +1,122 @@
|
||||
(fn make-nil
|
||||
[a-str]
|
||||
{:tag :nil
|
||||
:content "nil"})
|
||||
|
||||
(fn make-boolean
|
||||
[a-bool]
|
||||
{:tag :boolean
|
||||
:content a-bool})
|
||||
|
||||
(fn make-number
|
||||
[a-num]
|
||||
{:tag :number
|
||||
:content a-num})
|
||||
|
||||
(fn make-keyword
|
||||
[a-str]
|
||||
{:tag :keyword
|
||||
:content a-str})
|
||||
|
||||
(fn make-symbol
|
||||
[a-str]
|
||||
{:tag :symbol
|
||||
:content a-str})
|
||||
|
||||
(fn make-string
|
||||
[a-str]
|
||||
{:tag :string
|
||||
:content a-str})
|
||||
|
||||
(local mal-nil (make-nil))
|
||||
|
||||
(fn make-list
|
||||
[elts]
|
||||
{:tag :list
|
||||
:content elts})
|
||||
|
||||
(fn make-vector
|
||||
[elts]
|
||||
{:tag :vector
|
||||
:content elts})
|
||||
|
||||
(fn make-hash-map
|
||||
[elts]
|
||||
{:tag :hash-map
|
||||
:content elts})
|
||||
|
||||
(local mal-true (make-boolean true))
|
||||
|
||||
(local mal-false (make-boolean false))
|
||||
|
||||
;;
|
||||
|
||||
(fn get-value
|
||||
[ast]
|
||||
(. ast :content))
|
||||
|
||||
;;
|
||||
|
||||
(fn nil?*
|
||||
[ast]
|
||||
(= :nil (. ast :tag)))
|
||||
|
||||
(fn boolean?*
|
||||
[ast]
|
||||
(= :boolean (. ast :tag)))
|
||||
|
||||
(fn number?*
|
||||
[ast]
|
||||
(= :number (. ast :tag)))
|
||||
|
||||
(fn keyword?*
|
||||
[ast]
|
||||
(= :keyword (. ast :tag)))
|
||||
|
||||
(fn symbol?*
|
||||
[ast]
|
||||
(= :symbol (. ast :tag)))
|
||||
|
||||
(fn string?*
|
||||
[ast]
|
||||
(= :string (. ast :tag)))
|
||||
|
||||
(fn list?*
|
||||
[ast]
|
||||
(= :list (. ast :tag)))
|
||||
|
||||
(fn vector?*
|
||||
[ast]
|
||||
(= :vector (. ast :tag)))
|
||||
|
||||
(fn hash-map?*
|
||||
[ast]
|
||||
(= :hash-map (. ast :tag)))
|
||||
|
||||
{
|
||||
:make-nil make-nil
|
||||
:make-boolean make-boolean
|
||||
:make-number make-number
|
||||
:make-keyword make-keyword
|
||||
:make-symbol make-symbol
|
||||
:make-string make-string
|
||||
:make-list make-list
|
||||
:make-vector make-vector
|
||||
:make-hash-map make-hash-map
|
||||
;;
|
||||
:mal-nil mal-nil
|
||||
:mal-true mal-true
|
||||
:mal-false mal-false
|
||||
;;
|
||||
:nil?* nil?*
|
||||
:boolean?* boolean?*
|
||||
:number?* number?*
|
||||
:keyword?* keyword?*
|
||||
:symbol?* symbol?*
|
||||
:string?* string?*
|
||||
:list?* list?*
|
||||
:vector?* vector?*
|
||||
:hash-map?* hash-map?*
|
||||
;;
|
||||
:get-value get-value
|
||||
}
|
||||
7
impls/fennel/utils.fnl
Normal file
7
impls/fennel/utils.fnl
Normal file
@ -0,0 +1,7 @@
|
||||
(fn throw*
|
||||
[ast]
|
||||
(error ast))
|
||||
|
||||
{
|
||||
:throw* throw*
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user