steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor into faster_overflow_checks

db4
Slava Pestov 2008-11-28 21:05:31 -06:00
parent 68dd6cc35a 76afa6bf49
commit d3a40ff438
2 changed files with 103 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/kernel/kernel-docs.factor
View File

@ -599,7 +599,7 @@ HELP: dip
HELP: 2dip
{ $values { "x" object } { "y" object } { "quot" quotation } }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } " and " { $snippet "obj2" } " hidden on the retain stack." }
{ $description "Calls " { $snippet "quot" } " with " { $snippet "x" } " and " { $snippet "y" } " hidden on the retain stack." }
{ $notes "The following are equivalent:"
{ $code "[ [ foo bar ] dip ] dip" }
{ $code "[ foo bar ] 2dip" }

158
misc/factor.el
View File

@ -118,6 +118,10 @@ buffer."
"Face for parsing words."
:group 'factor-faces)
(defface factor-font-lock-declaration (face-default-spec font-lock-keyword-face)
"Face for declaration words (inline, parsing ...)."
:group 'factor-faces)
(defface factor-font-lock-comment (face-default-spec font-lock-comment-face)
"Face for comments."
:group 'factor-faces)
@ -178,10 +182,15 @@ buffer."
"UNION:" "USE:" "USING:" "V{" "VAR:" "VARS:" "W{"))
(defconst factor--regex-parsing-words-ext
(regexp-opt '("B" "call-next-method" "delimiter" "f" "flushable" "foldable"
"initial:" "inline" "parsing" "read-only" "recursive")
(regexp-opt '("B" "call-next-method" "delimiter" "f" "initial:" "read-only")
'words))
(defconst factor--declaration-words
'("flushable" "foldable" "inline" "parsing" "recursive"))
(defconst factor--regex-declaration-words
(regexp-opt factor--declaration-words 'words))
(defsubst factor--regex-second-word (prefixes)
(format "^%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
@ -202,7 +211,7 @@ buffer."
(defconst factor--regex-stack-effect " ( .* )")
(defconst factor--regex-using-line "^USING: +\\([^;]*\\);")
(defconst factor--regex-using-lines "^USING: +\\(\\([^;]\\|[\n\r\f]\\)*\\);")
(defconst factor--regex-use-line "^USE: +\\(.*\\)$")
@ -213,30 +222,31 @@ buffer."
'(2 'factor-font-lock-parsing-word)))
factor--parsing-words)
(,factor--regex-parsing-words-ext . 'factor-font-lock-parsing-word)
(,factor--regex-declaration-words 1 'factor-font-lock-declaration)
(,factor--regex-word-definition 2 'factor-font-lock-word-definition)
(,factor--regex-type-definition 2 'factor-font-lock-type-definition)
(,factor--regex-parent-type 1 'factor-font-lock-type-definition)
(,factor--regex-constructor . 'factor-font-lock-constructor)
(,factor--regex-setter . 'factor-font-lock-setter-word)
(,factor--regex-symbol-definition 2 'factor-font-lock-symbol-definition)
(,factor--regex-using-line 1 'factor-font-lock-vocabulary-name)
(,factor--regex-using-lines 1 'factor-font-lock-vocabulary-name)
(,factor--regex-use-line 1 'factor-font-lock-vocabulary-name))
"Font lock keywords definition for Factor mode.")
;;; Factor mode syntax:
(defconst factor--regexp-word-starters
(defconst factor--regex-definition-starters
(regexp-opt '("TUPLE" "MACRO" "MACRO:" "M" ":" "")))
(defconst factor--regexp-word-start
(format "^\\(%s:\\) " factor--regexp-word-starters))
(defconst factor--regex-definition-start
(format "^\\(%s:\\) " factor--regex-definition-starters))
(defconst factor--regex-definition-end
(format "\\(;\\( +%s\\)*\\)" factor--regex-declaration-words))
(defconst factor--font-lock-syntactic-keywords
`((,(format "^\\(%s\\)\\(:\\)" factor--regexp-word-starters)
(1 "w") (2 "(;"))
("\\(;\\)" (1 "):"))
("\\(#!\\)" (1 "<"))
`(("\\(#!\\)" (1 "<"))
(" \\(!\\)" (1 "<"))
("^\\(!\\)" (1 "<"))
("\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))))
@ -290,6 +300,7 @@ buffer."
(modify-syntax-entry ?\" "\"" factor-mode-syntax-table)
(modify-syntax-entry ?\\ "/" factor-mode-syntax-table)))
;;; symbol-at-point
(defun factor--beginning-of-symbol ()
@ -323,7 +334,7 @@ buffer."
(save-excursion
(beginning-of-buffer)
(while (not iw)
(if (not (re-search-forward factor--regexp-word-start nil t))
(if (not (re-search-forward factor--regex-definition-start nil t))
(setq iw factor-default-indent-width)
(forward-line)
(when (looking-at word-cont)
@ -336,13 +347,17 @@ buffer."
(defsubst factor--ppss-brackets-start ()
(nth 1 (syntax-ppss)))
(defun factor--ppss-brackets-end ()
(save-excursion
(goto-char (factor--ppss-brackets-start))
(condition-case nil
(progn (forward-sexp)
(1- (point)))
(error -1))))
(defsubst factor--indentation-at (pos)
(save-excursion (goto-char pos) (current-indentation)))
(defconst factor--regex-closing-paren "[])}]")
(defsubst factor--at-closing-paren-p ()
(looking-at factor--regex-closing-paren))
(defsubst factor--at-first-char-p ()
(= (- (point) (line-beginning-position)) (current-indentation)))
@ -350,16 +365,28 @@ buffer."
(format "^%s" (regexp-opt '("DEFER:" "GENERIC:" "IN:"
"PRIVATE>" "<PRIVATE" "SYMBOL:" "USE:"))))
(defconst factor--regex-begin-of-def
(format "^USING: \\|\\(%s\\)\\|\\(%s .*\\)"
factor--regex-definition-start
factor--regex-single-liner))
(defconst factor--regex-end-of-def-line
(format "^.*%s" factor--regex-definition-end))
(defconst factor--regex-end-of-def
(format "\\(%s\\)\\|\\(%s .*\\)"
factor--regex-end-of-def-line
factor--regex-single-liner))
(defsubst factor--at-begin-of-def ()
(looking-at factor--regexp-word-start))
(looking-at factor--regex-begin-of-def))
(defsubst factor--at-end-of-def ()
(looking-at factor--regex-end-of-def))
(defsubst factor--looking-at-emptiness ()
(looking-at "^[ \t]*$"))
(defun factor--at-end-of-def ()
(or (looking-at ".*;[ \t]*$")
(looking-at factor--regex-single-liner)))
(defun factor--at-setter-line ()
(save-excursion
(beginning-of-line)
@ -382,13 +409,12 @@ buffer."
(defun factor--indent-in-brackets ()
(save-excursion
(beginning-of-line)
(when (or (and (re-search-forward factor--regex-closing-paren
(line-end-position) t)
(not (backward-char)))
(> (factor--ppss-brackets-depth) 0))
(let ((op (factor--ppss-brackets-start)))
(when (> (line-number-at-pos) (line-number-at-pos op))
(if (factor--at-closing-paren-p)
(when (> (factor--ppss-brackets-depth) 0)
(let ((op (factor--ppss-brackets-start))
(cl (factor--ppss-brackets-end))
(ln (line-number-at-pos)))
(when (> ln (line-number-at-pos op))
(if (and (> cl 0) (= ln (line-number-at-pos cl)))
(factor--indentation-at op)
(factor--increased-indentation (factor--indentation-at op))))))))
@ -417,7 +443,8 @@ buffer."
(forward-line -1))
(if (or (factor--at-end-of-def) (factor--at-setter-line))
(factor--decreased-indentation)
(if (factor--at-begin-of-def)
(if (and (factor--at-begin-of-def)
(not (looking-at factor--regex-using-lines)))
(factor--increased-indentation)
(current-indentation)))))
@ -448,6 +475,12 @@ buffer."
(defvar factor-mode-map (make-sparse-keymap)
"Key map used by Factor mode.")
(defsubst factor--beginning-of-defun (times)
(re-search-backward factor--regex-begin-of-def nil t times))
(defsubst factor--end-of-defun ()
(re-search-forward factor--regex-end-of-def nil t))
;;;###autoload
(defun factor-mode ()
"A mode for editing programs written in the Factor programming language.
@ -469,8 +502,9 @@ buffer."
(set-syntax-table factor-mode-syntax-table)
;; Defun navigation
(setq defun-prompt-regexp "[^ :]+")
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) t)
(set (make-local-variable 'beginning-of-defun-function) 'factor--beginning-of-defun)
(set (make-local-variable 'end-of-defun-function) 'factor--end-of-defun)
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
;; Indentation
(set (make-local-variable 'indent-line-function) 'factor--indent-line)
(setq factor-indent-width (factor--guess-indent-width))
@ -506,7 +540,8 @@ buffer."
(defun factor--listener-process (&optional start)
(or (and (buffer-live-p factor--listener-buffer)
(get-buffer-process factor--listener-buffer))
(when start
(if (not start)
(error "No running factor listener. Try M-x run-factor.")
(factor--listener-start-process)
(factor--listener-process t))))
@ -566,7 +601,6 @@ buffer."
(defun factor--current-listener-vocab ()
(car (factor--listener-send-cmd "USING: parser ; in get .")))
(defun factor--set-current-listener-vocab (&optional vocab)
(factor--listener-send-cmd
(format "IN: %s" (or vocab (factor--current-buffer-vocab))))
@ -596,23 +630,28 @@ buffer."
(defconst factor--regex-error-marker "^Type :help for debugging")
(defconst factor--regex-data-stack "^--- Data stack:")
(defun factor--prune-stack (ans)
(do ((res '() (cons (car s) res)) (s ans (cdr s)))
((or (not s)
(and (car res) (string-match factor--regex-stack-effect (car res)))
(string-match factor--regex-data-stack (car s)))
(and (not (string-match factor--regex-error-marker (car res)))
(nreverse res)))))
(defun factor--prune-ans-strings (ans)
(nreverse
(catch 'done
(let ((res))
(dolist (a ans res)
(cond ((string-match factor--regex-stack-effect a)
(throw 'done (cons a res)))
((string-match factor--regex-data-stack a)
(throw 'done res))
((string-match factor--regex-error-marker a)
(throw 'done nil))
(t (push a res))))))))
(defun factor--see-ans-to-string (ans)
(let ((s (mapconcat #'identity (factor--prune-stack ans) " ")))
(let ((s (mapconcat #'identity (factor--prune-ans-strings ans) " "))
(font-lock-verbose nil))
(and (> (length s) 0)
(let ((font-lock-verbose nil))
(with-temp-buffer
(insert s)
(factor-mode)
(font-lock-fontify-buffer)
(buffer-string))))))
(with-temp-buffer
(insert s)
(factor-mode)
(font-lock-fontify-buffer)
(buffer-string)))))
(defun factor--see-current-word (&optional word)
(let ((word (or word (factor--symbol-at-point))))
@ -625,10 +664,9 @@ buffer."
(defun factor-see-current-word (&optional word)
"Echo in the minibuffer information about word at point."
(interactive)
(unless (factor--listener-process)
(error "No factor listener running. Try M-x run-factor"))
(let ((word (or word (factor--symbol-at-point)))
(msg (factor--see-current-word word)))
(let* ((proc (factor--listener-process))
(word (or word (factor--symbol-at-point)))
(msg (factor--see-current-word word)))
(if msg (message "%s" msg)
(if word (message "No help found for '%s'" word)
(message "No word at point")))))
@ -746,9 +784,8 @@ buffer."
(defvar factor--help-history nil)
(defun factor--listener-show-help (&optional see)
(unless (factor--listener-process)
(error "No running factor listener. Try M-x run-factor"))
(let* ((def (factor--symbol-at-point))
(let* ((proc (factor--listener-process))
(def (factor--symbol-at-point))
(prompt (format "See%s help on%s: " (if see " short" "")
(if def (format " (%s)" def) "")))
(ask (or (not (eq major-mode 'factor-mode))
@ -757,8 +794,7 @@ buffer."
(cmd (format "\\ %s %s"
(if ask (read-string prompt nil 'factor--help-history def) def)
(if see "see" "help")))
(hb (factor--listener-help-buffer))
(proc (factor--listener-process)))
(hb (factor--listener-help-buffer)))
(comint-redirect-send-command-to-process cmd hb proc nil)
(pop-to-buffer hb)
(beginning-of-buffer hb)))
@ -799,6 +835,13 @@ vocabularies which have been modified on disk."
(define-key m (vector '(control ?c) key) cmd)
(define-key m (vector '(control ?c) `(control ,key)) cmd))))
(defun factor--define-auto-indent-key (key)
(define-key factor-mode-map (vector key)
(lambda (n)
(interactive "p")
(self-insert-command n)
(indent-for-tab-command))))
(factor--define-key ?f 'factor-run-file)
(factor--define-key ?r 'factor-send-region)
(factor--define-key ?d 'factor-send-definition)
@ -807,6 +850,9 @@ vocabularies which have been modified on disk."
(factor--define-key ?z 'switch-to-factor t)
(factor--define-key ?c 'comment-region)
(factor--define-auto-indent-key ?\])
(factor--define-auto-indent-key ?\})
(define-key factor-mode-map "\C-ch" 'factor-help)
(define-key factor-help-mode-map "\C-ch" 'factor-help)
(define-key factor-mode-map "\C-m" 'newline-and-indent)