mirror of
https://github.com/kanaka/mal.git
synced 2024-08-16 17:20:23 +03:00
Add step 2
This commit is contained in:
parent
132c5854f7
commit
73da0bdbd9
89
impls/fennel/step2_eval.fnl
Normal file
89
impls/fennel/step2_eval.fnl
Normal file
@ -0,0 +1,89 @@
|
||||
(local printer (require :printer))
|
||||
(local reader (require :reader))
|
||||
(local t (require :types))
|
||||
(local u (require :utils))
|
||||
|
||||
(local repl_env
|
||||
{"+" (fn [ast-1 ast-2]
|
||||
(t.make-number (+ (t.get-value ast-1)
|
||||
(t.get-value ast-2))))
|
||||
"-" (fn [ast-1 ast-2]
|
||||
(t.make-number (- (t.get-value ast-1)
|
||||
(t.get-value ast-2))))
|
||||
"*" (fn [ast-1 ast-2]
|
||||
(t.make-number (* (t.get-value ast-1)
|
||||
(t.get-value ast-2))))
|
||||
"/" (fn [ast-1 ast-2]
|
||||
(t.make-number (/ (t.get-value ast-1)
|
||||
(t.get-value ast-2))))})
|
||||
|
||||
(fn READ
|
||||
[code-str]
|
||||
(reader.read_str code-str))
|
||||
|
||||
;; forward declaration
|
||||
(var EVAL 1)
|
||||
|
||||
(fn eval_ast
|
||||
[ast env]
|
||||
(if (t.symbol?* ast)
|
||||
(. env (t.get-value ast))
|
||||
;;
|
||||
(t.list?* ast)
|
||||
(t.make-list (u.map (fn [elt-ast]
|
||||
(EVAL elt-ast env))
|
||||
(t.get-value ast)))
|
||||
;;
|
||||
(t.vector?* ast)
|
||||
(t.make-vector (u.map (fn [elt-ast]
|
||||
(EVAL elt-ast env))
|
||||
(t.get-value ast)))
|
||||
;;
|
||||
(t.hash-map?* ast)
|
||||
(t.make-hash-map (u.map (fn [elt-ast]
|
||||
(EVAL elt-ast env))
|
||||
(t.get-value ast)))
|
||||
;;
|
||||
ast))
|
||||
|
||||
(set EVAL
|
||||
(fn [ast env]
|
||||
(if (not (t.list?* ast))
|
||||
(eval_ast ast env)
|
||||
;;
|
||||
(t.empty?* ast)
|
||||
ast
|
||||
;;
|
||||
(let [eval-list (eval_ast ast env)
|
||||
f (u.first (t.get-value eval-list))
|
||||
args (u.slice (t.get-value eval-list) 2 -1)]
|
||||
(f (table.unpack args))))))
|
||||
|
||||
(fn PRINT
|
||||
[ast]
|
||||
(printer.pr_str ast true))
|
||||
|
||||
(fn rep
|
||||
[code-str]
|
||||
(PRINT (EVAL (READ code-str) repl_env)))
|
||||
|
||||
(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))))
|
||||
|
@ -93,6 +93,14 @@
|
||||
[ast]
|
||||
(= :hash-map (. ast :tag)))
|
||||
|
||||
;;
|
||||
|
||||
(fn empty?*
|
||||
[ast]
|
||||
(when (or (list?* ast)
|
||||
(vector?* ast))
|
||||
(= (length (get-value ast)) 0)))
|
||||
|
||||
{
|
||||
:make-nil make-nil
|
||||
:make-boolean make-boolean
|
||||
@ -108,6 +116,8 @@
|
||||
:mal-true mal-true
|
||||
:mal-false mal-false
|
||||
;;
|
||||
:get-value get-value
|
||||
;;
|
||||
:nil?* nil?*
|
||||
:boolean?* boolean?*
|
||||
:number?* number?*
|
||||
@ -118,5 +128,5 @@
|
||||
:vector?* vector?*
|
||||
:hash-map?* hash-map?*
|
||||
;;
|
||||
:get-value get-value
|
||||
:empty?* empty?*
|
||||
}
|
||||
|
@ -2,6 +2,101 @@
|
||||
[ast]
|
||||
(error ast))
|
||||
|
||||
(fn abs-index
|
||||
[i len]
|
||||
(if (> i 0)
|
||||
i
|
||||
(< i 0)
|
||||
(+ len i 1)
|
||||
nil))
|
||||
|
||||
(comment
|
||||
|
||||
(abs-index 0 9)
|
||||
;; => nil
|
||||
|
||||
(abs-index 1 9)
|
||||
;; => 1
|
||||
|
||||
(abs-index -1 9)
|
||||
;; => 9
|
||||
|
||||
(abs-index -2 9)
|
||||
;; => 8
|
||||
|
||||
)
|
||||
|
||||
(fn slice
|
||||
[tbl beg end]
|
||||
(local len-tbl (length tbl))
|
||||
(local new-beg
|
||||
(if beg (abs-index beg len-tbl) 1))
|
||||
(local new-end
|
||||
(if end (abs-index end len-tbl) len-tbl))
|
||||
(local start
|
||||
(if (< new-beg 1) 1 new-beg))
|
||||
(local fin
|
||||
(if (< len-tbl new-end) len-tbl new-end))
|
||||
(local new-tbl [])
|
||||
(for [idx start fin]
|
||||
(tset new-tbl
|
||||
(+ (length new-tbl) 1)
|
||||
(. tbl idx)))
|
||||
new-tbl)
|
||||
|
||||
(comment
|
||||
|
||||
(slice [7 8 9] 2 -1)
|
||||
;; => [8 9]
|
||||
|
||||
(slice [1 2 3] 1 2)
|
||||
;; => [1 2]
|
||||
|
||||
)
|
||||
|
||||
(fn first
|
||||
[tbl]
|
||||
(. tbl 1))
|
||||
|
||||
(comment
|
||||
|
||||
(first [7 8 9])
|
||||
;; => 7
|
||||
|
||||
)
|
||||
|
||||
(fn last
|
||||
[tbl]
|
||||
(. tbl (length tbl)))
|
||||
|
||||
(comment
|
||||
|
||||
(last [7 8 9])
|
||||
;; => 9
|
||||
|
||||
)
|
||||
|
||||
(fn map
|
||||
[a-fn tbl]
|
||||
(local new-tbl [])
|
||||
(each [i elt (ipairs tbl)]
|
||||
(tset new-tbl i (a-fn elt)))
|
||||
new-tbl)
|
||||
|
||||
(comment
|
||||
|
||||
(map (fn [x] (+ x 1)) [7 8 9])
|
||||
;; => [8 9 10]
|
||||
|
||||
(map (fn [n] [n (+ n 1)]) [1 2 3])
|
||||
;; => [[1 2] [2 3] [3 4]]
|
||||
|
||||
)
|
||||
|
||||
{
|
||||
:throw* throw*
|
||||
:slice slice
|
||||
:first first
|
||||
:last last
|
||||
:map map
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user