Tag	< >	between	NO
unknown		everything	NO
white	\t \n \r	ignore	NO
%%

<define START
 <read Tag <call ParseTag 0> <goto START>>
 <read unknown <goto START>>
 <read "" <call Finish>>
>

%%
my @Keys = ();

sub GetValue     { $_[0] =~ /\([^\\]* \. \"([^\\]*)\"\)/; return $1; }
sub GetFirstWord { $_[0] =~ /([^ ]+)/; return $1; }

sub ParseTag {
    $Tag = $_[0];
    $Tag = GetValue($Tag);
    $Tag = substr($Tag,1,length($Tag)-2); # Clear < >
    $Value = GetFirstWord($Tag);
    if (substr($Value,0,1) eq '/') {      # /tag
       $Stack = pop (@Keys);
       if($Stack eq substr($Value,1,length($Value))) {
         print "Tag: ",$Stack," found. \t\t[ OK ]\n";
       }else{
         print "Tag: ",$Stack," error. \t\t[ BAD ]\n";
         exit;
       }
    }else{
       push (@Keys,$Value);               # tag
    }
    return "";
}

sub Finish {
   if(@Keys == 0) {
     print "Nice HTML Code ;o)\n";
   }else{
     print "Error not closed Tag: ",@Keys,"\n";
   }
   return "";
}
%%
(define Keys '())

(define GetValue
  (lambda (n)
     (cdr n)))

(define GetFirstWord
  (lambda (w)
     (letrec ((helper
                (lambda (n)
                   (cond ((= n (string-length w)) w)
                         ((eq? #\space (string-ref w n)) (substring w 0 n ))
                         (else (helper (+ n 1)))))))
     (helper 0))))
     
(define ParseTag
  (lambda (paramlist)
    (let ((w (GetValue (car paramlist))))
      (set! w (substring w 1 (- (string-length w) 1)))
      (set! w (GetFirstWord w))
      (if (eq? #\/ (string-ref w 0))
        (begin
         (let ((stack (car Keys)))
           (set! Keys (cdr Keys))
           (if (string=? stack (substring w 1 (string-length w)))
              (begin
                (display "Tag: ")
                (display stack)
                (display " found. [ OK ]")
                (newline)
              )
              (begin
                (display "Tag: ")
                (display stack)
                (display " missing. [ BAD ]")
                (newline)
                (error 'Parse "missing Close Tag")
              ))
        ))
         (set! Keys (cons w Keys))
      )
      ""
)))

(define Finish
  (lambda (paramlist)
    (if (null? Keys)
      (begin
        (display "Nice HTML Code ;o)")
        (newline)
      )
      (begin
        (display "Error not closed Tag: ")
        (display (car Keys))
        (newline)))
  ""
))

%%
1
