gcc/m2/mc/mcComment.mod

   1 (* mcComment.mod provides a module to remember the comments.
   2
   3 Copyright (C) 2015-2021 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  *)
  21
  22 IMPLEMENTATION MODULE mcComment ;   (*!m2pim*)
  23
  24 FROM DynamicStrings IMPORT String, InitString, ConCat, RemoveWhitePrefix, Mark, KillString, InitStringCharStar, EqualCharStar, Length, Slice, string, char ;
  25 FROM Storage IMPORT ALLOCATE ;
  26 FROM nameKey IMPORT Name, keyToCharStar, lengthKey, NulName ;
  27 FROM mcDebug IMPORT assert ;
  28 FROM ASCII IMPORT nl ;
  29 FROM libc IMPORT printf ;
  30
  31
  32 TYPE
  33    commentType = (unknown, procedureHeading, inBody, afterStatement) ;
  34
  35    commentDesc = POINTER TO RECORD
  36                                type    :  commentType ;
  37                                content :  String ;
  38                                procName:  Name ;
  39                                used    :  BOOLEAN ;
  40                             END ;
  41
  42
  43
  44 (*
  45    isProcedureComment - returns TRUE if, cd, is a procedure comment.
  46 *)
  47
  48 PROCEDURE isProcedureComment (cd: commentDesc) : BOOLEAN ;
  49 BEGIN
  50    RETURN (cd # NIL) AND (cd^.type = procedureHeading)
  51 END isProcedureComment;
  52
  53
  54 (*
  55    isBodyComment - returns TRUE if, cd, is a body comment.
  56 *)
  57
  58 PROCEDURE isBodyComment (cd: commentDesc) : BOOLEAN ;
  59 BEGIN
  60    RETURN (cd # NIL) AND (cd^.type = inBody)
  61 END isBodyComment;
  62
  63
  64 (*
  65    isAfterComment - returns TRUE if, cd, is an after comment.
  66 *)
  67
  68 PROCEDURE isAfterComment (cd: commentDesc) : BOOLEAN ;
  69 BEGIN
  70    RETURN (cd # NIL) AND (cd^.type = afterStatement)
  71 END isAfterComment;
  72
  73
  74 (*
  75    initComment - the start of a new comment has been seen by the lexical analyser.
  76                  A new comment block is created and all addText contents are placed
  77                  in this block.  onlySpaces indicates whether we have only seen
  78                  spaces on this line.
  79 *)
  80
  81 PROCEDURE initComment (onlySpaces: BOOLEAN) : commentDesc ;
  82 VAR
  83    cd: commentDesc ;
  84 BEGIN
  85    NEW (cd) ;
  86    assert (cd # NIL) ;
  87    WITH cd^ DO
  88       IF onlySpaces
  89       THEN
  90          type := inBody
  91       ELSE
  92          type := afterStatement
  93       END ;
  94       content := InitString ('') ;
  95       procName := NulName ;
  96       used := FALSE
  97    END ;
  98    RETURN cd
  99 END initComment ;
 100
 101
 102 (*
 103    addText - cs is a C string (null terminated) which contains comment text.
 104              This is appended to the comment, cd.
 105 *)
 106
 107 PROCEDURE addText (cd: commentDesc; cs: ADDRESS) ;
 108 BEGIN
 109    IF cd # NIL
 110    THEN
 111       cd^.content := ConCat (cd^.content, InitStringCharStar (cs))
 112    END
 113 END addText ;
 114
 115
 116 (*
 117    Min - returns the lower of, a, and, b.
 118 *)
 119
 120 PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
 121 BEGIN
 122    IF a < b
 123    THEN
 124       RETURN a
 125    ELSE
 126       RETURN b
 127    END
 128 END Min ;
 129
 130
 131 (*
 132    RemoveNewlines -
 133 *)
 134
 135 PROCEDURE RemoveNewlines (s: String) : String ;
 136 BEGIN
 137    WHILE Length (s) > 0 DO
 138       IF char (s, 0) = nl
 139       THEN
 140          s := RemoveWhitePrefix (Slice (s, 1, 0))
 141       ELSE
 142          RETURN RemoveWhitePrefix (s)
 143       END
 144    END ;
 145    RETURN s
 146 END RemoveNewlines ;
 147
 148
 149 (*
 150    seenProcedure - returns TRUE if the name, procName, appears as the first word
 151                    in the comment.
 152 *)
 153
 154 PROCEDURE seenProcedure (cd: commentDesc; procName: Name) : BOOLEAN ;
 155 VAR
 156    s   : String ;
 157    a   : ADDRESS ;
 158    i, h: CARDINAL ;
 159    res : BOOLEAN ;
 160 BEGIN
 161    a := keyToCharStar (procName) ;
 162    s := RemoveNewlines (cd^.content) ;
 163    s := Slice (Mark (s), 0, Min (Length (s), lengthKey (procName))) ;
 164    res := EqualCharStar (s, a) ;
 165    s := KillString (s) ;
 166    RETURN res
 167 END seenProcedure ;
 168
 169
 170 (*
 171    setProcedureComment - changes the type of comment, cd, to a
 172                          procedure heading comment,
 173                          providing it has the procname as the first word.
 174 *)
 175
 176 PROCEDURE setProcedureComment (cd: commentDesc; procname: Name) ;
 177 BEGIN
 178    IF cd # NIL
 179    THEN
 180       IF seenProcedure (cd, procname)
 181       THEN
 182          cd^.type := procedureHeading ;
 183          cd^.procName := procname
 184       END
 185    END
 186 END setProcedureComment ;
 187
 188
 189 (*
 190    getContent - returns the content of comment, cd.
 191 *)
 192
 193 PROCEDURE getContent (cd: commentDesc) : String ;
 194 BEGIN
 195    IF cd # NIL
 196    THEN
 197       RETURN cd^.content
 198    END ;
 199    RETURN NIL
 200 END getContent ;
 201
 202
 203 (*
 204    getCommentCharStar - returns the C string content of comment, cd.
 205 *)
 206
 207 PROCEDURE getCommentCharStar (cd: commentDesc) : ADDRESS ;
 208 VAR
 209    s: String ;
 210 BEGIN
 211    s := getContent (cd) ;
 212    IF s = NIL
 213    THEN
 214       RETURN NIL
 215    ELSE
 216       RETURN string (s)
 217    END
 218 END getCommentCharStar ;
 219
 220
 221 (*
 222    getProcedureComment - returns the current procedure comment if available.
 223 *)
 224
 225 PROCEDURE getProcedureComment (cd: commentDesc) : String ;
 226 BEGIN
 227    IF (cd^.type = procedureHeading) AND (NOT cd^.used)
 228    THEN
 229       cd^.used := TRUE ;
 230       RETURN cd^.content
 231    END ;
 232    RETURN NIL
 233 END getProcedureComment ;
 234
 235
 236 (*
 237    getAfterStatementComment - returns the current statement after comment if available.
 238 *)
 239
 240 PROCEDURE getAfterStatementComment (cd: commentDesc) : String ;
 241 BEGIN
 242    IF (cd^.type = afterStatement) AND (NOT cd^.used)
 243    THEN
 244       cd^.used := TRUE ;
 245       RETURN cd^.content
 246    END ;
 247    RETURN NIL
 248 END getAfterStatementComment ;
 249
 250
 251 (*
 252    getInbodyStatementComment - returns the current statement after comment if available.
 253 *)
 254
 255 PROCEDURE getInbodyStatementComment (cd: commentDesc) : String ;
 256 BEGIN
 257    IF (cd^.type = inBody) AND (NOT cd^.used)
 258    THEN
 259       cd^.used := TRUE ;
 260       RETURN cd^.content
 261    END ;
 262    RETURN NIL
 263 END getInbodyStatementComment ;
 264
 265
 266 (*
 267    dumpComment -
 268 *)
 269
 270 PROCEDURE dumpComment (cd: commentDesc) ;
 271 BEGIN
 272    printf ("comment : ");
 273    WITH cd^ DO
 274       CASE type OF
 275
 276       unknown         :  printf ("unknown") |
 277       procedureHeading:  printf ("procedureheading") |
 278       inBody          :  printf ("inbody") |
 279       afterStatement  :  printf ("afterstatement")
 280
 281       END ;
 282       IF used
 283       THEN
 284          printf (" used")
 285       ELSE
 286          printf (" unused")
 287       END ;
 288       printf (" contents = %s\n", string (content))
 289    END
 290 END dumpComment ;
 291
 292
 293 END mcComment.