Skip to content

Commit 7d1235e

Browse files
sergvsergv
committed
get rid of haskell--rx-let macro
1 parent 0e04612 commit 7d1235e

File tree

2 files changed

+135
-149
lines changed

2 files changed

+135
-149
lines changed

‎haskell-c2hs.el‎

Lines changed: 135 additions & 131 deletions
Original file line numberDiff line numberDiff line change
@@ -44,137 +44,141 @@
4444
:group 'haskell)
4545

4646
(defvar haskell-c2hs-font-lock-keywords
47-
`((,(haskell--rx-let ((ws (any ?\s ?\t ?\n ?\r))
48-
(anychar (or (not (any ?#))
49-
(seq "#"
50-
(not (any ?\})))))
51-
(any-nonquote (or (not (any ?# ?\"))
52-
(seq "#"
53-
(not (any ?\} ?\")))))
54-
(cid (seq (any (?a . ?z) (?A . ?Z) ?_)
55-
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_))))
56-
(hsid-type (seq (? "'")
57-
(any (?A . ?Z))
58-
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_ ?'))))
59-
(equals-str-val (seq (* ws)
60-
"="
61-
(* ws)
62-
"\""
63-
(* any-nonquote)
64-
"\"")))
65-
(group-n 1 "{#")
66-
(* ws)
67-
(or (seq (group-n 2
68-
"import"
69-
(opt (+ ws)
70-
"qualified"))
71-
(+ ws))
72-
(seq (group-n 2
73-
"context")
74-
(opt (+ ws)
75-
(group-n 3
76-
"lib")
77-
equals-str-val)
78-
(opt (+ ws)
79-
(group-n 4
80-
"prefix")
81-
equals-str-val)
82-
(opt (+ ws)
83-
(group-n 5
84-
"add"
85-
(+ ws)
86-
"prefix")
87-
equals-str-val))
88-
(seq (group-n 2
89-
"type")
90-
(+ ws)
91-
cid)
92-
(seq (group-n 2
93-
"sizeof")
94-
(+ ws)
95-
cid)
96-
(seq (group-n 2
97-
"enum"
98-
(+ ws)
99-
"define")
100-
(+ ws)
101-
cid)
102-
;; TODO: vanilla enum fontification is incomplete
103-
(seq (group-n 2
104-
"enum")
105-
(+ ws)
106-
cid
107-
(opt (+ ws)
108-
(group-n 3
109-
"as")))
110-
;; TODO: fun hook highlighting is incompelete
111-
(seq (group-n 2
112-
(or "call"
113-
"fun")
114-
(opt (+ ws)
115-
"pure")
116-
(opt (+ ws)
117-
"unsafe"))
118-
(+ ws)
119-
cid
120-
(opt (+ ws)
121-
(group-n 3
122-
"as")
123-
(opt (+ ws)
124-
(group-n 8
125-
"^"))))
126-
(group-n 2
127-
"get")
128-
(group-n 2
129-
"set")
130-
(seq (group-n 2
131-
"pointer")
132-
(or (seq (* ws)
133-
(group-n 3 "*")
134-
(* ws))
135-
(+ ws))
136-
cid
137-
(opt (+ ws)
138-
(group-n 4 "as")
139-
(+ ws)
140-
hsid-type)
141-
(opt (+ ws)
142-
(group-n 5
143-
(or "foreign"
144-
"stable")))
145-
(opt
146-
(or (seq (+ ws)
147-
(group-n 6
148-
"newtype"))
149-
(seq (* ws)
150-
"->"
151-
(* ws)
152-
hsid-type)))
153-
(opt (+ ws)
154-
(group-n 7
155-
"nocode")))
156-
(group-n 2
157-
"class")
158-
(group-n 2
159-
"alignof")
160-
(group-n 2
161-
"offsetof")
162-
(seq (group-n 2
163-
"const")
164-
(+ ws)
165-
cid)
166-
(seq (group-n 2
167-
"typedef")
168-
(+ ws)
169-
cid
170-
(+ ws)
171-
hsid-type)
172-
(group-n 2
173-
"nonGNU")
174-
;; TODO: default hook not implemented
175-
)
176-
(* anychar)
177-
(group-n 9 "#}"))
47+
`((,(eval-when-compile
48+
(let* ((ws '(any ?\s ?\t ?\n ?\r))
49+
(anychar '(or (not (any ?#))
50+
(seq "#"
51+
(not (any ?\})))))
52+
(any-nonquote '(or (not (any ?# ?\"))
53+
(seq "#"
54+
(not (any ?\} ?\")))))
55+
(cid '(seq (any (?a . ?z) (?A . ?Z) ?_)
56+
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_))))
57+
(hsid-type '(seq (? "'")
58+
(any (?A . ?Z))
59+
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_ ?'))))
60+
(equals-str-val `(seq (* ,ws)
61+
"="
62+
(* ,ws)
63+
"\""
64+
(* ,any-nonquote)
65+
"\"")))
66+
(eval
67+
`(rx
68+
(seq
69+
(group-n 1 "{#")
70+
(* ,ws)
71+
(or (seq (group-n 2
72+
"import"
73+
(opt (+ ,ws)
74+
"qualified"))
75+
(+ ,ws))
76+
(seq (group-n 2
77+
"context")
78+
(opt (+ ,ws)
79+
(group-n 3
80+
"lib")
81+
,equals-str-val)
82+
(opt (+ ,ws)
83+
(group-n 4
84+
"prefix")
85+
,equals-str-val)
86+
(opt (+ ,ws)
87+
(group-n 5
88+
"add"
89+
(+ ,ws)
90+
"prefix")
91+
,equals-str-val))
92+
(seq (group-n 2
93+
"type")
94+
(+ ,ws)
95+
,cid)
96+
(seq (group-n 2
97+
"sizeof")
98+
(+ ,ws)
99+
,cid)
100+
(seq (group-n 2
101+
"enum"
102+
(+ ,ws)
103+
"define")
104+
(+ ,ws)
105+
,cid)
106+
;; TODO: vanilla enum fontification is incomplete
107+
(seq (group-n 2
108+
"enum")
109+
(+ ,ws)
110+
,cid
111+
(opt (+ ,ws)
112+
(group-n 3
113+
"as")))
114+
;; TODO: fun hook highlighting is incompelete
115+
(seq (group-n 2
116+
(or "call"
117+
"fun")
118+
(opt (+ ,ws)
119+
"pure")
120+
(opt (+ ,ws)
121+
"unsafe"))
122+
(+ ,ws)
123+
,cid
124+
(opt (+ ,ws)
125+
(group-n 3
126+
"as")
127+
(opt (+ ,ws)
128+
(group-n 8
129+
"^"))))
130+
(group-n 2
131+
"get")
132+
(group-n 2
133+
"set")
134+
(seq (group-n 2
135+
"pointer")
136+
(or (seq (* ,ws)
137+
(group-n 3 "*")
138+
(* ,ws))
139+
(+ ,ws))
140+
,cid
141+
(opt (+ ,ws)
142+
(group-n 4 "as")
143+
(+ ,ws)
144+
,hsid-type)
145+
(opt (+ ,ws)
146+
(group-n 5
147+
(or "foreign"
148+
"stable")))
149+
(opt
150+
(or (seq (+ ,ws)
151+
(group-n 6
152+
"newtype"))
153+
(seq (* ,ws)
154+
"->"
155+
(* ,ws)
156+
,hsid-type)))
157+
(opt (+ ,ws)
158+
(group-n 7
159+
"nocode")))
160+
(group-n 2
161+
"class")
162+
(group-n 2
163+
"alignof")
164+
(group-n 2
165+
"offsetof")
166+
(seq (group-n 2
167+
"const")
168+
(+ ,ws)
169+
,cid)
170+
(seq (group-n 2
171+
"typedef")
172+
(+ ,ws)
173+
,cid
174+
(+ ,ws)
175+
,hsid-type)
176+
(group-n 2
177+
"nonGNU")
178+
;; TODO: default hook not implemented
179+
)
180+
(* ,anychar)
181+
(group-n 9 "#}"))))))
178182
;; Override highlighting for pairs in order to always distinguish them.
179183
(1 'haskell-c2hs-hook-pair-face t)
180184
(2 'haskell-c2hs-hook-name-face)

‎haskell-utils.el‎

Lines changed: 0 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -180,23 +180,5 @@ expression bounds."
180180
end-c
181181
value)))))
182182

183-
(defmacro haskell--rx-let (definitions &rest main-expr)
184-
"Return `rx' invokation of main-expr that has symbols defined in
185-
DEFINITIONS substituted by definition body. DEFINITIONS is list
186-
of let-bindig forms, (<symbol> <body>). No recursion is permitted -
187-
no defined symbol should show up in body of its definition or in
188-
body of any futher definition."
189-
(declare (indent 1))
190-
(let ((invalid-def (cl-find-if (lambda (def) (not (= 2 (length def)))) definitions)))
191-
(when invalid-def
192-
(error "haskell--rx-let: every definition must consist of two elements: (name def), but this one doesn't: %s"
193-
invalid-def)))
194-
`(rx ,@(cl-reduce (lambda (def expr)
195-
(cl-subst (cadr def) (car def) expr
196-
:test #'eq))
197-
definitions
198-
:initial-value main-expr
199-
:from-end t)))
200-
201183
(provide 'haskell-utils)
202184
;;; haskell-utils.el ends here

0 commit comments

Comments
 (0)