]> gitweb.factorcode.org Git - factor.git/commitdiff
Merge remote-tracking branch 'origin/html5-force-push'
authorDoug Coleman <doug.coleman@gmail.com>
Sun, 19 Jun 2022 16:10:07 +0000 (11:10 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Sun, 19 Jun 2022 16:10:07 +0000 (11:10 -0500)
1  2 
extra/modern/html/html.factor
extra/modern/slices/slices.factor
extra/sequences/extras/extras.factor

index d5d33ed20be8e28f37eed61bc99cedc9cc7e1ed9,c28b05321aec64814e81d2a0e77b335c03d2bcfb..4082e930cdc98ca7318f96faf12c0d1217281b12
@@@ -2,7 -2,7 +2,7 @@@
  ! See http://factorcode.org/license.txt for BSD license.
  USING: accessors arrays assocs combinators
  combinators.short-circuit kernel make math modern modern.slices
 -sequences sequences.extras shuffle shuffle.extras splitting
 +sequences sequences.extras shuffle combinators.extras splitting
  strings unicode ;
  IN: modern.html
  
@@@ -70,7 -70,7 +70,7 @@@ C: <dquote> dquot
          { CHAR: \\ CHAR: ' } slice-til-separator-inclusive {
              { f [ to>> over string-expected-got-eof ] }
              { CHAR: ' [ drop ] }
 -            { CHAR: \\ [ drop next-char-from drop advance-squote-payload ] }
 +            { CHAR: \\ [ drop take-char drop advance-squote-payload ] }
          } case
      ] [
          string-expected-got-eof
@@@ -87,7 -87,7 +87,7 @@@
      [ "\s\r\n/>" member? ] slice-until ;
  
  : read-value ( n string -- n' string value )
 -    skip-whitespace next-char-from {
 +    skip-whitespace take-char {
          { CHAR: ' [ CHAR: ' read-string >string <squote> ] }
          { CHAR: " [ CHAR: " read-string >string <dquote> ] }
          { CHAR: [ [ "[" throw ] }
      ">" expect-and-span
      <close-tag> ;
  
- :: shorten* ( vector n -- seq )
-     vector n tail
-     n vector shorten ;
  : unclosed-open-tag? ( obj -- ? )
      { [ open-tag? ] [ close-tag>> not ] } 1&& ; inline
  
index a7d0c0a9379e8ebdaa999864762d8d7d68f00b8f,6a9f6793c6f94934e444fce53cf04dc3c5c4474f..54b90c8472aacfd35d3245b45b8c7b9eb13fa337
@@@ -1,7 -1,8 +1,8 @@@
  ! Copyright (C) 2016 Doug Coleman.
  ! See http://factorcode.org/license.txt for BSD license.
- USING: accessors assocs kernel math sequences sequences.deep
- sequences.extras combinators.extras strings unicode ;
 -USING: accessors assocs fry kernel locals math sequences
++USING: accessors assocs combinators.extras kernel math sequences
+ sequences.deep sequences.extras sequences.private strings
+ unicode ;
  IN: modern.slices
  
  : >strings ( seq -- str )
@@@ -43,14 -44,29 +44,14 @@@ ERROR: unexpected-end n string 
      over [ [ 1 - ] dip ?nth ] [ 2drop f ] if ;
  
  ! Allow eof
 -: next-char-from ( n/f string -- n'/f string ch/f )
 +: take-char ( n/f string -- n'/f string ch/f )
      over [
          2dup ?nth [ [ 1 + ] 2dip ] [ f ] if*
      ] [
 -        [ 2drop f ] [ nip ] 2bi f
 +        f
      ] if ;
  
 -: prev-char-from-slice-end ( slice -- ch/f )
 -    [ to>> 2 - ] [ seq>> ] bi ?nth ;
 -
 -: prev-char-from-slice ( slice -- ch/f )
 -    [ from>> 1 - ] [ seq>> ] bi ?nth ;
 -
 -: next-char-from-slice ( slice -- ch/f )
 -    [ to>> ] [ seq>> ] bi ?nth ;
 -
 -: char-before-slice ( slice -- ch/f )
 -    [ from>> 1 - ] [ seq>> ] bi ?nth ;
 -
 -: char-after-slice ( slice -- ch/f )
 -    [ to>> ] [ seq>> ] bi ?nth ;
 -
 -: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ? )
 +: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i/f elt ? )
      [ find-from ] keepd
      pick [ drop t ] [ length -rot nip f ] if ; inline
  
@@@ -78,10 -94,12 +79,10 @@@ ERROR: expected-sequence-error expecte
      2dup [ >lower ] bi@ sequence= [ nip ] [ expected-sequence-error ] if ;
  
  : expect-and-span ( n string slice expected-string -- n' string slice' )
 -    dup length '[ _ take-slice ] 2dip
 -    rot check-sequence span-slices ;
 +    dup length '[ _ take-slice ] 2dip-1up check-sequence span-slices ;
  
  : expect-and-span-insensitive ( n string slice expected-string -- n' string slice' )
 -    dup length '[ _ take-slice ] 2dip
 -    rot check-sequence-insensitive span-slices ;
 +    dup length '[ _ take-slice ] 2dip-1up check-sequence-insensitive span-slices ;
  
  :: split-slice-back ( slice n -- slice1 slice2 )
      slice [ from>> ] [ to>> ] [ seq>> ] tri :> ( from to seq )
  : empty-slice-end ( seq -- slice )
      [ length dup ] [ ] bi <slice> ; inline
  
 -: empty-slice-from ( n seq -- slice )
 -    dupd <slice> ; inline
 -
  :: slice-til-eol ( n string -- n' string slice/f ch/f )
      n [
          n string '[ "\r\n" member? ] find-from :> ( n' ch )
          n string string empty-slice-end f
      ] if ; inline
  
 -:: merge-slice-til-eol-slash'' ( n string -- n' string slice/f ch/f )
 -    n [
 -        n string '[ "\r\n\\" member? ] find-from :> ( n' ch )
 -        n' string
 -        n n' string ?<slice>
 -        ch
 -    ] [
 -        n string string empty-slice-end f
 -    ] if ; inline
 -
 -: merge-slice-til-whitespace ( n string slice --  n' string slice' )
 +: merge-slice-til-whitespace ( n/f string slice --  n'/f string slice' )
      pick [
          [ slice-til-whitespace drop ] dip merge-slices
      ] when ;
  
 -: merge-slice-til-eol ( n string slice --  n' string slice' )
 -    [ slice-til-eol drop ] dip merge-slices ;
 -
  : slice-between ( slice1 slice2 -- slice )
      ! ensure-same-underlying
      slice-order-by-from
  : slice-before ( slice -- slice' )
      [ drop 0 ] [ from>> ] [ seq>> ] tri <slice> ;
  
 -: (?nth) ( n/f string/f -- obj/f )
 -    over [ (?nth) ] [ 2drop f ] if ;
 -
 -:: merge-slice-til-eol-slash' ( n string slice -- n' string slice/f ch/f )
 -    n string merge-slice-til-eol-slash'' :> ( n' string' slice' ch' )
 -    ch' CHAR: \\ = [
 -        n' 1 + string' (?nth) "\r\n" member? [
 -            n' 2 + string' slice slice' span-slices merge-slice-til-eol-slash'
 -        ] [
 -            "omg" throw
 -        ] if
 -    ] [
 -        n' string' slice slice' span-slices ch'
 -    ] if ;
 -
 -! Supports \ at eol (with no space after it)
 -: slice-til-eol-slash ( n string -- n' string slice/f ch/f )
 -    2dup empty-slice-from merge-slice-til-eol-slash' ;
 -
  :: slice-til-separator-inclusive ( n string tokens -- n' string slice/f ch/f )
      n string '[ tokens member? ] find-from [ dup [ 1 + ] when ] dip  :> ( n' ch )
      n' string
@@@ -183,7 -236,7 +184,7 @@@ ERROR: subseq-expected-but-got-eof n st
  :: slice-til-string ( n string search --  n' string payload end-string )
      search string n subseq-start-from :> n'
      n' [ n string search subseq-expected-but-got-eof ] unless
-     n' search length +  string
+     n' search length + string
      n n' string ?<slice>
      n' dup search length + string ?<slice> ;
  
      '[ from>> _ + ] [ to>> ] [ seq>> ] tri <slice> ;
  
  : modify-to ( slice n -- slice' )
 -    [ [ from>> ] [ to>> ] [ seq>> ] tri ] dip
 -    swap [ + ] dip <slice> ;
 +    [ from>> ] swap '[ to>> _ + ] [ seq>> ] tri <slice> ; inline
  
  ! { CHAR: \] [ read-closing ] }
  ! { CHAR: \} [ read-closing ] }
  ! { CHAR: \) [ read-closing ] }
 -: read-closing ( n string tok -- n string tok )
 +: read-closing ( n string tok -- n' string tok )
      dup length 1 = [
 -        -1 modify-to [ 1 - ] 2dip
 +        -1 modify-to
 +        [ 1 - ] 2dip
      ] unless ;
  
  : rewind-slice ( n string slice -- n' string )
-     2nip [ from>> ] [ seq>> ] bi ; inline
+     2nip [ from>> ] [ seq>> ] bi ; inline
+ :: take-from? ( n seq subseq -- n'/f seq  ? )
+     subseq seq n pick length (subseq-start-from) 2nip [
+         n subseq length +
+         seq
+         t
+     ] [
+         n seq f
+     ] if ;
+ : check-slice? ( from to seq -- from to seq ? )
+     pick 0 < [
+         f
+     ] [
+         2dup length > [
+             f
+         ] [
+             t
+         ] if
+     ] if ; inline
+ :: take-from-insensitive? ( n seq str -- n'/f seq ? )
+     n str length over + seq check-slice? [
+         subseq str [ >lower ] bi@ sequence= [
+             n str length + seq t
+         ] [
+             n seq f
+         ] if
+     ] [
+         3drop n seq f
+     ] if ;
index b9443bca8d20b69c797079e2a3c6e190754d5a08,e6de86632110001a4f62ec74dc23dce210de2d9b..07dbaf4273b85460a98cd6c9ff5c5fe1b190dde0
@@@ -688,6 -688,10 +688,10 @@@ PRIVATE
      [ not ] compose [ find-last drop ] keepd
      length swap [ - 1 - ] when* ; inline
  
+ :: shorten* ( vector n -- seq )
+     vector n tail
+     n vector shorten ;
  :: interleaved-as ( seq glue exemplar -- newseq )
      seq length dup 1 - + 0 max exemplar new-sequence :> newseq
      seq [ 2 * newseq set-nth-unsafe ] each-index
  : find-pred-loop ( ... i n seq quot: ( ... elt -- ... calc ? ) -- ... calc/f i/f elt/f )
      2pick < [
          [ nipd call ] 4keep
 -        7 nrot 7 nrot 7 nrot
 +        3 7 nrotates
          [ [ 3drop ] 2dip rot ]
          [ 2drop [ 1 + ] 3dip find-pred-loop ] if
      ] [