define-xml-error-class ( class superclass slots -- )

Vocabulary

xml.errors

Inputs

class	an object
superclass	an object
slots	an object

Outputs

None

Definition

USING: classes.tuple classes.tuple.private combinators
generalizations kernel math sequences words xml.state ;

IN: xml.errors

: define-xml-error-class ( class superclass slots -- )
    { "line" "column" } prepend error-slots {
        [ define-tuple-class ]
        [ 2drop reset-generic ]
        [ 2drop t "error-class" set-word-prop ]
        [ 2drop t "xml-error-class" set-word-prop ]
        [
            [
                length 1 - nip dupd
                [ [ get-line get-column ] swap ndip boa throw ]
                2curry
            ] [ 2drop all-slots 2 head* thrower-effect ] 3bi
            define-declared
        ]
    } 3cleave ;