Skip to content

Commit

Permalink
Update Fennel keywords to catch up to version 0.6.0.
Browse files Browse the repository at this point in the history 
Remove support for single-quoted strings.

Update fennelview example to latest version of library.
  • Loading branch information
@technomancy @birkenfeld
technomancy authored and birkenfeld committed Sep 7, 2020
1 parent 080bbeb commit c4a3b82
Show file tree
Hide file tree
Showing 2 changed files with 104 additions and 54 deletions.
24 changes: 14 additions & 10 deletions pygments/lexers/lisp.py
View file
Expand Up @@ -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?
Expand All @@ -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': [
Expand All @@ -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
Expand Down
134 changes: 90 additions & 44 deletions tests/examplefiles/fennelview.fnl
View file
@@ -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)]
Expand All @@ -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")
Expand All @@ -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)
Expand All @@ -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)

Expand All @@ -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))
Expand All @@ -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")
Expand All @@ -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))))

0 comments on commit c4a3b82

Please sign in to comment.