Commit 5f00907f authored by POGODALLA Sylvain's avatar POGODALLA Sylvain

Fix the compilation error matching bug and improve the indentation

parent 96fecc75
......@@ -17,7 +17,8 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Main missing features: indentation
;; Main missing features: indentation. Only a cheap implementation is
;; provided
(require 'generic-x)
......@@ -28,9 +29,16 @@
"infix"
"binder"
"end"
"type")
'(("\\(signature\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \t\n]*\\(=\\)" 1 'font-lock-keyword-face)
("\\(signature\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\(=\\)" 2 'font-lock-constant-face)
"type"
"signature"
"lexicon")
'(
; FIXME while this regexp correctly capture multi-line comments,
; they they're not highlighted in the emace buffer. Only single
; line comments are
("\\((\\*\\([^*]*\\*[^)].*\\|[^*]*\\|.*[^*])\\|[^)]*\\)\\(\n\2\\)*\\*)\\)" 1 ''font-lock-comment-face)
("\\(signature\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \t\n]*\\(=\\)" 1 'font-lock-keyword-face)
("\\(signature\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\(=\\)" 2 'font-lock-constant-face)
("\\(signature\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\(=\\)" 3 'font-lock-keyword-face)
("\\(lexicon\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\((\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\()\\)[ \n\t]*\\(:\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\(=\\)" 1 'font-lock-keyword-face)
("\\(lexicon\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\((\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\()\\)[ \n\t]*\\(:\\)[ \n\t]*\\([a-zA-Z0-9_']*\\)[ \n\t]*\\(=\\)" 2 'font-lock-constant-face)
......@@ -45,6 +53,30 @@
nil
)
; regexp pour les commentaires
; (\*\([^*]*\*[^)].*\|[^*]*\|.*[^*])\|[^)]*\)\(\n\1\)*\*)
;;;;;;;;;;;;;;;;;;;;;;;
;; User customization
;;;;;;;;;;;;;;;;;;;;;;;
(require 'custom)
(defgroup acg nil
"Support for the ACG definition language"
:group 'languages)
(defcustom acg-default-indent 4
"*Default indentation.
Global indentation variable (large values may lead to indentation overflows).
When no governing keyword is found, this value is used to indent the line
if it has to."
:group 'acg :type 'integer)
(defgroup acg-faces nil
"Special faces for the Acg mode."
:group 'acg)
......@@ -93,6 +125,8 @@
(add-hook 'acg-mode-hook 'acg-set-compile-command)
(require 'compile)
;; find the line of the error
(defconst acg-error-regexp
;; "^[^\0-@]+ \"\\([^\"\n]+\\)\", [^\0-@]+ \\([0-9]+\\)[-,:]"
......@@ -111,12 +145,12 @@
;; (for instance in case of non linear application on linear variable
(defconst acg-error-chars-single-line-regexp
;; ".*, .*, [^\0-@]+ \\([0-9]+\\)-\\([0-9]+\\)"
".*line [0-9]+, characters \\([0-9]+\\)-\\([0-9]+\\)"
".*line \\([0-9]+\\), characters \\([0-9]+\\)-\\([0-9]+\\)"
"Regexp matching the char numbers in an error message produced by acgc.")
(defconst acg-error-chars-multi-line-regexp
".*line [0-9]+, character \\([0-9]+\\) to line \\([0-9]+\\), character \\([0-9]+\\)"
".*line \\([0-9]+\\), character \\([0-9]+\\) to line \\([0-9]+\\), character \\([0-9]+\\)"
"Regexp matching the char numbers in an error message produced by acgc.")
......@@ -132,19 +166,22 @@ Puts the point and the mark exactly around the erroneous program
fragment. The erroneous fragment is also temporarily highlighted if
possible."
(if (eq major-mode 'acg-mode)
(let ((beg nil) (end nil) (line-end nil) (char-end nil))
(let ((beg nil) (end nil) (line-beg nil) (line-end nil) (char-end nil))
(save-excursion
(set-buffer compilation-last-buffer)
(save-excursion
(goto-char (window-point (get-buffer-window (current-buffer) t)))
(if (looking-at acg-error-chars-single-line-regexp)
(setq beg (string-to-int (acg-match-string 1))
end (string-to-int (acg-match-string 2)))
(setq line-beg (string-to-int (acg-match-string 1))
beg (string-to-int (acg-match-string 2))
end (string-to-int (acg-match-string 3)))
(if (looking-at acg-error-chars-multi-line-regexp)
(setq beg (string-to-int (acg-match-string 1))
line-end (string-to-int (acg-match-string 2))
char-end (string-to-int (acg-match-string 3))
(setq line-beg (string-to-int (acg-match-string 1))
beg (string-to-int (acg-match-string 2))
line-end (string-to-int (acg-match-string 3))
char-end (string-to-int (acg-match-string 4))
)))))
; (goto-line line-beg)
(beginning-of-line)
(if beg
(progn
......@@ -171,3 +208,127 @@ possible."
)
(ad-activate 'next-error)
; This code provides a very cheap indentation procedure. It basically
; expects the signature, lexicon and end kwd to be the first
; declaration on the line and that for each declaration (or
; definition) not to have anything else after the closing ";"
;(make-local-variable 'indent-line-function)
(setq indent-line-function 'acg-indent-line)
(defun acg-find-position-from-first-non-blank-char ()
; (message "point is: %s" (current-column))
; (message "indentation is: %s" (current-indentation))
(if (> (current-column) (current-indentation))
(- (current-column) (current-indentation))
0))
(defun acg-move-backward-line-skipping-empty-lines ()
; (message "Moving backward from %d" (line-number-at-pos))
(if (forward-line -1)
(progn
(while (and (not (looking-at "^[ \t]*[^ \t\n].*$")) (not (bobp)))
(forward-line -1))
t)
(nil)))
(defun acg-check-current-line-belongs-to-a-comment ()
(let (in-comment))
; (message "Checking line: %d" (line-number-at-pos))
(save-excursion
; assume we're in a comment by
; default
(if (acg-move-backward-line-skipping-empty-lines)
(cond
((looking-at "^[ \t]*(\\*.*\\*)[ \t]*$") ; the line is a one line comment
(progn
; (message "The previous line is a one line comment")
(setq in-comment nil)))
((looking-at "^.*\\*)[ \t]*$") ; the line ends closing a comment
(progn
; (message "The previous line closes a comment")
(setq in-comment nil)))
((looking-at "^[ \t]*(\\*") ; the line opens a comment without closing it
(progn
; (message "The previous line opens a comment")
(setq in-comment t)))
((bobp)
(progn
; (message "Reaching the beginning of the buffer")
(setq in-comment nil)))
(t ; there is no mention of a comment
(progn
; (message "Don't know. I need to move backward")
(setq in-comment (acg-check-current-line-belongs-to-a-comment)))))
(setq in-comment nil)
)
)
in-comment)
(defun acg-indent-line ()
"Indent current line as ACG declaration"
(interactive "*")
(setq offset-from-non-blank (acg-find-position-from-first-non-blank-char))
(setq inside-comment-tab 3)
; (message "the offset is %s" offset-from-non-blank)
(beginning-of-line)
(setq cur-indent nil)
(if (acg-check-current-line-belongs-to-a-comment )
(progn
()
(save-excursion
(acg-move-backward-line-skipping-empty-lines)
(while (and (acg-check-current-line-belongs-to-a-comment) (not (bobp)))
(acg-move-backward-line-skipping-empty-lines))
(setq cur-indent (+ inside-comment-tab (current-indentation)))))
(if (bobp)
; if beginning of buffer, set
; indentation to 0
(setq cur-indent 0)
; otherwise first look if
; there is some keyword
; starting the line
(if (looking-at "^[ \t]*\\(lexicon\\|signature\\|end\\)")
; and also set indentation to 0
(progn
(setq cur-indent 0)
;(message "I found a kwd so cur-indent is set to 0")
)
; we're in a declaration or a definition
; let's try to see whether the previous one was closed
(progn
(save-excursion
(acg-move-backward-line-skipping-empty-lines)
(if (acg-check-current-line-belongs-to-a-comment)
(setq cur-indent (max 0 (- (current-indentation) inside-comment-tab)))
(progn
(cond
((bobp)
(setq cur-indent 0))
((looking-at "^[ \t]*\\(lexicon\\|signature\\)")
(setq cur-indent acg-default-indent)
)
((looking-at "^[ \t]*end")
(setq cur-indent 0)
)
((looking-at "^[ \t]*(\\*.*\\*)[ \t]*$")
(setq cur-indent (current-indentation))
)
((looking-at "^.*;[ \t]*$")
(setq cur-indent acg-default-indent)
)
(t
(setq cur-indent (+ acg-default-indent acg-default-indent))
)
))))))))
(if cur-indent
(indent-line-to cur-indent)
(indent-line-to 0))
(forward-char offset-from-non-blank)
)
......@@ -231,6 +231,26 @@ lexicon tag_syntax (derivation_trees) : derived_trees =
C_liked := wh_extract_tv liked;
C_said := ph_arg_v said;
C_does_think := lambda s_root a subj s_foot . s_root (S2 does (S2 subj (a (VP2 think s_foot))));
I_n,I_vp,I_s := lambda x.x;
end
I_n,I_vp,I_s := lambda x.x;
signature toto =
tutu: type;
essai : type;
(* voici *)
a : toto ->
tutu ;
b; to; (Lambda ());
(* toto
sfsdf
tutu *)
(* toto *)
tutu;
end
essa;
end
......@@ -18,12 +18,14 @@
(**************************************************************************)
signature abstract =
np,s,n:type;
np,s,n,s':type;
J,M,he,her,it:np;
man,woman,farmer,donkey:n;
loves,beats,owns : np => np => s;
a,every,most:n=>np;
who: (np => s) => n => n;
CLOSE : s => s';
end
......@@ -35,6 +37,7 @@ signature object =
infix + : e => g => g;
Top,Bot:t;
john,mary : e;
nil : g;
man,woman,farmer,donkey:e=>t;
infix & : t => t => t;
love,beat,own : e => e => t;
......@@ -54,6 +57,7 @@ end
lexicon montague (abstract) : object =
s := o;
s' := t;
np := (e => o) => o;
n := e => o;
J := Lambda P.P john;
......@@ -70,4 +74,6 @@ lexicon montague (abstract) : object =
every := Lambda P Q . All_dyn x. (P x) > (Q x);
most := Lambda P Q . Most x. (P x) > (Q x);
who := Lambda R Q x. (Q x) @ (R (Lambda P.P x));
CLOSE := Lambda S.S nil (Lambda e.Top);
end
\ No newline at end of file
......@@ -25,5 +25,7 @@ abstract analyse beats (every farmer) (a J) : s;
abstract analyse beats (every farmer) (a donkey) : s;
select object;
print;
abstract analyse beats it (every (who (owns (a donkey)) farmer)) : s;
montague analyse beats (every farmer) (a donkey) : s;
montague analyse beats it : np => s;
montague analyse beats it (every (who (owns (a donkey)) farmer)) : s;
montague analyse CLOSE (beats it (every (who (owns (a donkey)) farmer))) : s';
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment