path: root/gcc/m2/mc/mcComment.mod

(* mcComment.mod provides a module to remember the comments.

Copyright (C) 2015-2025 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.

This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Modula-2; see the file COPYING3.  If not see
<http://www.gnu.org/licenses/>.  *)

IMPLEMENTATION MODULE mcComment ;   (*!m2pim*)

FROM DynamicStrings IMPORT String, InitString, ConCat, RemoveWhitePrefix, Mark, KillString, InitStringCharStar, EqualCharStar, Length, Slice, string, char ;
FROM Storage IMPORT ALLOCATE ;
FROM nameKey IMPORT Name, keyToCharStar, lengthKey, NulName ;
FROM mcDebug IMPORT assert ;
FROM ASCII IMPORT nl ;
FROM libc IMPORT printf ;


TYPE
   commentType = (unknown, procedureHeading, inBody, afterStatement) ;

   commentDesc = POINTER TO RECORD
                               type    :  commentType ;
			       content :  String ;
			       procName:  Name ;
			       used    :  BOOLEAN ;
                            END ;



(*
   isProcedureComment - returns TRUE if, cd, is a procedure comment.
*)

PROCEDURE isProcedureComment (cd: commentDesc) : BOOLEAN ;
BEGIN
   RETURN (cd # NIL) AND (cd^.type = procedureHeading)
END isProcedureComment;


(*
   isBodyComment - returns TRUE if, cd, is a body comment.
*)

PROCEDURE isBodyComment (cd: commentDesc) : BOOLEAN ;
BEGIN
   RETURN (cd # NIL) AND (cd^.type = inBody)
END isBodyComment;


(*
   isAfterComment - returns TRUE if, cd, is an after comment.
*)

PROCEDURE isAfterComment (cd: commentDesc) : BOOLEAN ;
BEGIN
   RETURN (cd # NIL) AND (cd^.type = afterStatement)
END isAfterComment;


(*
   initComment - the start of a new comment has been seen by the lexical analyser.
                 A new comment block is created and all addText contents are placed
                 in this block.  onlySpaces indicates whether we have only seen
                 spaces on this line.
*)

PROCEDURE initComment (onlySpaces: BOOLEAN) : commentDesc ;
VAR
   cd: commentDesc ;
BEGIN
   NEW (cd) ;
   assert (cd # NIL) ;
   WITH cd^ DO
      IF onlySpaces
      THEN
         type := inBody
      ELSE
         type := afterStatement
      END ;
      content := InitString ('') ;
      procName := NulName ;
      used := FALSE
   END ;
   RETURN cd
END initComment ;


(*
   addText - cs is a C string (null terminated) which contains comment text.
             This is appended to the comment, cd.
*)

PROCEDURE addText (cd: commentDesc; cs: ADDRESS) ;
BEGIN
   IF cd # NIL
   THEN
      cd^.content := ConCat (cd^.content, InitStringCharStar (cs))
   END
END addText ;


(*
   Min - returns the lower of, a, and, b.
*)

PROCEDURE Min (a, b: CARDINAL) : CARDINAL ;
BEGIN
   IF a < b
   THEN
      RETURN a
   ELSE
      RETURN b
   END
END Min ;


(*
   RemoveNewlines -
*)

PROCEDURE RemoveNewlines (s: String) : String ;
BEGIN
   WHILE Length (s) > 0 DO
      IF char (s, 0) = nl
      THEN
         s := RemoveWhitePrefix (Slice (s, 1, 0))
      ELSE
         RETURN RemoveWhitePrefix (s)
      END
   END ;
   RETURN s
END RemoveNewlines ;


(*
   seenProcedure - returns TRUE if the name, procName, appears as the first word
                   in the comment.
*)

PROCEDURE seenProcedure (cd: commentDesc; procName: Name) : BOOLEAN ;
VAR
   s   : String ;
   a   : ADDRESS ;
   i, h: CARDINAL ;
   res : BOOLEAN ;
BEGIN
   a := keyToCharStar (procName) ;
   s := RemoveNewlines (cd^.content) ;
   s := Slice (Mark (s), 0, Min (Length (s), lengthKey (procName))) ;
   res := EqualCharStar (s, a) ;
   s := KillString (s) ;
   RETURN res
END seenProcedure ;


(*
   setProcedureComment - changes the type of comment, cd, to a
                         procedure heading comment,
                         providing it has the procname as the first word.
*)

PROCEDURE setProcedureComment (cd: commentDesc; procname: Name) ;
BEGIN
   IF cd # NIL
   THEN
      IF seenProcedure (cd, procname)
      THEN
         cd^.type := procedureHeading ;
         cd^.procName := procname
      END
   END
END setProcedureComment ;


(*
   getContent - returns the content of comment, cd.
*)

PROCEDURE getContent (cd: commentDesc) : String ;
BEGIN
   IF cd # NIL
   THEN
      RETURN cd^.content
   END ;
   RETURN NIL
END getContent ;


(*
   getCommentCharStar - returns the C string content of comment, cd.
*)

PROCEDURE getCommentCharStar (cd: commentDesc) : ADDRESS ;
VAR
   s: String ;
BEGIN
   s := getContent (cd) ;
   IF s = NIL
   THEN
      RETURN NIL
   ELSE
      RETURN string (s)
   END
END getCommentCharStar ;


(*
   getProcedureComment - returns the current procedure comment if available.
*)

PROCEDURE getProcedureComment (cd: commentDesc) : String ;
BEGIN
   IF (cd^.type = procedureHeading) AND (NOT cd^.used)
   THEN
      cd^.used := TRUE ;
      RETURN cd^.content
   END ;
   RETURN NIL
END getProcedureComment ;


(*
   getAfterStatementComment - returns the current statement after comment if available.
*)

PROCEDURE getAfterStatementComment (cd: commentDesc) : String ;
BEGIN
   IF (cd^.type = afterStatement) AND (NOT cd^.used)
   THEN
      cd^.used := TRUE ;
      RETURN cd^.content
   END ;
   RETURN NIL
END getAfterStatementComment ;


(*
   getInbodyStatementComment - returns the current statement after comment if available.
*)

PROCEDURE getInbodyStatementComment (cd: commentDesc) : String ;
BEGIN
   IF (cd^.type = inBody) AND (NOT cd^.used)
   THEN
      cd^.used := TRUE ;
      RETURN cd^.content
   END ;
   RETURN NIL
END getInbodyStatementComment ;


(*
   dumpComment -
*)

PROCEDURE dumpComment (cd: commentDesc) ;
BEGIN
   printf ("comment : ");
   WITH cd^ DO
      CASE type OF

      unknown         :  printf ("unknown") |
      procedureHeading:  printf ("procedureheading") |
      inBody          :  printf ("inbody") |
      afterStatement  :  printf ("afterstatement")

      END ;
      IF used
      THEN
         printf (" used")
      ELSE
         printf (" unused")
      END ;
      printf (" contents = %s\n", string (content))
   END
END dumpComment ;


END mcComment.