checkman.txr

@(name file)
@;;
@;; Check syntax block after function
@;;
@(define check-synb ())
.synb
@  (assert bad ln `bad .synb block`)
@  (repeat :gap 0 :mintimes 1)
.mets @(skip)
@    (maybe)
@      (repeat :gap 0 :mintimes 1)
.mets \ \ @(skip)
@      (last :mandatory)

@      (trailer)
.mets @(skip)
@      (end)
@    (end)
@  (last :mandatory)
.syne
@  (end)
@  (assert bad ln `missing .desc`)
.desc
@  (assert bad ln `blank line after .desc`)
@/..*/
@(end)
@;;
@;; Check variable/operator/function/... description headings
@;; introduced by .coNP
@;;
@(define check-coNP ())
@  (cases)
@;   exception
.coNP @/Variables|Special Variables/ @@, s-ifmt @(skip)
@    (or)
@;   exception
.coNP @/Variables|Special Variables/ @@, *0 @(skip)
@    (or)
.coNP @/Variables|Special Variables/@(assert bad ln `bad Variables heading`)@(rep :gap 0) @@, @{x /\S+/}@(last :mandatory) @@ @y and @@ @{z /\S+/}@(end)
@      (assert bad ln `no .desc after variables heading`)
.desc
@    (or)
.coNP @/Variable|Special Variable/@(assert bad ln `bad Variable heading`) @@ @{x /\S+/}
@      (assert bad ln `no .desc after variable heading`)
.desc
@    (or)
@;   exception
.coNP @/Accessors/ @@, caar @(skip)
@    (or)
.coNP @{type /Operator|Macro/}/function @(skip)
@      (assert bad ln `no .synb after @type/function heading`)
@      (check-synb)
@    (or)
.coNP Operator @@ @op and Macro @@ @mac
@      (assert bad ln `no .synb after Operator and macro heading`)
@      (check-synb)
@    (or)
.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure|Pattern Operator|(Operators|Macros)\/Function/}s@(assert bad ln `bad @{type}s heading`)@(rep :gap 0) @@, @{x /\S+/}@(last :mandatory) @@ @y and @@ @{z /\S+/}@(end)
@      (assert bad ln `no .synb after @{type}s heading`)
@      (check-synb)
@    (or)
.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure|Pattern (Operator|Macro)|Parameter List Macro|(Operator|Macro)\/Function/}@(assert bad ln `bad @type heading`) @@ @{x /\S+/}@junk
@      (assert bad ln `extra elements in singular @type heading`)
@      (bind junk "")
@      (assert bad ln `no .synb after @type heading`)
@      (check-synb)
@    (or)
.coNP @/Argument Generation|Passing Options|The Lisp @|Keyword Param|\
        The @ |Keyword Para|Keywords in|Lisp Forms in|Mandatory @|\
        Specifying Variables in|@ catch Clauses|\
        Interaction Between|Vertical-Horizontal|Horizontal-Horizontal|\
        Nested @|@ repeat an|Conventions Used|Struct Clause Macro|\
        Treatment of|Examples of|FFI type|Differences Due to|\
        Unbound Symbols in|Bound symbols in|File-Wide|\
        Delimited Continuations|Symbol Macro/@nil
@    (or)
.coNP @junk
@      (throw bad ln `unrecognized .coNP arguments: @junk`)
@  (end)
@(end)
@;;
@;; check .code, .codn, .cod2, .cod3, .meta and .metn.
@;;
@(define check-code ())
@  (cases)
.@{type /code|meta/} "@(assert bad ln `.@type needs one argument`)@x"@(eol)
@  (or)
.@{type /code|meta/}@(assert bad ln `.@type needs one argument`) @{x /\S+/}@(eol)
@  (or)
.cod3 @(assert bad ln `.cod3 needs three arguments`)@x @y @{z /\S+/}@(eol)
@  (or)
.@{type /codn|cod2|metn/} @(assert bad ln `.@type needs two arguments`)@(cases)"@x"@(or)@{x /\S+/}@(end) @{y /\S+/}@(eol)
@    (assert bad ln `.codn second argument doesn't begin with punctuation`)
@    (require (or (not (memqual type '("codn" "metn")))
                  (equal "s" y)
                  (and (starts-with "s" y)
                       (chr-ispunct [y 1]))
                  (chr-ispunct [y 0])))
@  (end)
@(end)
@;;
@;; Check .mono/.onom pairing
@;;
@(define check-mono ())
.mono
@  (assert bad ln `.mono not closed`)
@  (repeat :gap 0)
@    (none)
.mono
@    (end)
@  (last :mandatory)
.onom
@  (end)
@(end)
@;;
@;; Check .verb/.brev pairing
@;;
@(define check-verb ())
.verb
@  (assert bad ln `.verb not closed`)
@  (repeat :gap 0)
@    (none)
.verb
@    (end)
@  (last :mandatory)
.brev
@  (end)
@(end)
@;;
@;; Check for various dangling
@;; macros.
@;;
@(define check-spurious ())
@  {mac /.(cble|syne)/}@(skip)
@  (throw bad ln `dangling @mac`)
@(end)
@;;
@;; Check for .meti not wrapped in .mono/.onom macros.
@;;
@(define check-meti ())
.meti @(skip)
@  (throw bad ln ".meti not in .mono")
@(end)
@;;
@;; Check for .IP, coIP or .meIP followed by blank line
@;;
@(define check-ip ())
.@{ip /IP|coIP|meIP/}@(skip)

@  (throw bad ln `.@ip followed by blank line`)
@(end)
@;;
@;; Check for .meIP, .meti or .mets containing spurious spaces.
@;;
@(define check-spaces ())
.@{mac /meIP|meti|mets/}@/(( \\)+  )?/@(skip)  @(skip)
@  (throw bad ln `.@mac contains spurious spaces`)
@(end)
@;;
@;; Main
@;;
@(bind errors 0)
@(repeat)
@  (line ln)
@  (try)
@    (cases)
@      (check-coNP)
@    (or)
@      (check-code)
@    (or)
@      (check-verb)
@    (or)
@      (check-mono)
@    (or)
@      (check-synb)
@    (or)
@      (check-spurious)
@    (or)
@      (check-meti)
@    (or)
@      (check-ip)
@    (end)
@  (catch bad (line msg))
@    (do (inc errors)
         (put-line `@file:@line:@msg`))
@  (end)
@(end)
@(next file)
@(repeat)
@  (line ln)
@  (try)
@    (check-spaces)
@  (catch bad (line msg))
@    (do (inc errors)
         (put-line `@file:@line:@msg`))
@  (end)
@(end)
@(do (exit (zerop errors)))