Skip to content

Replace cl-case calls with cond #34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Oct 13, 2021
Merged

Replace cl-case calls with cond #34

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6f9ab8f
Replace `cl-case` calls with `cond`
plexus Oct 11, 2021
5cf5cd5
Replace seq-doseq with mapcar... IDK
plexus Oct 12, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# Unreleased

- [#34](https://github.com/clojure-emacs/parseclj/pull/34) Replace `cl-case` with `cond`

## 1.0.4 (2021-09-30)

- Provide parseclj-alist-merge, since we can't use `(map-merge 'alist)` yet in Emacs 25/26.
Expand Down
10 changes: 6 additions & 4 deletions parseclj-alist.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -82,10 +82,12 @@ For example: (parseclj-hash-table :foo 123 :bar 456)"
;; Emacs 27: (map-merge 'alist l1 l2)
(let ((keys (delete-dups (append (mapcar #'car l1) (mapcar #'car l2))))
(res '()))
(seq-doseq (key keys)
(push (or (assoc key l2)
(assoc key l1))
res))
(mapcar
(lambda (key)
(push (or (assoc key l2)
(assoc key l1))
res))
keys)
(nreverse res)))

(provide 'parseclj-alist)
Expand Down
58 changes: 29 additions & 29 deletions parseclj-ast.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -120,29 +120,29 @@ OPTIONS is an association list. See `parseclj-parse' for more information
on available options."
(let* ((pos (map-elt opening-token :pos))
(type (parseclj-lex-token-type opening-token))
(type (cl-case type
(:lparen :list)
(:lbracket :vector)
(:lbrace :map)
(t type))))
(cl-case type
(:root (cons (parseclj-ast-node :root pos :children children) stack))
(:discard stack)
(:tag (cons (parseclj-ast-node :tag
pos
:tag (intern (substring (map-elt opening-token :form) 1))
:children children)
stack))
(:metadata (cons (parseclj-ast-node :with-meta
pos
:children children)
stack))
(:map-prefix (cons (parseclj-alist-assoc (car children)
:map-prefix opening-token)
stack))
(t (cons
(parseclj-ast-node type pos :children children)
stack)))))
(type (cond
((eq :lparen type) :list)
((eq :lbracket type) :vector)
((eq :lbrace type) :map)
(t type))))
(cond
((eq :root type) (cons (parseclj-ast-node :root pos :children children) stack))
((eq :discard type) stack)
((eq :tag type) (cons (parseclj-ast-node :tag
pos
:tag (intern (substring (map-elt opening-token :form) 1))
:children children)
stack))
((eq :metadata type) (cons (parseclj-ast-node :with-meta
pos
:children children)
stack))
((eq :map-prefix type) (cons (parseclj-alist-assoc (car children)
:map-prefix opening-token)
stack))
(t (cons
(parseclj-ast-node type pos :children children)
stack)))))

(defun parseclj-ast--reduce-branch-with-lexical-preservation (stack opening-token children options)
"Reduce STACK with an AST branch node representing a collection of elements.
Expand Down Expand Up @@ -176,12 +176,12 @@ on available options."
(defun parseclj-ast--unparse-collection (node)
"Insert a string representation of the given AST branch NODE into buffer."
(let* ((token-type (parseclj-ast-node-type node))
(delimiters (cl-case token-type
(:root (cons "" ""))
(:list (cons "(" ")"))
(:vector (cons "[" "]"))
(:set (cons "#{" "}"))
(:map (cons "{" "}")))))
(delimiters (cond
((eq :root token-type) (cons "" ""))
((eq :list token-type) (cons "(" ")"))
((eq :vector token-type) (cons "[" "]"))
((eq :set token-type) (cons "#{" "}"))
((eq :map token-type) (cons "{" "}")))))
(insert (car delimiters))
(let ((nodes (alist-get ':children node)))
(when-let (node (car nodes))
Expand Down
38 changes: 20 additions & 18 deletions parseclj-lex.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -140,14 +140,15 @@ S goes through three transformations:
(make-string 1 (string-to-number (substring x 2) 16)))
(replace-regexp-in-string "\\\\[tbnrf'\"\\]"
(lambda (x)
(cl-case (elt x 1)
(?t "\t")
(?f "\f")
(?\" "\"")
(?r "\r")
(?n "\n")
(?\\ "\\\\")
(t (substring x 1))))
(let ((ch (elt x 1)))
(cond
((eq ?t ch) "\t")
((eq ?f ch) "\f")
((eq ?\" ch) "\"")
((eq ?r ch) "\r")
((eq ?n ch) "\n")
((eq ?\\ ch) "\\\\")
(t (substring x 1)))))
(substring s 1 -1)))))

(defun parseclj-lex--character-value (c)
Expand All @@ -164,16 +165,17 @@ S goes through three transformations:

(defun parseclj-lex--leaf-token-value (token)
"Parse the given leaf TOKEN to an Emacs Lisp value."
(cl-case (parseclj-lex-token-type token)
(:number (string-to-number (alist-get :form token)))
(:nil nil)
(:true t)
(:false nil)
(:symbol (intern (alist-get :form token)))
(:keyword (intern (alist-get :form token)))
(:string (parseclj-lex--string-value (alist-get :form token)))
(:character (parseclj-lex--character-value (alist-get :form token)))
(:symbolic-value (intern (substring (alist-get :form token) 2)))))
(let ((token-type (parseclj-lex-token-type token)))
(cond
((eq :number token-type) (string-to-number (alist-get :form token)))
((eq :nil token-type) nil)
((eq :true token-type) t)
((eq :false token-type) nil)
((eq :symbol token-type) (intern (alist-get :form token)))
((eq :keyword token-type) (intern (alist-get :form token)))
((eq :string token-type) (parseclj-lex--string-value (alist-get :form token)))
((eq :character token-type) (parseclj-lex--character-value (alist-get :form token)))
((eq :symbolic-value token-type) (intern (substring (alist-get :form token) 2))))))

;; Stream tokenization

Expand Down
25 changes: 13 additions & 12 deletions parseclj-parser.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -43,18 +43,19 @@ can be handled with `condition-case'."

(defun parseclj--find-opening-token (stack closing-token)
"Scan STACK for an opening-token matching CLOSING-TOKEN."
(cl-case (parseclj-lex-token-type closing-token)
(:rparen (parseclj-lex-token-type
(seq-find (lambda (token)
(member (parseclj-lex-token-type token)
'(:lparen :lambda)))
stack)))
(:rbracket :lbracket)
(:rbrace (parseclj-lex-token-type
(seq-find (lambda (token)
(member (parseclj-lex-token-type token)
'(:lbrace :set)))
stack)))))
(let ((token-type (parseclj-lex-token-type closing-token)))
(cond
((eq :rparen token-type) (parseclj-lex-token-type
(seq-find (lambda (token)
(member (parseclj-lex-token-type token)
'(:lparen :lambda)))
stack)))
((eq :rbracket token-type) :lbracket)
((eq :rbrace token-type) (parseclj-lex-token-type
(seq-find (lambda (token)
(member (parseclj-lex-token-type token)
'(:lbrace :set)))
stack))))))

(defun parseclj--reduce-coll (stack closing-token reduce-branch options)
"Reduce collection based on the top of the STACK and a CLOSING-TOKEN.
Expand Down