$EXTRN OPEN, GET;
$EXTRN PROUT;
$EXTRN IMPLODE;
$EXTRN BR, CP, DG;
$EXTRN DI5;

$ENTRY Go {
     = <Open 'r' 1 <Arg 1>>
       <Prout <DI5 (<DTD_REF <A <Get 1>>>) >>;
          }

A   {
    e.1 0 e.2 = e.1 e.2;
    e1 = e1 <A <Get 1>>;
    }

$ENTRY DTD_REF {
   e.1 = <Obr <Ubkomm <Spar <Ubpr e.1>>>>;
               }

$ENTRY DTD_REF1 {
   (e.1) = <Open 'r' 1 e.1>
           <DTD_REF <A <Get 1>>>;
                } 

*  Парсер DTD в рефал-выражение, в тот вид,
*  который был в интерпретаторе
*  регулjaрных выражений (см. пособие по суперкомпилjaтору).

/*  Например, следующее DTD 

<!ELEMENT apply (
   (minus, (cn | ci | apply)
 | ( (minus | divide | power), (cn | ci | apply), (cn | ci | apply))
 | ( (plus | times), (cn | ci | apply)*)
                )>

будет преобразовано в 

(Apply (ALT (CAT
   (ALT
        (CAT Minus (ALT Cn Ci Apply))
        (CAT (ALT Minus Divide Power) 
             (ALT Cn Ci Apply)
             (ALT Cn Ci Apply) )
        (CAT (ALT Plus Times)
             (ITER (ALT Cn Ci Apply)) )
   )
)))

*/

* -----------------------------------
* Внимание. В этом варианте не обрабатываютсja
*           элементы  ATTLIST.

Obr {
  = <ElEnd >;
 ('!ENTITY' e.1 '%' e.2) e.3 = <Entity e.2> <Obr e.3>;
 ('!ELEMENT' e.1) e.3 = <Element e.1> <Obr e.3>;
    }

Element {
   ' ' e.1 = <Element e.1>;
   e.1     = <Element1 ( ) e.1>;
        }

Element1 {
   (e.a) ' ' e.2 = ( <ElPlus <IMPLODE e.a>>
                     (ALT (CAT <Obr1 <Prob e.2>>)) );
   (e.a) s.b e.2 = <Element1 (e.a s.b) e.2>;
   (e.a) (e.1) e.2 = ( <ElPlus <IMPLODE e.a>>
                     (ALT (CAT <Obr1 <Prob (e.1) e.2>>)) );
         }

Obr1 {
   ' ' e.1     = <Obr1 e.1>;
   e.1 ' '     = <Obr1 e.1>;
   e.1 '|' e.2 = (ALT <Obr1 e.1> <Obr1 e.2> );
   e.1 ',' e.2 = (CAT <Obr1 e.1> <Obr1 e.2> );
   e.1 '*'     = (ITER <Obr1 e.1> );
   e.1 '+'     = (ALT (CAT <Obr1 e.1>) (ITER <Obr1 e.1> ));
   e.1 '?'     = (ALT (CAT ) (CAT <Obr1 e.1> ));
*   e.1 ',' e.2 = (CAT <Obr1 e.1> <Obr1 e.2> );
   (e.1)       = <Obr1 e.1>;
               = (CAT );
   'empty'     = (CAT );
   'EMPTY'     = (CAT );
   '#PCDATA'   = PCDATA ;
*  e.1         = (CAT <ElProv <IMPLODE e.1>> ); 
   '%' e.1 ';' = <Obr1 <CP e.1>>;
   e.1         = <ElProv <IMPLODE e.1>>;     
}

Entity {
   e.1 '"' e.2 '"' = <BR <Prob e.1> '=' e.2>;
       }

Prob {
  ' ' e.1 = <Prob e.1>;
  e.1 ' ' = <Prob e.1>;
  e.1     = e.1;
    }

*  Замены  < , >   на  ( , )
Ubpr {
       '<' e.1 = '(' <Ubpr e.1>;
       '>' e.1 = ')' <Ubpr e.1>;
       s.a e.1 = s.a <Ubpr e.1>;
               = ;
     }

*  Спаривание скобок.
Spar   { e.1 = <Spar1 ('*') e.1>; }
Spar1  {
    (e.1)       '('e.3  = <Spar1 ((e.1))     e.3>;
    ((e.1) e.2) ')' e.3 = <Spar1 (e.1 (e.2)) e.3>;
    ('*' e.1)   ')' e.3 = 'error' e.1 ')' e.3;
    (e.1)       s.A e.3 = <Spar1 (e.1 s.A)   e.3>;
    ('*' e.1)           = e.1;
    ((e.1) e.2)         = 'error' e.1 '(' e.2;
       }

* Убирание комментариев и пролога.
* Пропуск  ATTLIST.
Ubkomm {
     ('?' e.a '?')    e.1 = <Ubkomm e.1>;
     ('!--' e.a '--') e.1 = <Ubkomm e.1>;
     ('!ATTLIST' e.a) e.1 = <Ubkomm e.1>;
     (e.a) e.1            = (e.a) <Ubkomm e.1>;
* ???                       s.a
     s.a e.1              = <Ubkomm e.1>;
                          = ;
       }

* Проверки полноты списков тэгов в DTD

ElPlus {
  s.a = s.a <ElPlus1 s.a <DG 'SPISOK__'>>;
       }

ElPlus1 {
  s.a = <ElPlus1 s.a ( ) ( )>;
  s.a (e.1 s.a e.2) (e.3) = <PROUT 'REPEAT NAME ' s.a>
                            <BR 'SPISOK__=' (e.1 s.a e.2) (e.3)>;
  s.a (e.1) (e.3 s.a e.4) = <BR 'SPISOK__=' (e.1 s.a) (e.3 e.4)>;
  s.a (e.1) (e.3) = <BR 'SPISOK__=' (e.1 s.a) (e.3)>;
        }

ElProv {
  s.a = s.a <ElProv1 s.a <DG 'SPISOK__'>>;
       }

ElProv1 {
  s.a = <ElProv1 s.a ( ) ( )>;
  s.a (e.1 s.a e.2) (e.3) = <BR 'SPISOK__=' (e.1 s.a e.2) (e.3)>;
  s.a (e.1) (e.3 s.a e.4) = <BR 'SPISOK__=' (e.1) (e.3 s.a e.4)>;
  s.a (e.1) (e.3) = <BR 'SPISOK__=' (e.1) (e.3 s.a)>;
        }

ElEnd {
   = <ElEnd1 <DG 'SPISOK__'>>;
      }

ElEnd1 {
   (e.1) ( ) = ;
   (e.1) (e.2) = <PROUT 'NO NAME TAG ' e.2>;
       }