Implement recur with fn target

main.js

@@ -171,8 +171,8 @@ function testExercisesUntilFail() {
   console.log("Fails:", fails)
 }
 
-//testSolution(randExercise())
-//testSolution("clock")
-//loadExercise("rn")
+testSolution(randExercise())
+//testSolution("poker")
+//loadExercise("all_your_base")
 //testExercisesUntilFail()
-testExercises()
+//testExercises()

src/core.js

@@ -1,7 +1,7 @@
 import { read_str } from './reader.js';
 import { _pr_str, _println } from './printer.js'
 import * as types from './types.js'
-import { repl_env, walk, evalString } from './interpreter.js';
+import { repl_env, evalString } from './interpreter.js';
 import zip from './clj/zip.clj?raw'
 
 // Errors/Exceptions
@@ -921,7 +921,7 @@ export var ns = {
     //'mod': mod,
     'rem': mod,
     'iterate': iterate,
-    'walk': walk,
+    'walk': types.walk,
 
     'sequential?': types._sequential_Q,
     'cons': cons,

src/interpreter.js

@@ -76,54 +76,6 @@ export function clearTests() {
 
 export var deftests = []
 
-export function walk(inner, outer, form) {
-    //console.log("Walking form:", form)
-    if (types._list_Q(form)) {
-        return outer(form.map(inner))
-    } else if (form === null) {
-        return null
-    }
-    else if (types._vector_Q(form)) {
-        let v = outer(form.map(inner))
-        v.__isvector__ = true;
-        return v
-    } else if (form.__mapEntry__) {
-        const k = inner(form[0])
-        const v = inner(form[1])
-        let mapEntry = [k, v]
-        mapEntry.__mapEntry__ = true
-        return outer(mapEntry)
-    } else if (types._hash_map_Q(form)) {
-        let newMap = new Map()
-        form.forEach((value, key, map) => newMap.set(key, inner(value)))
-        return outer(newMap)
-    } else {
-        return outer(form)
-    }
-}
-
-export function postwalk(f, form) {
-    return walk(x => postwalk(f, x), f, form)
-}
-
-function hasLet(ast) {
-    let lets = []
-    postwalk(x => {
-        if (x.value == types._symbol("let*")) {
-            lets.push(true)
-            return true
-        } else {
-            return x
-        }
-        return x
-    }, ast)
-    if (lets.length > 0) {
-        return true
-    } else {
-        return false
-    }
-}
-
 function _EVAL(ast, env) {
     while (true) {
         //console.log(ast)
@@ -277,6 +229,7 @@ function _EVAL(ast, env) {
                 //console.log("f:", f, PRINT(ast), env)
                 if (f.__multifn__) {
                     ast = f.__ast__(el.slice(1))
+                    ast = types.swapRecur(ast, f)
                     env = f.__gen_env__(el.slice(1));
                 } else if (f.__ast__) {
                     ast = f.__ast__;

src/types.js

@@ -205,11 +205,74 @@ export function _regex_Q(obj) {
     return obj instanceof RegExp
 }
 
+export function walk(inner, outer, form) {
+    //console.log("Walking form:", form)
+    if (_list_Q(form)) {
+        return outer(form.map(inner))
+    } else if (form === null) {
+        return null
+    }
+    else if (_vector_Q(form)) {
+        let v = outer(form.map(inner))
+        v.__isvector__ = true;
+        return v
+    } else if (form.__mapEntry__) {
+        const k = inner(form[0])
+        const v = inner(form[1])
+        let mapEntry = [k, v]
+        mapEntry.__mapEntry__ = true
+        return outer(mapEntry)
+    } else if (_hash_map_Q(form)) {
+        let newMap = new Map()
+        form.forEach((value, key, map) => newMap.set(key, inner(value)))
+        return outer(newMap)
+    } else {
+        return outer(form)
+    }
+}
+
+export function postwalk(f, form) {
+    return walk(x => postwalk(f, x), f, form)
+}
+
+function hasLoop(ast) {
+    let loops = []
+    postwalk(x => {
+        if (x.value == _symbol("loop")) {
+            loops.push(true)
+            return true
+        } else {
+            return x
+        }
+        return x
+    }, ast)
+    if (loops.length > 0) {
+        return true
+    } else {
+        return false
+    }
+}
+
+export function swapRecur(ast, f) {
+    if (!hasLoop(ast)) {
+        return postwalk(x => {
+            if (x.value == _symbol("recur")) {
+                return f
+            } else {
+                return x
+            }
+            return x
+        }, ast)
+    }
+    return ast
+}
+
 // Functions
 export function _function(Eval, Env, ast, env, params) {
     var fn = function () {
         return Eval(ast, new Env(env, params, arguments));
     };
+    ast = swapRecur(ast, fn)
     fn.__meta__ = null;
     fn.__ast__ = ast;
     fn.__gen_env__ = function (args) { return new Env(env, params, args); };

test/exercises.json

@@ -118,7 +118,7 @@
   "dominoes" : "(defn is-connected? [graph]\r\n  (cond\r\n    (< (count graph) 2) true\r\n    :else (let [start-point (first (keys graph))]\r\n            (loop [vertices []\r\n                   explored #{start-point}\r\n                   frontier [start-point]]\r\n              (if (empty? frontier)\r\n                (= (set vertices) (set (keys graph)))\r\n                (let [v (peek frontier)\r\n                      neighbors (get graph v)]\r\n                  (recur\r\n                    (concat vertices [v])\r\n                    (into explored neighbors)\r\n                    (into (pop frontier) (remove explored neighbors)))))))))\r\n\r\n(defn can-chain? [stones]\r\n  (and (is-connected? (reduce\r\n                        (fn [graph stone] (-> graph\r\n                                              (update (first stone) #(concat % [(second stone)]))\r\n                                              (update (second stone) #(concat % [(first stone)]))))\r\n                        {} stones))\r\n       (every? even? (vals (frequencies (flatten stones))))))\r\n",
   "rotational_cipher" : "(defn rotate-int [low num n]\r\n  (+ low (mod (+ n (- num low)) 26)))\r\n\r\n(defn rotate-char [n c]\r\n    (if (Character/isLetter c)\r\n      (if (Character/isLowerCase (int c))\r\n        (char (rotate-int 97 (int c) n))\r\n        (char (rotate-int 65 (int c) n)))\r\n      c))\r\n\r\n(defn rotate [s n]\r\n  (apply str (map (fn [c] (rotate-char n c)) s)))\r\n",
   "kindergarten_garden" : "(def default-students [\"Alice\" \"Bob\" \"Charlie\" \"David\" \"Eve\" \"Fred\" \"Ginny\"\r\n                       \"Harriet\" \"Ileana\" \"Joseph\" \"Kincaid\" \"Larry\"])\r\n\r\n(def seeds {\\G :grass \\C :clover \\R :radishes \\V :violets})\r\n\r\n(defn row-to-seeds [row-string]\r\n  (map seeds row-string))\r\n\r\n(defn garden-to-rows [garden]\r\n  (str/split-lines garden))\r\n\r\n(defn garden\r\n  ([string]\r\n   (garden string default-students))\r\n  ([string students]\r\n   (let [students     (map #(keyword (str/lower-case %1)) (sort students))\r\n         [front back] (map #(partition 2 %1)\r\n                           (map row-to-seeds (garden-to-rows string)))]\r\n     (->> (interleave front back)\r\n          (partition 2)\r\n          (map flatten)\r\n          (map vec)\r\n          (zipmap students)))))\r\n",
-  "all_your_base" : "(defn digits->decimal\r\n [input-base digits]\r\n  (loop [sum 0\r\n         [num & nums] digits]\r\n    (if num\r\n      (recur (+ (* sum input-base) num) nums)\r\n      sum)))\r\n\r\n(defn decimal->digits\r\n   [output-base number]\r\n  (loop [digits nil\r\n         num number]\r\n    (if (zero? num)\r\n      digits\r\n      (recur (conj digits (mod num output-base)) (quot num output-base)))))\r\n\r\n(defn convert\r\n   [input-base digits output-base]\r\n  (cond\r\n    (some #(< % 2) (list input-base output-base)) nil\r\n    (not-every? #(and (not (neg? %)) (< % input-base)) digits) nil\r\n    (empty? digits) ()\r\n    (every? #(zero? %) digits) '(0)\r\n    :else (->> digits\r\n               (digits->decimal input-base)\r\n               (decimal->digits output-base))))\r\n",
+  "all_your_base" : "(defn digits->decimal [input-base digits]\r\n  (loop [sum 0\r\n         nums digits]\r\n    (if (first nums)\r\n      (recur (+ (* sum input-base) (first nums)) (rest nums))\r\n      sum)))\r\n\r\n(defn decimal->digits\r\n   [output-base number]\r\n  (loop [digits nil\r\n         num number]\r\n    (if (zero? num)\r\n      digits\r\n      (recur (conj digits (mod num output-base)) (quot num output-base)))))\r\n\r\n#_(defn convert\r\n   [input-base digits output-base]\r\n  (cond\r\n    (some #(< % 2) (list input-base output-base)) nil\r\n    (not-every? #(and (not (neg? %)) (< % input-base)) digits) nil\r\n    (empty? digits) ()\r\n    (every? #(zero? %) digits) '(0)\r\n    :else (->> digits\r\n               (digits->decimal input-base)\r\n               (decimal->digits output-base))))\r\n",
   "spiral_matrix" : "(defn rotate [m]\r\n  (apply map (comp reverse vector) m))\r\n\r\n(defn range-n [start count]\r\n  (range start (+ start count)))\r\n\r\n(defn gen-row [start m]\r\n  (range-n start m))\r\n\r\n(defn spiral-mx\r\n  [n m start]\r\n  (cond \r\n    (= n 0) '()\r\n     (= n 1) [(gen-row start m)]\r\n       :else (cons (gen-row start m)\r\n              (rotate (spiral-mx m (dec n) (+ start m))))))\r\n  \r\n(defn spiral [n]\r\n  (spiral-mx n n 1))\r\n",
   "anagram2" : "(defn anagram? [w c]\r\n  (let [w (lower-case w)\r\n        c (lower-case c)]\r\n    (and (= (sort w) (sort c))\r\n         (not= w c))))\r\n\r\n(defn anagrams-for [w coll]\r\n  (filter (partial anagram? w) coll))\r\n",
   "atbash_cipher" : "(def letters\r\n  (map char\r\n       (range (int \"A\") (inc (int \"z\")))))\r\n\r\n(def to-cipher\r\n  (apply hash-map\r\n         (interleave letters (reverse letters))))\r\n\r\n(defn sanitize\r\n  [plaintext]\r\n  (str/replace (str/lower-case plaintext) #\"\\\\W\" \"\"))\r\n\r\n(defn cipher\r\n  [plain-char]\r\n  (or (to-cipher plain-char) plain-char))\r\n\r\n(defn to-chunks\r\n  [character-list]\r\n  (map #(apply str %) (partition 5 5 character-list)))\r\n\r\n(defn encode\r\n  [plaintext]\r\n  (->> plaintext\r\n       sanitize\r\n       (map cipher)\r\n       to-chunks\r\n       (str/join \" \")))\r\n",
@@ -160,7 +160,7 @@
   "luhn" : "(defn double [n]\r\n  (if (> n 4)\r\n    (+ n n -9)\r\n    (+ n n)))\r\n\r\n(defn sum [input]\r\n  (->> input\r\n       (re-seq #\"\\\\d\")\r\n       (map #(Integer/parseInt %))\r\n       reverse\r\n      (partition 2 2 [0])\r\n       (reduce (fn [sum a-b] (+ sum (first a-b) (double (last a-b)))) 0)))\r\n\r\n(defn valid? [input]\r\n  (boolean\r\n    (and (re-matches #\"[\\\\d\\\\s]*\" input)\r\n         (zero? (rem (sum input) 10))\r\n         (< 1 (count (re-seq #\"\\\\d\" input))))))\r\n",
   "difference_of_squares" : "(defn sum [xs] (reduce + 0 xs))\r\n\r\n(defn sum-of-squares [n]\r\n    (sum (map #(int (Math/pow % 2)) (range 0 (inc n)))))\r\n\r\n(defn square-of-sum [n]\r\n    (int (Math/pow (sum (range 0 (inc n))) 2)))\r\n\r\n(defn difference [x]\r\n    (- (square-of-sum x) (sum-of-squares x)))\r\n",
   "complex_numbers" : "(defn real [c] (first c))\r\n\r\n(defn imaginary [c] (last c))\r\n\r\n(defn abs [c] (Math/sqrt (apply + (map #(Math/pow % 2) [(first c) (last c)]))))\r\n\r\n(defn conjugate [c] [(first c) (- (last c))])\r\n\r\n(defn add [c1 c2] [(+ (first c1) (first c2)) (+ (last c1) (last c2))])\r\n\r\n(defn sub [c1 c2] [(- (first c1) (first c2)) (- (last c1) (last c2))])\r\n\r\n(defn mul [c1 c2] [(- (* (first c1) (first c2)) (* (last c1) (last c2)))\r\n             (+ (* (first c1) (last c2)) (* (last c1) (first c2)))])\r\n\r\n(defn div [c1 c2]\r\n  (when-not (== 0 c1 c2)\r\n    (let [x (+ (* (first c2) (first c2)) (* (last c2) (last c2)))]\r\n      [(double (/ (+ (* (first c1) (first c2)) (* (last c1) (last c2))) x))\r\n       (double (/ (- (* (last c1) (first c2)) (* (first c1) (last c2))) x))])))\r\n",
-  "poker" : "(def base-values\r\n  {\"2\" 2\r\n   \"3\" 3\r\n   \"4\" 4\r\n   \"5\" 5\r\n   \"6\" 6\r\n   \"7\" 7\r\n   \"8\" 8\r\n   \"9\" 9\r\n   \"10\" 10\r\n   \"J\" 11\r\n   \"Q\" 12\r\n   \"K\" 13})\r\n\r\n(def values-low-as\r\n  (into base-values\r\n        {\"A\" 1}))\r\n\r\n(def values-high-as\r\n  (into base-values\r\n        {\"A\" 14}))\r\n\r\n(defn value-freq [hand]\r\n  (->> hand\r\n       (group-by :value)\r\n       (vals)\r\n       (map count)\r\n       (sort)))\r\n\r\n(defn one-pair? [hand]\r\n  (= [1 1 1 2] (value-freq hand)))\r\n\r\n(defn two-pair? [hand]\r\n  (= [1 2 2] (value-freq hand)))\r\n\r\n(defn three-of-a-kind? [hand]\r\n  (= [1 1 3] (value-freq hand)))\r\n\r\n(defn straight? [hand]\r\n  (->> hand\r\n       (map :value)\r\n       (sort)\r\n       (partition 2 1)\r\n       (map (partial apply -))\r\n       (every? (partial = -1))))\r\n\r\n(defn flush? [hand]\r\n  (->> hand\r\n       (map :color)\r\n       (apply =)))\r\n\r\n(defn full-house? [hand]\r\n  (= [2 3] (value-freq hand)))\r\n\r\n(defn four-of-a-kind? [hand]\r\n  (= [1 4] (value-freq hand)))\r\n\r\n(defn straight-flush? [hand]\r\n  (and (flush? hand) (straight? hand)))\r\n\r\n(defn category [hand]\r\n  (condp #(%1 %2) hand\r\n    straight-flush? 8\r\n    four-of-a-kind? 7\r\n    full-house? 6\r\n    flush? 5\r\n    straight? 4\r\n    three-of-a-kind? 3\r\n    two-pair? 2\r\n    one-pair? 1\r\n    0))\r\n\r\n(defn highcards [hand]\r\n  (->> hand\r\n       (map :value)\r\n       (frequencies)\r\n       (map reverse)\r\n       (map vec)\r\n       (sort)\r\n       (reverse)\r\n       (vec)))\r\n\r\n(defn read-hand [raw-hand values]\r\n  (vec (for [[_ rank color] (re-seq #\"(\\d+|[JQKA])([CDHS])\" raw-hand)]\r\n         {:value (values rank)\r\n          :color color})))\r\n\r\n(defn score\r\n  ([raw-hand]\r\n   (last (sorted-set (score raw-hand values-high-as)\r\n                     (score raw-hand values-low-as))))\r\n  ([raw-hand values]\r\n   (-> raw-hand\r\n       (read-hand values)\r\n       ((juxt category highcards)))))\r\n\r\n(defn max-by-score [raw-hands]\r\n  (->> raw-hands\r\n       (group-by score)\r\n       (into (sorted-map))\r\n       (vals)\r\n       (last)))\r\n\r\n(defn best-hands [hands]\r\n  (max-by-score hands))\r\n",
+  "poker" : "(def base-values\r\n  {\"2\" 2\r\n   \"3\" 3\r\n   \"4\" 4\r\n   \"5\" 5\r\n   \"6\" 6\r\n   \"7\" 7\r\n   \"8\" 8\r\n   \"9\" 9\r\n   \"10\" 10\r\n   \"J\" 11\r\n   \"Q\" 12\r\n   \"K\" 13})\r\n\r\n(def values-low-as\r\n  (into base-values\r\n        {\"A\" 1}))\r\n\r\n(def values-high-as\r\n  (into base-values\r\n        {\"A\" 14}))\r\n\r\n#_(defn value-freq [hand]\r\n  (->> hand\r\n       (group-by :value)\r\n       (vals)\r\n       (map count)\r\n       (sort)))\r\n\r\n#_(defn one-pair? [hand]\r\n  (= [1 1 1 2] (value-freq hand)))\r\n\r\n#_(defn two-pair? [hand]\r\n  (= [1 2 2] (value-freq hand)))\r\n\r\n#_(defn three-of-a-kind? [hand]\r\n  (= [1 1 3] (value-freq hand)))\r\n\r\n#_(defn straight? [hand]\r\n  (->> hand\r\n       (map :value)\r\n       (sort)\r\n       (partition 2 1)\r\n       (map (partial apply -))\r\n       (every? (partial = -1))))\r\n\r\n#_(defn flush? [hand]\r\n  (->> hand\r\n       (map :color)\r\n       (apply =)))\r\n\r\n#_(defn full-house? [hand]\r\n  (= [2 3] (value-freq hand)))\r\n\r\n#_(defn four-of-a-kind? [hand]\r\n  (= [1 4] (value-freq hand)))\r\n\r\n#_(defn straight-flush? [hand]\r\n  (and (flush? hand) (straight? hand)))\r\n\r\n#_(defn category [hand]\r\n  (condp #(%1 %2) hand\r\n    straight-flush? 8\r\n    four-of-a-kind? 7\r\n    full-house? 6\r\n    flush? 5\r\n    straight? 4\r\n    three-of-a-kind? 3\r\n    two-pair? 2\r\n    one-pair? 1\r\n    0))\r\n\r\n#_(defn highcards [hand]\r\n  (->> hand\r\n       (map :value)\r\n       (frequencies)\r\n       (map reverse)\r\n       (map vec)\r\n       (sort)\r\n       (reverse)\r\n       (vec)))\r\n\r\n#_(defn read-hand [raw-hand values]\r\n  (vec (for [[_ rank color] (re-seq #\"(\\d+|[JQKA])([CDHS])\" raw-hand)]\r\n         {:value (values rank)\r\n          :color color})))\r\n\r\n#_(defn score\r\n  ([raw-hand]\r\n   (last (sorted-set (score raw-hand values-high-as)\r\n                     (score raw-hand values-low-as))))\r\n  ([raw-hand values]\r\n   (-> raw-hand\r\n       (read-hand values)\r\n       ((juxt category highcards)))))\r\n\r\n#_(defn max-by-score [raw-hands]\r\n  (->> raw-hands\r\n       (group-by score)\r\n       (into (sorted-map))\r\n       (vals)\r\n       (last)))\r\n\r\n#_(defn best-hands [hands]\r\n  (max-by-score hands))\r\n",
   "go_counting" : "(defn grid->graph [xs]\r\n  (->> (for [x (-> xs count range), y (-> xs first count range)]\r\n         (case (get-in xs [x y])\r\n           \\W     [[y x] :white]\r\n           \\B     [[y x] :black]\r\n           \" \" [[y x] :free]))\r\n       (into {})))\r\n\r\n(defn neighbors [pred stones [x y]]\r\n  (->> [[0 1] [0 -1] [1 0] [-1 0]]\r\n       (map (fn [[j k]] [(+ x j) (+ y k)]))\r\n       (filter (comp pred stones))))\r\n\r\n(defn territory-of [stones [x y]]\r\n  (if (= :free (stones [x y]))\r\n    (letfn [(f [[seen frontier]]\r\n              (let [nseen (reduce conj seen frontier)]\r\n                [nseen (->> frontier\r\n                            (mapcat #(neighbors #{:free} stones %))\r\n                            (filter (complement nseen)))]))]\r\n      (->> [#{} [[x y]]]\r\n           (iterate f)\r\n           (drop-while (comp seq second))\r\n           (ffirst)))\r\n    #{}))\r\n\r\n(defn territory-owner [stones territory]\r\n  (->> territory\r\n       (mapcat (partial neighbors  #{:black :white} stones))\r\n       (map stones)\r\n       (#(cond (empty? %)                    nil\r\n               (every? (partial = :black) %) :black\r\n               (every? (partial = :white) %) :white\r\n               :else                         nil))))\r\n\r\n(defn territory [grid [x y]]\r\n  (let [stones    (grid->graph grid)\r\n        territory (territory-of stones [x y])]\r\n    (if (nil? (stones [x y]))\r\n      (throw \"Invalid coordinate!\")\r\n      {:stones territory :owner (territory-owner stones territory)})))\r\n\r\n(defn territories [grid]\r\n  (let [territories   (->> grid grid->graph keys (map (partial territory grid)))\r\n        territory-for #(->> territories (filter (comp % :owner)) (map :stones) (reduce concat) set)]\r\n    {:black-territory (territory-for (partial = :black))\r\n     :white-territory (territory-for (partial = :white))\r\n     :null-territory  (territory-for nil?)}))\r\n",
   "accumulate" : "(defn accumulate [f xs]\r\n   (loop [xs xs\r\n         accum []]\r\n      (if (empty? xs)\r\n          accum\r\n         (recur (rest xs) (conj accum (f (first xs)))))))\r\n",
   "hexadecimal" : "(defn- char-between [start end c]  (let [ascii (int c)]\r\n    (and (>= ascii (int start)) (<= ascii (int end)))))\r\n\r\n(def is-digit (partial char-between \\0 \\9))\r\n(def is-a-to-f (partial char-between \\a \\f))\r\n\r\n(defn- is-hex-digit [c]\r\n  (or (is-digit c) (is-a-to-f c)))\r\n\r\n(defn- digit-to-int [c]\r\n  (cond\r\n    (is-digit c) (- (int c) (int \\0))\r\n    (is-a-to-f c) (+ (- (int c) (int \\a)) 10)\r\n    :else (throw \"Character is not a hex digit\")))\r\n\r\n(defn hex-to-int [digits]\r\n  (if\r\n   (some (complement is-hex-digit) digits) 0\r\n   (reduce (fn [a b] (+ (digit-to-int b) (* a 16))) 0 digits)))\r\n",