Permalink
Browse files

function literal without closure

  • Loading branch information...
1 parent f28e7f5 commit a50de0f344951e2e36a60131458d8533ea75241a @ujihisa committed Jan 2, 2013
Showing with 26 additions and 10 deletions.
  1. +26 −10 runtime.clj
View
@@ -33,25 +33,35 @@
[value]
(.toString value))
+(declare run-)
+
(defn evaluate [expr env]
"assumption: env won't change"
(if (list? expr)
(let [[car & cdr] expr]
(case car
+ function (let [params (first cdr)
+ body (second cdr)]
+ {:type :function :params params :body body})
fcall (let [func (evaluate (first cdr) env)
- args (map #(evaluate % env) (second cdr))]
- (case func
- console.log (println (js-string (first args)))
- + (if (every? number? args)
- (+ (first args) (second args))
- (str (js-string (first args)) (js-string (second args))))
- (prn 'must-not-happen 'missing-function func)))
- quote (get env (first cdr))
+ args (map #(evaluate % env) (second cdr))]
+ (case func
+ console.log (println (js-string (first args)))
+ + (if (every? number? args)
+ (+ (first args) (second args))
+ (str (js-string (first args)) (js-string (second args))))
+ (if (= (:type func) :function)
+ (let [applied-params (into {} (map (fn [x y] [x y])
+ (:params func)
+ args))]
+ (run- (:body func) (merge env applied-params)))
+ (prn 'must-not-happen 'missing-function func))))
+ quote (get env (first cdr) 'missing-local-var)
expr))
expr))
-(defn run [stmts]
- (loop [[stmt & stmts] stmts env {'console.log 'console.log '+ '+ 'null 'null 'undefined 'undefined 'NaN 'NaN}]
+(defn- run- [stmts env]
+ (loop [[stmt & stmts] stmts env env]
(when stmt
(let [[car & cdr] stmt]
(case car
@@ -63,5 +73,11 @@
(evaluate stmt env)
(recur stmts env)))))))
+(defn run [stmts]
+ (run- stmts {'console.log 'console.log '+ '+ 'null 'null 'undefined 'undefined 'NaN 'NaN}))
+
(run '[(var x 1)
(fcall 'console.log [(fcall '+ ['x "hello"])])])
+(run '[(fcall (function [x]
+ [(fcall 'console.log ['x])])
+ [2])])

0 comments on commit a50de0f

Please sign in to comment.