read-double-matched ( open-ch -- quot: ( n string tag ch -- n' string seq ) )

Vocabulary

modern

Inputs

open-ch

an object

Outputs

quot	a quotation with stack effect ( n string tag ch -- n' string seq )

Definition

USING: arrays combinators kernel math modern.slices sequences
strings ;

IN: modern

MACRO:: read-double-matched
    ( open-ch -- quot: ( n string tag ch -- n' string seq ) )
    open-ch dup matching-delimiter {
        [ drop 2 swap <string> ]
        [ drop 1string ]
        [ nip 2 swap <string> ]
    } 2cleave :> ( openstr2 openstr1 closestr2 ) [| n string
    tag! ch |
        ch {
            {
                61
                [
                    tag 1 cut-slice* drop
                    tag! n string openstr1
                    slice-til-separator-inclusive
                    [ -1 modify-from ] dip
                    :> ( n' string' opening ch ) ch open-ch = [
                        tag openstr2 n string ch
                        long-opening-mismatch
                    ] unless
                    opening matching-delimiter-string :> needle
                    n' string' needle slice-til-string
                    :> ( n'' string'' payload closing ) n''
                    string tag opening payload closing 4array
                ]
            }
            {
                open-ch
                [
                    tag 1 cut-slice* swap tag! 1 modify-to
                    :> opening n 1 +
                    string closestr2 slice-til-string
                    :> ( n' string' payload closing ) n' string
                    tag opening payload closing 4array
                ]
            }
            [
                [ tag openstr2 n string ] dip
                long-opening-mismatch
            ]
        } case
    ] ;