Update Fennel keywords to catch up to version 0.6.0.

Remove support for single-quoted strings.

Update fennelview example to latest version of library.

2 files changed, 104 insertions, 54 deletions

diff --git a/pygments/lexers/lisp.py b/pygments/lexers/lisp.py
index cd36aedd..1ecbf9d5 100644
--- a/pygments/lexers/lisp.py
+++ b/pygments/lexers/lisp.py
@@ -2634,14 +2634,18 @@ class FennelLexer(RegexLexer):
 
     # these two lists are taken from fennel-mode.el:
     # https://gitlab.com/technomancy/fennel-mode
-    # this list is current as of Fennel version 0.1.0.
+    # this list is current as of Fennel version 0.6.0.
     special_forms = (
-        u'require-macros', u'eval-compiler',
-        u'do', u'values', u'if', u'when', u'each', u'for', u'fn', u'lambda',
-        u'λ', u'set', u'global', u'var', u'local', u'let', u'tset', u'doto',
-        u'set-forcibly!', u'defn', u'partial', u'while', u'or', u'and', u'true',
-        u'false', u'nil', u'.', u'+', u'..', u'^', u'-', u'*', u'%', u'/', u'>',
-        u'<', u'>=', u'<=', u'=', u'~=', u'#', u'...', u':', u'->', u'->>',
+        u'require-macros', u'eval-compiler', u'doc', u'lua', u'hashfn',
+        u'macro', u'macros', u'import-macros', u'pick-args', u'pick-values',
+        u'macroexpand', u'macrodebug', u'do', u'values', u'if', u'when',
+        u'each', u'for', u'fn', u'lambda', u'λ', u'partial', u'while',
+        u'set', u'global', u'var', u'local', u'let', u'tset', u'set-forcibly!',
+        u'doto', u'match', u'or', u'and', u'true', u'false', u'nil', u'not',
+        u'not=', u'.', u'+', u'..', u'^', u'-', u'*', u'%', u'/', u'>',
+        u'<', u'>=', u'<=', u'=', u'...', u':', u'->', u'->>', u'-?>',
+        u'-?>>', u'rshift', u'lshift', u'bor', u'band', u'bnot', u'bxor',
+        u'with-open', u'length'
     )
 
     # Might be nicer to use the list from _lua_builtins.py but it's unclear how?
@@ -2655,8 +2659,9 @@ class FennelLexer(RegexLexer):
         u'tostring', u'type', u'unpack', u'xpcall'
     )
 
-    # based on the scheme definition, but disallowing leading digits and commas
-    valid_name = r'[a-zA-Z_!$%&*+/:<=>?@^~|-][\w!$%&*+/:<=>?@^~|\.-]*'
+    # based on the scheme definition, but disallowing leading digits and
+    # commas, and @ is not allowed.
+    valid_name = r'[a-zA-Z_!$%&*+/:<=>?^~|-][\w!$%&*+/:<=>?^~|\.-]*'
 
     tokens = {
         'root': [
@@ -2668,7 +2673,6 @@ class FennelLexer(RegexLexer):
             (r'-?\d+', Number.Integer),
 
             (r'"(\\\\|\\"|[^"])*"', String),
-            (r"'(\\\\|\\'|[^'])*'", String),
 
             # these are technically strings, but it's worth visually
             # distinguishing them because their intent is different
diff --git a/tests/examplefiles/fennelview.fnl b/tests/examplefiles/fennelview.fnl
index fd0fc648..19d9c167 100644
--- a/tests/examplefiles/fennelview.fnl
+++ b/tests/examplefiles/fennelview.fnl
@@ -1,13 +1,13 @@
 ;; A pretty-printer that outputs tables in Fennel syntax.
 ;; Loosely based on inspect.lua: http://github.com/kikito/inspect.lua
 
-(local quote (fn [str] (.. '"' (: str :gsub '"' '\\"') '"')))
+(fn view-quote [str] (.. "\"" (: str :gsub "\"" "\\\"") "\""))
 
 (local short-control-char-escapes
        {"\a" "\\a" "\b" "\\b" "\f" "\\f" "\n" "\\n"
         "\r" "\\r" "\t" "\\t" "\v" "\\v"})
 
-(local long-control-char-esapes
+(local long-control-char-escapes
        (let [long {}]
          (for [i 0 31]
            (let [ch (string.char i)]
@@ -17,9 +17,10 @@
          long))
 
 (fn escape [str]
-  (let [str (: str :gsub "\\" "\\\\")
-        str (: str :gsub "(%c)%f[0-9]" long-control-char-esapes)]
-    (: str :gsub "%c" short-control-char-escapes)))
+  (-> str
+      (: :gsub "\\" "\\\\")
+      (: :gsub "(%c)%f[0-9]" long-control-char-escapes)
+      (: :gsub "%c" short-control-char-escapes)))
 
 (fn sequence-key? [k len]
   (and (= (type k) "number")
@@ -32,7 +33,7 @@
 
 (fn sort-keys [a b]
   (let [ta (type a) tb (type b)]
-    (if (and (= ta tb) (~= ta "boolean")
+    (if (and (= ta tb)
              (or (= ta "string") (= ta "number")))
         (< a b)
         (let [dta (. type-order a)
@@ -58,13 +59,12 @@
     (values keys sequence-length)))
 
 (fn count-table-appearances [t appearances]
-  (if (= (type t) "table")
-      (when (not (. appearances t))
-        (tset appearances t 1)
-        (each [k v (pairs t)]
-          (count-table-appearances k appearances)
-          (count-table-appearances v appearances)))
-      (when (and t (= t t)) ; no nans please
+  (when (= (type t) "table")
+    (if (not (. appearances t))
+        (do (tset appearances t 1)
+            (each [k v (pairs t)]
+              (count-table-appearances k appearances)
+              (count-table-appearances v appearances)))
         (tset appearances t (+ (or (. appearances t) 0) 1))))
   appearances)
 
@@ -78,7 +78,7 @@
 
 (fn tabify [self] (puts self "\n" (: self.indent :rep self.level)))
 
-(fn already-visited? [self v] (~= (. self.ids v) nil))
+(fn already-visited? [self v] (not= (. self.ids v) nil))
 
 (fn get-id [self v]
   (var id (. self.ids v))
@@ -89,54 +89,70 @@
       (tset self.ids v id)))
   (tostring id))
 
-(fn put-sequential-table [self t length]
+(fn put-sequential-table [self t len]
   (puts self "[")
   (set self.level (+ self.level 1))
-  (for [i 1 length]
-    (puts self " ")
+  (for [i 1 len]
+    (when (< 1 i (+ 1 len))
+      (puts self " "))
     (put-value self (. t i)))
   (set self.level (- self.level 1))
-  (puts self " ]"))
+  (puts self "]"))
 
 (fn put-key [self k]
   (if (and (= (type k) "string")
-           (: k :find "^[-%w?\\^_`!#$%&*+./@~:|<=>]+$"))
+           (: k :find "^[-%w?\\^_!$%&*+./@:|<=>]+$"))
       (puts self ":" k)
       (put-value self k)))
 
-(fn put-kv-table [self t]
+(fn put-kv-table [self t ordered-keys]
   (puts self "{")
   (set self.level (+ self.level 1))
-  (each [k v (pairs t)]
-    (tabify self)
+  ;; first, output sorted nonsequential keys
+  (each [i k (ipairs ordered-keys)]
+    (when (or self.table-edges (not= i 1))
+      (tabify self))
     (put-key self k)
     (puts self " ")
+    (put-value self (. t k)))
+  ;; next, output any sequential keys
+  (each [i v (ipairs t)]
+    (tabify self)
+    (put-key self i)
+    (puts self " ")
     (put-value self v))
   (set self.level (- self.level 1))
-  (tabify self)
+  (when self.table-edges
+    (tabify self))
   (puts self "}"))
 
 (fn put-table [self t]
-  (if (already-visited? self t)
-      (puts self "#<table " (get-id self t) ">")
-      (>= self.level self.depth)
-      (puts self "{...}")
-      :else
-      (let [(non-seq-keys length) (get-nonsequential-keys t)
-            id (get-id self t)]
-        (if (> (. self.appearances t) 1)
-            (puts self "#<" id ">")
-            (and (= (# non-seq-keys) 0) (= (# t) 0))
-            (puts self "{}")
-            (= (# non-seq-keys) 0)
-            (put-sequential-table self t length)
-            :else
-            (put-kv-table self t)))))
+  (let [metamethod (and self.metamethod? (-?> t getmetatable (. :__fennelview)))]
+    (if (and (already-visited? self t) self.detect-cycles?)
+        (puts self "#<table @" (get-id self t) ">")
+        (>= self.level self.depth)
+        (puts self "{...}")
+        metamethod
+        (puts self (metamethod t self.fennelview))
+        :else
+        (let [(non-seq-keys len) (get-nonsequential-keys t)
+              id (get-id self t)]
+          ;; fancy metatable stuff can result in self.appearances not including
+          ;; a table, so if it's not found, assume we haven't seen it; we can't
+          ;; do cycle detection in that case.
+          (when (and (< 1 (or (. self.appearances t) 0)) self.detect-cycles?)
+            (puts self "@" id))
+          (if (and (= (length non-seq-keys) 0) (= (length t) 0))
+              (puts self (if self.empty-as-square "[]" "{}"))
+              (= (length non-seq-keys) 0)
+              (put-sequential-table self t len)
+              :else
+              (put-kv-table self t non-seq-keys))))))
 
 (set put-value (fn [self v]
                  (let [tv (type v)]
                    (if (= tv "string")
-                       (puts self (quote (escape v)))
+                       (puts self (view-quote (escape v)))
                        (or (= tv "number") (= tv "boolean") (= tv "nil"))
                        (puts self (tostring v))
                        (= tv "table")
@@ -146,11 +162,41 @@
 
 
 
-(fn fennelview [root options]
+(fn one-line [str]
+  ;; save return value as local to ignore gsub's extra return value
+  (let [ret (-> str
+                (: :gsub "\n" " ")
+                (: :gsub "%[ " "[") (: :gsub " %]" "]")
+                (: :gsub "%{ " "{") (: :gsub " %}" "}")
+                (: :gsub "%( " "(") (: :gsub " %)" ")"))]
+    ret))
+
+(fn fennelview [x options]
+  "Return a string representation of x.
+
+Can take an options table with these keys:
+* :one-line (boolean: default: false) keep the output string as a one-liner
+* :depth (number, default: 128) limit how many levels to go (default: 128)
+* :indent (string, default: \"  \") use this string to indent each level
+* :detect-cycles? (boolean, default: true) don't try to traverse a looping table
+* :metamethod? (boolean: default: true) use the __fennelview metamethod if found
+* :table-edges (boolean: default: true) put {} table brackets on their own line
+* :empty-as-square (boolean: default: false) render empty tables as [], not {}
+
+The __fennelview metamethod should take the table being serialized as its first
+argument and a function as its second arg which can be used on table elements to
+continue the fennelview process on them.
+"
   (let [options (or options {})
-        inspector {:appearances (count-table-appearances root {})
+        inspector {:appearances (count-table-appearances x {})
                    :depth (or options.depth 128)
                    :level 0 :buffer {} :ids {} :max-ids {}
-                   :indent (or options.indent "  ")}]
-    (put-value inspector root)
-    (table.concat inspector.buffer)))
+                   :indent (or options.indent (if options.one-line "" "  "))
+                   :detect-cycles? (not (= false options.detect-cycles?))
+                   :metamethod? (not (= false options.metamethod?))
+                   :fennelview #(fennelview $1 options)
+                   :table-edges (not= options.table-edges false)
+                   :empty-as-square options.empty-as-square}]
+    (put-value inspector x)
+    (let [str (table.concat inspector.buffer)]
+      (if options.one-line (one-line str) str))))