From 73da0bdbd9f6c917765a677fc1bcf8e6d791f556 Mon Sep 17 00:00:00 2001
From: sogaiu <983021772@users.noreply.github.com>
Date: Tue, 24 Nov 2020 22:19:47 +0900
Subject: [PATCH] Add step 2

---
 impls/fennel/step2_eval.fnl | 89 ++++++++++++++++++++++++++++++++++
 impls/fennel/types.fnl      | 12 ++++-
 impls/fennel/utils.fnl      | 95 +++++++++++++++++++++++++++++++++++++
 3 files changed, 195 insertions(+), 1 deletion(-)
 create mode 100644 impls/fennel/step2_eval.fnl

diff --git a/impls/fennel/step2_eval.fnl b/impls/fennel/step2_eval.fnl
new file mode 100644
index 00000000..93d536ea
--- /dev/null
+++ b/impls/fennel/step2_eval.fnl
@@ -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))))
+
diff --git a/impls/fennel/types.fnl b/impls/fennel/types.fnl
index fe00334f..e854e0f2 100644
--- a/impls/fennel/types.fnl
+++ b/impls/fennel/types.fnl
@@ -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?*
 }
diff --git a/impls/fennel/utils.fnl b/impls/fennel/utils.fnl
index 6155c803..db7cc509 100644
--- a/impls/fennel/utils.fnl
+++ b/impls/fennel/utils.fnl
@@ -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
 }