5 files changed, 46 insertions(+), 18 deletions(-)

M changelog.md
M src/fennel/parser.fnl
M src/fennel/repl.fnl
M src/fennel/view.fnl
M test/repl.fnl

@@ 13,11 13,15 @@ deprecated forms.
 * Fix an edge case where `{:__metatable true}` (as in pandoc-lua) breaks fennel.view
 * Fix a 1.3.0 bug where `macros` only accepts table literals, not table-returning exprs
 * Fix a bug where metadata tables with different arglists break lambdas
+* Fix a bug with detecting cycles for tables that have custom
+  `__pairs` metamethod in fennel.view
 
 ### New Features
 
 * `fennel.runtime-version` will return version information as a table
   if given optional argument
+* Expose REPL's methods in the `___repl___` table, allowing method
+  redefinition at runtime.
 
 ## 1.3.0 / 2023-02-13
 

@@ 7,7 7,7 @@
 
 (fn granulate [getchunk]
   "Convert a stream of chunks to a stream of bytes.
-Also returns a second function to clear the buffer in the byte stream"
+Also returns a second function to clear the buffer in the byte stream."
   (var (c index done?) (values "" 1 false))
   (values (fn [parser-state]
             (when (not done?)

@@ 348,18 348,20 @@ For more information about the language, see https://fennel-lang.org/reference")
                       (try-readline! opts (pcall require :readline)))
         _ (when ?fennelrc (?fennelrc))
         env (specials.wrap-env (or opts.env (rawget _G :_ENV) _G))
+        callbacks {:readChunk (or opts.readChunk default-read-chunk)
+                   :onValues (or opts.onValues default-on-values)
+                   :onError (or opts.onError default-on-error)
+                   :pp (or opts.pp view)
+                   :env env}
         save-locals? (not= opts.saveLocals false)
-        read-chunk (or opts.readChunk default-read-chunk)
-        on-values (or opts.onValues default-on-values)
-        on-error (or opts.onError default-on-error)
-        pp (or opts.pp view)
-        (byte-stream clear-stream) (parser.granulate read-chunk)
+        (byte-stream clear-stream) (parser.granulate #(callbacks.readChunk $))
         chars []
         (read reset) (parser.parser (fn [parser-state]
                                       (let [b (byte-stream parser-state)]
                                         (when b
                                           (table.insert chars (string.char b)))
                                         b)))]
+    (set env.___repl___ callbacks)
     (set (opts.env opts.scope) (values env (compiler.make-scope)))
     ;; use metadata unless we've specifically disabled it
     (set opts.useMetadata (not= opts.useMetadata false))


@@ 375,12 377,13 @@ For more information about the language, see https://fennel-lang.org/reference")
 
     (fn print-values [...]
       (let [vals [...]
-            out []]
+            out []
+            pp callbacks.pp]
         (set (env._ env.__) (values (. vals 1) vals))
         ;; utils.map won't work here because of sparse tables
         (for [i 1 (select "#" ...)]
           (table.insert out (pp (. vals i))))
-        (on-values out)))
+        (callbacks.onValues out)))
 
     (fn loop []
       (each [k (pairs chars)]


@@ 393,27 396,27 @@ For more information about the language, see https://fennel-lang.org/reference")
             not-eof? (and readline-not-eof? parser-not-eof?)]
         (if (not ok)
             (do
-              (on-error :Parse not-eof?)
+              (callbacks.onError :Parse not-eof?)
               (clear-stream)
               (loop))
             (command? src-string)
-            (run-command-loop src-string read loop env on-values on-error
+            (run-command-loop src-string read loop env callbacks.onValues callbacks.onError
                               opts.scope chars)
             (when not-eof?
               (match (pcall compiler.compile x (doto opts
                                                  (tset :source src-string)))
                 (false msg) (do
                               (clear-stream)
-                              (on-error :Compile msg))
+                              (callbacks.onError :Compile msg))
                 (true src) (let [src (if save-locals?
                                          (splice-save-locals env src opts.scope)
                                          src)]
                              (match (pcall specials.load-code src env)
                                (false msg) (do
                                              (clear-stream)
-                                             (on-error "Lua Compile" msg src))
+                                             (callbacks.onError "Lua Compile" msg src))
                                (_ chunk) (xpcall #(print-values (chunk))
-                                                 (partial on-error :Runtime)))))
+                                                 (partial callbacks.onError :Runtime)))))
               (set utils.root.options old-root-options)
               (loop)))))
 

@@ 141,13 141,15 @@
       (set seen.len id))
     seen))
 
-(fn detect-cycle [t seen ?k]
+(fn detect-cycle [t seen]
   "Return `true` if table `t` appears in itself."
   (when (= :table (type t))
     (tset seen t true)
-    (match (next t ?k)
-      (k v) (or (. seen k) (detect-cycle k seen) (. seen v)
-                (detect-cycle v seen) (detect-cycle t seen k)))))
+    (accumulate [res nil
+                 k v (pairs t)
+                 :until res]
+      (or (. seen k) (detect-cycle k seen)
+          (. seen v) (detect-cycle v seen)))))
 
 (fn visible-cycle? [t options]
   ;; Detect cycle, save table's ID in seen tables, and determine if

@@ 315,6 315,24 @@
         [back] (send (table.concat long))]
     (l.assertEquals 8000 (length back))))
 
+(fn test-decorating-repl []
+  ;; overriding REPL methods from within the REPL via decoration.
+  (let [send (wrap-repl)]
+    (let [_ (send "(let [readChunk ___repl___.readChunk]
+                     (fn ___repl___.readChunk [parser-state]
+                       (string.format \"(- %s)\" (readChunk parser-state))))")
+          [res] (send "(+ 1 2 3)")]
+      (l.assertEquals res "-6" "expected the result to be negated by the new readChunk"))
+    (let [_ (send "(let [onValues ___repl___.onValues]
+                     (fn ___repl___.onValues [vals]
+                       (onValues (icollect [_ v (ipairs vals)]
+                          (.. \"res: \" v)))))")
+          [res] (send "(+ 1 2 3 4)")]
+      (l.assertEquals res "res: -10" "expected result to include \"res: \" preffix"))
+    (let [_ (send "(fn ___repl___.onError [errtype err lua-source] nil)")
+          [res] (send "(error :foo)")]
+      (l.assertEquals res nil "expected error to be ignored"))))
+
 ;; Skip REPL tests in non-JIT Lua 5.1 only to avoid engine coroutine
 ;; limitation. Normally we want all tests to run on all versions, but in
 ;; this case the feature will work fine; we just can't use this method of


@@ 338,5 356,6 @@
      : test-docstrings
      : test-no-undocumented
      : test-custom-metadata
-     : test-long-string}
+     : test-long-string
+     : test-decorating-repl}
     {})