]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/modern/modern.factor
factor: trim some using lists
[factor.git] / extra / modern / modern.factor
index e29eb3b5ddf6a3d081ab4c78ef5c228c1222d722..435aaedd6968f8b0d4daaa4bbd3ededd8c1c74d1 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2016 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators
+USING: accessors arrays assocs combinators combinators.extras
 combinators.short-circuit continuations io.encodings.utf8
 io.files kernel make math math.order modern.paths modern.slices
 sequences sequences.extras sets splitting strings unicode
@@ -115,7 +115,7 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
         { CHAR: \\ CHAR: \" } slice-til-separator-inclusive {
             { f [ to>> over string-expected-got-eof ] }
             { CHAR: \" [ drop ] }
-            { CHAR: \\ [ drop next-char-from drop advance-dquote-payload ] }
+            { CHAR: \\ [ drop take-char drop advance-dquote-payload ] }
         } case
     ] [
         string-expected-got-eof
@@ -124,9 +124,9 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
 :: read-string ( n string tag -- n' string seq )
     n string advance-dquote-payload drop :> n'
     n' string
+    tag
     n n' 1 - string <slice>
-    n' 1 - n' string <slice>
-    tag -rot 3array ;
+    n' 1 - n' string <slice> 3array ;
 
 : take-comment ( n string slice -- n' string comment )
     2over ?nth CHAR: [ = [
@@ -285,7 +285,7 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
         { [ dup section-open? ] [
             [
                 matching-section-delimiter 1array lex-until
-            ] keep swap unclip-last 3array
+            ] keep-1up unclip-last 3array
         ] }
         ! <foo/>
         { [ dup html-self-close? ] [
@@ -320,7 +320,7 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
     } cond ;
 
 : read-acute ( n string slice -- n' string acute )
-    [ matching-section-delimiter 1array lex-until ] keep swap unclip-last 3array ;
+    [ matching-section-delimiter 1array lex-until ] keep-1up unclip-last 3array ;
 
 ! Words like append! and suffix! are allowed for now.
 : read-exclamation ( n string slice -- n' string obj )