Skip to content

Add c2hs mode #1199

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 5 commits into from
Mar 14, 2016
Merged

Add c2hs mode #1199

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
6226b70
Add c2hs mode
sergv Mar 7, 2016
6107531
Fix byte compile error in check-face-match-range
sergv Mar 9, 2016
aa46bb8
Generalize check-properties test helper
sergv Mar 9, 2016
9327171
Split enum into vanilla enum and enum define
sergv Mar 10, 2016
1173847
Add c2hs fontification tests
sergv Mar 11, 2016
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
204 changes: 204 additions & 0 deletions haskell-c2hs.el
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,204 @@
;; haskell-c2hs.el --- -*- lexical-binding: t; -*-

;; Copyright (C) 2016 Sergey Vinokurov
;;
;; Author: Sergey Vinokurov <[email protected]>
;; Created: Monday, 7 March 2016

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This mode is mostly intended for highlighting {#...#} hooks.
;;
;; Quick setup:
;; (autoload 'c2hs-mode "c2hs-mode" nil t)
;; (add-to-list 'auto-mode-alist '("\\.chs\\'" . c2hs-mode))
;;

(require 'haskell-mode)
(require 'haskell-font-lock)
(require 'haskell-utils)

;;;###autoload
(add-to-list 'auto-mode-alist '("\\.chs\\'" . c2hs-mode))

(defface c2hs-hook-pair-face
'((t (:inherit 'font-lock-preprocessor-face)))
"Face for highlighting {#...#} pairs."
:group 'haskell)

(defface c2hs-hook-name-face
'((t (:inherit 'font-lock-keyword-face)))
"Face for highlighting c2hs hook names."
:group 'haskell)

;;;###autoload
(defvar c2hs-font-lock-keywords
`((,(haskell--rx-let ((ws (any ?\s ?\t ?\n ?\r))
(anychar (or (not (any ?#))
(seq "#"
(not (any ?\})))))
(any-nonquote (or (not (any ?# ?\"))
(seq "#"
(not (any ?\} ?\")))))
(cid (seq (any (?a . ?z) (?A . ?Z) ?_)
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_))))
(hsid-type (seq (? "'")
(any (?A . ?Z))
(* (any (?a . ?z) (?A . ?Z) (?0 . ?9) ?_ ?'))))
(equals-str-val (seq (* ws)
"="
(* ws)
"\""
(* any-nonquote)
"\"")))
(group-n 1 "{#")
(* ws)
(or (seq (group-n 2
"import"
(opt (+ ws)
"qualified"))
(+ ws))
(seq (group-n 2
"context")
(opt (+ ws)
(group-n 3
"lib")
equals-str-val)
(opt (+ ws)
(group-n 4
"prefix")
equals-str-val)
(opt (+ ws)
(group-n 5
"add"
(+ ws)
"prefix")
equals-str-val))
(seq (group-n 2
"type")
(+ ws)
cid)
(seq (group-n 2
"sizeof")
(+ ws)
cid)
(seq (group-n 2
"enum"
(+ ws)
"define")
(+ ws)
cid)
;; TODO: vanilla enum fontification is incomplete
(seq (group-n 2
"enum")
(+ ws)
cid
(opt (+ ws)
(group-n 3
"as")))
;; TODO: fun hook highlighting is incompelete
(seq (group-n 2
(or "call"
"fun")
(opt (+ ws)
"pure")
(opt (+ ws)
"unsafe"))
(+ ws)
cid
(opt (+ ws)
(group-n 3
"as")
(opt (+ ws)
(group-n 8
"^"))))
(group-n 2
"get")
(group-n 2
"set")
(seq (group-n 2
"pointer")
(or (seq (* ws)
(group-n 3 "*")
(* ws))
(+ ws))
cid
(opt (+ ws)
(group-n 4 "as")
(+ ws)
hsid-type)
(opt (+ ws)
(group-n 5
(or "foreign"
"stable")))
(opt
(or (seq (+ ws)
(group-n 6
"newtype"))
(seq (* ws)
"->"
(* ws)
hsid-type)))
(opt (+ ws)
(group-n 7
"nocode")))
(group-n 2
"class")
(group-n 2
"alignof")
(group-n 2
"offsetof")
(seq (group-n 2
"const")
(+ ws)
cid)
(seq (group-n 2
"typedef")
(+ ws)
cid
(+ ws)
hsid-type)
(group-n 2
"nonGNU")
;; TODO: default hook not implemented
)
(* anychar)
(group-n 9 "#}"))
;; Override highlighting for pairs in order to always distinguish them.
(1 'c2hs-hook-pair-face t)
(2 'c2hs-hook-name-face)
;; Make matches lax, i.e. do not signal error if nothing
;; matched.
(3 'c2hs-hook-name-face nil t)
(4 'c2hs-hook-name-face nil t)
(5 'c2hs-hook-name-face nil t)
(6 'c2hs-hook-name-face nil t)
(7 'c2hs-hook-name-face nil t)
(8 'font-lock-negation-char-face nil t)
;; Override highlighting for pairs in order to always distinguish them.
(9 'c2hs-hook-pair-face t))
,@(haskell-font-lock-keywords)))

;;;###autoload
(define-derived-mode c2hs-mode haskell-mode "C2HS"
"Mode for editing *.chs files of the c2hs haskell tool."
(setq-local font-lock-defaults
(cons 'c2hs-font-lock-keywords
(cdr font-lock-defaults))))


(provide 'haskell-c2hs)

;; haskell-c2hs.el ends here
20 changes: 20 additions & 0 deletions haskell-utils.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,8 @@
;; require/depend-on any other haskell-mode modules in order to
;; stay at the bottom of the module dependency graph.

(eval-when-compile (require 'cl-lib))

(require 'haskell-customize)

(defvar haskell-utils-async-post-command-flag nil
Expand Down Expand Up @@ -175,5 +177,23 @@ expression bounds."
end-c
value)))))

(defmacro haskell--rx-let (definitions &rest main-expr)
"Return `rx' invokation of main-expr that has symbols defined in
DEFINITIONS substituted by definition body. DEFINITIONS is list
of let-bindig forms, (<symbol> <body>). No recursion is permitted -
no defined symbol should show up in body of its definition or in
body of any futher definition."
(declare (indent 1))
(let ((invalid-def (cl-find-if (lambda (def) (not (= 2 (length def)))) definitions)))
(when invalid-def
(error "haskell--rx-let: every definition must consist of two elements: (name def), but this one doesn't: %s"
invalid-def)))
`(rx ,@(cl-reduce (lambda (def expr)
(cl-subst (cadr def) (car def) expr
:test #'eq))
definitions
:initial-value main-expr
:from-end t)))

(provide 'haskell-utils)
;;; haskell-utils.el ends here
Loading