Merge branch 'master' of git://factorcode.org/git/factor

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 -- )

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' ) <repetition> concat >quotation ;
+
+: repeat ( n obj quot -- ) swapd times ; inline
+
+>>
+
 MACRO: nsequence ( n seq -- quot )
     [
         [ drop <reversed> ] [ '[ _ _ 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 ;

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' ) <repetition> concat >quotation ;
-
-: saver ( n -- quot ) \ >r <repetition> >quotation ;
-
-: restorer ( n -- quot ) \ r> <repetition> >quotation ;

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

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
   '("{" "}" "^:" "^::" ";" "<<" "<PRIVATE" ">>"
     "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>" "<PRIVATE" "SYMBOL:" "USE:"))))
 
 (defsubst factor--at-begin-of-def ()
-  (looking-at "\\([^ ]\\|^\\)+:"))
+  (looking-at factor--regexp-word-start))
 
 (defsubst factor--looking-at-emptiness ()
   (looking-at "^[ \t]*$"))
@@ -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)
@@ -671,7 +670,6 @@ vocabularies which have been modified on disk."
 (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)
-(define-key factor-mode-map [tab] 'indent-for-tab-command)
 
 (define-key factor-listener-mode-map [f8] 'factor-refresh-all)