gap-buffer: some cleanup.

extra/gap-buffer/gap-buffer.factor

@@ -4,8 +4,8 @@
 ! gap buffer -- largely influenced by Strandh and Villeneuve's Flexichain
 ! for a good introduction see:
 ! https://common-lisp.net/project/flexichain/download/StrandhVilleneuveMoore.pdf
-USING: accessors arrays circular fry kernel math math.functions
+USING: accessors arrays circular fry kernel locals math
-math.order multiline sequences sequences.private ;
+math.functions math.order multiline sequences sequences.private ;
 IN: gap-buffer
 
 ! gap-start     -- the first element of the gap
@@ -24,30 +24,29 @@ TUPLE: gb
     [ expand-factor>> * ceiling >fixnum ]
     [ min-size>> ] bi max ;
 
-: <gb> ( seq -- gb )
+:: <gb> ( seq -- gb )
     gb new
         5 >>min-size
         1.5 >>expand-factor
-        swap
+        seq length >>gap-start
-        [ length >>gap-start ] keep
+        seq length over required-space >>gap-end
-        [ length over required-space >>gap-end ] keep
+        dup gap-end>> seq { } like resize-array <circular> >>seq ;
-        over gap-end>> swap { } like resize-array <circular> >>seq ;
 
 M: gb like ( seq gb -- seq ) drop <gb> ;
 
-: gap-length ( gb -- n ) [ gap-end>> ] keep gap-start>> - ;
+: gap-length ( gb -- n )
+    [ gap-end>> ] [ gap-start>> ] bi - ;
 
 : buffer-length ( gb -- n ) seq>> length ;
 
-M: gb length ( gb -- n ) [ buffer-length ] keep gap-length - ;
+M: gb length ( gb -- n )
+    [ buffer-length ] [ gap-length ] bi - ;
 
 : valid-position? ( pos gb -- ? )
-    ! one element past the end of the buffer is a valid position when we're inserting
+    ! one element past the end of the buffer is a valid position
+    ! when we're inserting
     length -1 swap between? ;
 
-: valid-index? ( i gb -- ? )
-    buffer-length -1 swap between? ;
-
 ERROR: position-out-of-bounds position gap-buffer ;
 
 : position>index ( pos gb -- i )
@@ -59,8 +58,10 @@ ERROR: position-out-of-bounds position gap-buffer ;
         position-out-of-bounds
     ] if ;
 
-TUPLE: index-out-of-bounds index gap-buffer ;
+: valid-index? ( i gb -- ? )
-C: <index-out-of-bounds> index-out-of-bounds
+    buffer-length -1 swap between? ;
+
+ERROR: index-out-of-bounds index gap-buffer ;
 
 : index>position ( i gb -- pos )
     2dup valid-index? [
@@ -68,18 +69,10 @@ C: <index-out-of-bounds> index-out-of-bounds
             gap-length -
         ] [ drop ] if
     ] [
-        <index-out-of-bounds> throw
+        index-out-of-bounds
     ] if ;
 
 M: gb virtual@ ( n gb -- n seq ) [ position>index ] keep seq>> ;
-    
-M: gb nth ( n gb -- elt ) bounds-check virtual@ nth-unsafe ;
-
-M: gb nth-unsafe ( n gb -- elt ) virtual@ nth-unsafe ;
-
-M: gb set-nth ( elt n seq -- ) bounds-check virtual@ set-nth-unsafe ;
-
-M: gb set-nth-unsafe ( elt n seq -- ) virtual@ set-nth-unsafe ;
 
 M: gb virtual-exemplar seq>> ;
 
@@ -108,13 +101,14 @@ INSTANCE: gb virtual-sequence
         [ over - ] dip swap copy-elements-back
     ] if ;
 
-! the gap can be moved either forward or back. Moving the gap 'inside' means
+! the gap can be moved either forward or back. Moving the gap
-! moving elements across the gap. Moving the gap 'around' means changing the
+! 'inside' means moving elements across the gap. Moving the gap
-! start of the circular buffer to avoid moving as many elements.
+! 'around' means changing the start of the circular buffer to
+! avoid moving as many elements.
 
-! We decide which method (inside or around) to pick based on the number of
+! We decide which method (inside or around) to pick based on the
-! elements that will need to be moved. We always try to move as few elements as
+! number of elements that will need to be moved. We always try
-! possible.
+! to move as few elements as possible.
 
 : move-gap? ( i gb -- i gb ? ) 2dup gap-end>> = not ;
 
@@ -122,17 +116,21 @@ INSTANCE: gb virtual-sequence
 
 : move-gap-back-inside? ( i gb -- i gb ? )
     ! is it cheaper to move the gap inside than around?
-    2dup [ gap-start>> swap 2 * - ] keep [ buffer-length ] keep gap-end>> - <= ;
+    2dup [ gap-start>> swap 2 * - ] keep
+    [ buffer-length ] keep gap-end>> - <= ;
 
 : move-gap-forward-inside? ( i gb -- i gb ? )
     ! is it cheaper to move the gap inside than around?
-    2dup [ gap-end>> [ 2 * ] dip - ] keep [ gap-start>> ] keep buffer-length + <= ;
+    2dup [ gap-end>> [ 2 * ] dip - ] keep
+    [ gap-start>> ] keep buffer-length + <= ;
 
 : move-gap-forward-inside ( i gb -- )
-    [ dup gap-length neg swap gap-end>> rot ] keep seq>> copy-elements ;
+    [ dup gap-length neg swap gap-end>> rot ] keep
+    seq>> copy-elements ;
 
 : move-gap-back-inside ( i gb -- )
-    [ dup gap-length swap gap-start>> 1 - rot 1 - ] keep seq>> copy-elements ;
+    [ dup gap-length swap gap-start>> 1 - rot 1 - ] keep
+    seq>> copy-elements ;
 
 : move-gap-forward-around ( i gb -- )
     0 over move-gap-back-inside [
@@ -176,10 +174,10 @@ INSTANCE: gb virtual-sequence
 : fix-gap ( n gb -- )
     2dup [ gap-length + ] keep gap-end<< gap-start<< ;
 
-! moving the gap to position 5 means that the element in position 5 will be immediately after the gap
+! moving the gap to position 5 means that the element in
-GENERIC: move-gap ( n gb -- )
+! position 5 will be immediately after the gap
-
+: move-gap ( n gb -- )
-M: gb move-gap ( n gb -- ) 2dup [ position>index ] keep (move-gap) fix-gap ;
+    2dup [ position>index ] keep (move-gap) fix-gap ;
 
 ! ------------ resizing -------------------------------------
 
@@ -198,12 +196,14 @@ M: gb move-gap ( n gb -- ) 2dup [ position>index ] keep (move-gap) fix-gap ;
     dup gap-start>> head ;
 
 : copy-after-gap ( array gb -- )
-    ! copy everything after the gap in 'gb' into the end of 'array',
+    ! copy everything after the gap in 'gb' into the end of
-    ! and change 'gb's gap-end to reflect the gap-end in 'array'
+    ! 'array', and change 'gb's gap-end to reflect the gap-end
+    ! in 'array'
     dup after-gap [ 2dup set-new-gap-end gap-end>> swap ] dip -rot copy ;
 
 : copy-before-gap ( array gb -- )
-    ! copy everything before the gap in 'gb' into the start of 'array'
+    ! copy everything before the gap in 'gb' into the start of
+    ! 'array'
     before-gap 0 rot copy ; ! gap start doesn't change
 
 : resize-buffer ( gb new-size -- )
@@ -224,21 +224,17 @@ M: gb move-gap ( n gb -- ) 2dup [ position>index ] keep (move-gap) fix-gap ;
     ] [ drop f ] if ;
 
 : ?decrease ( gb -- )
-    dup gb-too-big? [
+    dup gb-too-big? [ decrease-buffer-size ] [ drop ] if ;
-        decrease-buffer-size
-    ] [ drop ] if ;
 
 : ensure-room ( n gb -- )
     ! ensure that ther will be enough room for 'n' more elements
-    2dup enough-room? [ 2drop ] [
+    2dup enough-room? [ 2drop ] [ increase-buffer-size ] if ;
-        increase-buffer-size
-    ] if ;
 
 ! ------- editing operations ---------------
 
-GENERIC#: insert* 2 ( seq position gb -- )
+GENERIC#: insert* 2 ( seq pos gb -- )
 
-: prepare-insert ( seq position gb -- seq gb )
+: prepare-insert ( seq pos gb -- seq gb )
     tuck move-gap over length over ensure-room ;
 
 : insert-elements ( seq gb -- )
@@ -247,20 +243,14 @@ GENERIC#: insert* 2 ( seq position gb -- )
 : increment-gap-start ( gb n -- )
     over gap-start>> + swap gap-start<< ;
 
-! generic dispatch identifies numbers as sequences before numbers...
+M: number insert*
-M: number insert* ( elem position gb -- ) [ 1array ] 2dip insert* ;
+    [ 1array ] 2dip insert* ;
-! : number-insert ( num position gb -- ) [ 1array ] 2dip insert* ;
 
-M: sequence insert* ( seq position gb -- )
+M: sequence insert*
     prepare-insert [ insert-elements ] 2keep swap length increment-gap-start ;
 
-: (delete*) ( gb -- )
+: delete* ( pos gb -- )
-    dup gap-end>> 1 + over gap-end<< ?decrease ;
+    tuck move-gap dup gap-end>> 1 + over gap-end<< ?decrease ;
-
-GENERIC: delete* ( pos gb -- )
-
-M: gb delete* ( position gb -- )
-    tuck move-gap (delete*) ;
 
 ! -------- stack/queue operations -----------
 
@@ -268,7 +258,7 @@ M: gb delete* ( position gb -- )
 
 : push-end ( obj gb -- ) [ length ] keep insert* ;
 
-: pop-elem ( position gb -- elem ) [ nth ] 2keep delete* ;
+: pop-elem ( pos gb -- elem ) [ nth ] 2keep delete* ;
 
 : pop-start ( gb -- elem ) 0 swap pop-elem ;