From 1f61f6dad0bcf1d0ac52a5c7d19d9cf22ec58b2e Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 25 Nov 2008 11:48:11 +0100 Subject: [PATCH 1/5] Emacs factor modes: gensym is not needed. --- misc/factor.el | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/misc/factor.el b/misc/factor.el index 6c9faf50c9..790ff0c56a 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -652,13 +652,12 @@ vocabularies which have been modified on disk." ;;; Key bindings: -(defmacro factor--define-key (key cmd &optional both) - (let ((m (gensym)) - (ms '(factor-mode-map))) - (when both (push 'factor-help-mode-map ms)) - `(dolist (,m (list ,@ms)) - (define-key ,m [(control ?c) ,key] ,cmd) - (define-key ,m [(control ?c) (control ,key)] ,cmd)))) +(defun factor--define-key (key cmd &optional both) + (let ((ms (list factor-mode-map))) + (when both (push factor-help-mode-map ms)) + (dolist (m ms) + (define-key m (vector '(control ?c) key) cmd) + (define-key m (vector '(control ?c) `(control ,key)) cmd)))) (factor--define-key ?f 'factor-run-file) (factor--define-key ?r 'factor-send-region) From a11453e458d5e94e0ef04ff8528baf1dbf4acc79 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 25 Nov 2008 21:53:06 +0100 Subject: [PATCH 2/5] Emacs factor-mode: fix indentation of empty line after starting word definition. --- misc/factor.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/misc/factor.el b/misc/factor.el index 790ff0c56a..346642f70c 100644 --- a/misc/factor.el +++ b/misc/factor.el @@ -160,10 +160,6 @@ buffer." ;;; Factor mode font lock: -(defconst factor--regexp-word-start - (let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M"))) - (format "^\\(%s\\)\\(:\\) " (mapconcat 'identity sws "\\|")))) - (defconst factor--parsing-words '("{" "}" "^:" "^::" ";" "<<" ">" "BIN:" "BV{" "B{" "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CS{" "C{" @@ -222,6 +218,10 @@ buffer." ;;; Factor mode syntax: +(defconst factor--regexp-word-start + (let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M"))) + (format "^\\(%s\\)\\(:\\) " (regexp-opt sws)))) + (defconst factor--font-lock-syntactic-keywords `(("^\\(:\\)\\(:\\)" (1 ".") (2 "(;")) (,factor--regexp-word-start (2 "(;")) @@ -321,7 +321,7 @@ buffer." "PRIVATE>" " Date: Tue, 25 Nov 2008 16:26:17 -0600 Subject: [PATCH 3/5] Clean up --- basis/ui/gadgets/canvas/canvas.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/ui/gadgets/canvas/canvas.factor b/basis/ui/gadgets/canvas/canvas.factor index 4ff7519a85..0028b9b165 100644 --- a/basis/ui/gadgets/canvas/canvas.factor +++ b/basis/ui/gadgets/canvas/canvas.factor @@ -12,8 +12,7 @@ TUPLE: canvas < gadget dlist ; : delete-canvas-dlist ( canvas -- ) [ find-gl-context ] - [ dlist>> [ delete-dlist ] when* ] - [ f >>dlist drop ] tri ; + [ [ [ delete-dlist ] when* f ] change-dlist drop ] bi ; : make-canvas-dlist ( canvas quot -- dlist ) [ drop ] [ GL_COMPILE swap make-dlist ] 2bi From 30f93f547f8e2eaeee912842b3e884f6234d69e1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Nov 2008 16:47:47 -0600 Subject: [PATCH 4/5] generalizations and delegate no longer uses >r/r> --- basis/delegate/delegate.factor | 12 +----- basis/generalizations/generalizations.factor | 42 ++++++++++---------- 2 files changed, 24 insertions(+), 30 deletions(-) diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index 12860337ff..3a7cecb800 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors parser generic kernel classes classes.tuple words slots assocs sequences arrays vectors definitions -prettyprint math hashtables sets macros namespaces make ; +prettyprint math hashtables sets generalizations namespaces make ; IN: delegate : protocol-words ( protocol -- words ) @@ -25,15 +25,7 @@ M: tuple-class group-words : consult-method ( word class quot -- ) [ drop swap first create-method ] - [ - nip - [ - over second saver % - % - dup second restorer % - first , - ] [ ] make - ] 3bi + [ nip [ , dup second , \ ndip , first , ] [ ] make ] 3bi define ; : change-word-prop ( word prop quot -- ) diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 74291bae33..490fa77204 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -1,10 +1,18 @@ ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman, Eduardo ! Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences sequences.private namespaces math -math.ranges combinators macros quotations fry arrays ; +USING: kernel sequences sequences.private math math.ranges +combinators macros quotations fry ; IN: generalizations +<< + +: n*quot ( n seq -- seq' ) concat >quotation ; + +: repeat ( n obj quot -- ) swapd times ; inline + +>> + MACRO: nsequence ( n seq -- quot ) [ [ drop ] [ '[ _ _ new-sequence ] ] 2bi @@ -22,44 +30,38 @@ MACRO: firstn ( n -- ) bi prefix '[ _ cleave ] ] if ; -: npick-wrap ( quot n -- quot ) - dup 1 > - [ swap '[ _ dip swap ] swap 1 - npick-wrap ] - [ drop ] - if ; - -MACRO: npick ( n -- quot ) [ dup ] swap npick-wrap ; +MACRO: npick ( n -- quot ) + 1- [ dup ] [ '[ _ dip swap ] ] repeat ; MACRO: ndup ( n -- ) dup '[ _ npick ] n*quot ; MACRO: nrot ( n -- ) - 1- dup saver swap [ r> swap ] n*quot append ; + 1- [ ] [ '[ _ dip swap ] ] repeat ; MACRO: -nrot ( n -- ) - 1- dup [ swap >r ] n*quot swap restorer append ; + 1- [ ] [ '[ swap _ dip ] ] repeat ; MACRO: ndrop ( n -- ) [ drop ] n*quot ; -: nnip ( n -- ) - swap >r ndrop r> ; inline +MACRO: nnip ( n -- ) + '[ [ _ ndrop ] dip ] ; MACRO: ntuck ( n -- ) - 2 + [ dupd -nrot ] curry ; + 2 + '[ dup _ -nrot ] ; MACRO: nrev ( n -- quot ) 1 [a,b] [ ] [ '[ @ _ -nrot ] ] reduce ; MACRO: ndip ( quot n -- ) - dup saver -rot restorer 3append ; + [ '[ _ dip ] ] times ; MACRO: nslip ( n -- ) - dup saver [ call ] rot restorer 3append ; + '[ [ call ] _ ndip ] ; -MACRO: nkeep ( n -- ) - [ ] [ 1+ ] [ ] tri - '[ [ _ ndup ] dip _ -nrot _ nslip ] ; +MACRO: nkeep ( quot n -- ) + tuck '[ _ ndup _ _ ndip ] ; MACRO: ncurry ( n -- ) [ curry ] n*quot ; @@ -69,5 +71,5 @@ MACRO: nwith ( n -- ) MACRO: napply ( n -- ) 2 [a,b] - [ [ 1- ] keep '[ _ ntuck _ nslip ] ] + [ [ 1- ] [ ] bi '[ _ ntuck _ nslip ] ] map concat >quotation [ call ] append ; From f3f3b3e76966afa8d7e1a9807eddfeab26e04cc3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 25 Nov 2008 16:47:56 -0600 Subject: [PATCH 5/5] Remove some unused words --- basis/macros/macros.factor | 6 ------ 1 file changed, 6 deletions(-) diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 794d523d00..1481e6eea5 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -22,9 +22,3 @@ M: macro definition "macro" word-prop ; M: macro reset-word [ call-next-method ] [ f "macro" set-word-prop ] bi ; - -: n*quot ( n seq -- seq' ) concat >quotation ; - -: saver ( n -- quot ) \ >r >quotation ; - -: restorer ( n -- quot ) \ r> >quotation ;