gcc/m2/mc/wlists.mod

   1 (* wlists.mod word lists module.
   2
   3 Copyright (C) 2015-2022 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius@glam.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 wlists ;
  23
  24
  25 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  26
  27 CONST
  28    maxNoOfElements = 5 ;
  29
  30 TYPE
  31    wlist = POINTER TO RECORD
  32               noOfElements: CARDINAL ;
  33               elements    : ARRAY [1..maxNoOfElements] OF WORD ;
  34               next        : wlist ;
  35            END ;
  36
  37
  38 (*
  39    initList - creates a new wlist, l.
  40 *)
  41
  42 PROCEDURE initList () : wlist ;
  43 VAR
  44    l: wlist ;
  45 BEGIN
  46    NEW (l) ;
  47    WITH l^ DO
  48       noOfElements := 0 ;
  49       next := NIL
  50    END ;
  51    RETURN l
  52 END initList ;
  53
  54
  55 (*
  56    killList - deletes the complete wlist, l.
  57 *)
  58
  59 PROCEDURE killList (VAR l: wlist) ;
  60 BEGIN
  61    IF l#NIL
  62    THEN
  63       IF l^.next#NIL
  64       THEN
  65          killList (l^.next)
  66       END ;
  67       DISPOSE (l)
  68    END
  69 END killList ;
  70
  71
  72 (*
  73    replaceItemInList - replace the nth WORD in wlist, l.
  74                        The first item in a wlists is at index, 1.
  75                        If the index, n, is out of range nothing is changed.
  76 *)
  77
  78 PROCEDURE replaceItemInList (l: wlist; n: CARDINAL; w: WORD) ;
  79 BEGIN
  80    WHILE l#NIL DO
  81       WITH l^ DO
  82          IF n<=noOfElements
  83          THEN
  84             elements[n] := w
  85          ELSE
  86             DEC (n, noOfElements)
  87          END
  88       END ;
  89       l := l^.next
  90    END
  91 END replaceItemInList ;
  92
  93
  94 (*
  95    putItemIntoList - places an WORD, c, into wlist, l.
  96 *)
  97
  98 PROCEDURE putItemIntoList (l: wlist; c: WORD) ;
  99 BEGIN
 100    WITH l^ DO
 101       IF noOfElements<maxNoOfElements
 102       THEN
 103          INC (noOfElements) ;
 104          elements[noOfElements] := c
 105       ELSIF next#NIL
 106       THEN
 107          putItemIntoList (next, c)
 108       ELSE
 109          next := initList () ;
 110          putItemIntoList (next, c)
 111       END
 112    END
 113 END putItemIntoList ;
 114
 115
 116 (*
 117    getItemFromList - retrieves the nth WORD from wlist, l.
 118 *)
 119
 120 PROCEDURE getItemFromList (l: wlist; n: CARDINAL) : WORD ;
 121 BEGIN
 122    WHILE l#NIL DO
 123       WITH l^ DO
 124          IF n<=noOfElements
 125          THEN
 126             RETURN elements[n]
 127          ELSE
 128             DEC (n, noOfElements)
 129          END
 130       END ;
 131       l := l^.next
 132    END ;
 133    RETURN 0
 134 END getItemFromList ;
 135
 136
 137 (*
 138    getIndexOfList - returns the index for WORD, c, in wlist, l.
 139                     If more than one WORD, c, exists the index
 140                     for the first is returned.
 141 *)
 142
 143 PROCEDURE getIndexOfList (l: wlist; c: WORD) : CARDINAL ;
 144 VAR
 145    i: CARDINAL ;
 146 BEGIN
 147    IF l=NIL
 148    THEN
 149       RETURN 0
 150    ELSE
 151       WITH l^ DO
 152          i := 1 ;
 153          WHILE i<=noOfElements DO
 154             IF elements[i]=c
 155             THEN
 156                RETURN i
 157             ELSE
 158                INC(i)
 159             END
 160          END ;
 161          RETURN noOfElements + getIndexOfList (next, c)
 162       END
 163    END
 164 END getIndexOfList ;
 165
 166
 167 (*
 168    noOfItemsInList - returns the number of items in wlist, l.
 169 *)
 170
 171 PROCEDURE noOfItemsInList (l: wlist) : CARDINAL ;
 172 VAR
 173    t: CARDINAL ;
 174 BEGIN
 175    IF l=NIL
 176    THEN
 177       RETURN 0
 178    ELSE
 179       t := 0 ;
 180       REPEAT
 181          WITH l^ DO
 182             INC (t, noOfElements)
 183          END ;
 184          l := l^.next
 185       UNTIL l=NIL;
 186       RETURN t
 187    END
 188 END noOfItemsInList ;
 189
 190
 191 (*
 192    includeItemIntoList - adds an WORD, c, into a wlist providing
 193                          the value does not already exist.
 194 *)
 195
 196 PROCEDURE includeItemIntoList (l: wlist; c: WORD) ;
 197 BEGIN
 198    IF NOT isItemInList (l, c)
 199    THEN
 200       putItemIntoList (l, c)
 201    END
 202 END includeItemIntoList ;
 203
 204
 205 (*
 206    removeItem - remove an element at index, i, from the wlist data type.
 207 *)
 208
 209 PROCEDURE removeItem (p, l: wlist; i: CARDINAL) ;
 210 BEGIN
 211    WITH l^ DO
 212       DEC (noOfElements) ;
 213       WHILE i<=noOfElements DO
 214          elements[i] := elements[i+1] ;
 215          INC (i)
 216       END ;
 217       IF (noOfElements=0) AND (p#NIL)
 218       THEN
 219          p^.next := l^.next ;
 220          DISPOSE (l)
 221       END
 222    END
 223 END removeItem ;
 224
 225
 226 (*
 227    removeItemFromList - removes a WORD, c, from a wlist.
 228                         It assumes that this value only appears once.
 229 *)
 230
 231 PROCEDURE removeItemFromList (l: wlist; c: WORD) ;
 232 VAR
 233    p    : wlist ;
 234    i    : CARDINAL ;
 235    found: BOOLEAN ;
 236 BEGIN
 237    IF l#NIL
 238    THEN
 239       found := FALSE ;
 240       p := NIL ;
 241       REPEAT
 242          WITH l^ DO
 243             i := 1 ;
 244             WHILE (i<=noOfElements) AND (elements[i]#c) DO
 245                INC (i)
 246             END ;
 247          END ;
 248          IF (i<=l^.noOfElements) AND (l^.elements[i]=c)
 249          THEN
 250             found := TRUE
 251          ELSE
 252             p := l ;
 253             l := l^.next
 254          END
 255       UNTIL (l=NIL) OR found ;
 256       IF found
 257       THEN
 258          removeItem (p, l, i)
 259       END
 260    END
 261 END removeItemFromList ;
 262
 263
 264 (*
 265    isItemInList - returns true if a WORD, c, was found in wlist, l.
 266 *)
 267
 268 PROCEDURE isItemInList (l: wlist; c: WORD) : BOOLEAN ;
 269 VAR
 270    i: CARDINAL ;
 271 BEGIN
 272    REPEAT
 273       WITH l^ DO
 274          i := 1 ;
 275          WHILE i<=noOfElements DO
 276             IF elements[i]=c
 277             THEN
 278                RETURN TRUE
 279             ELSE
 280                INC (i)
 281             END
 282          END
 283       END ;
 284       l := l^.next
 285    UNTIL l=NIL ;
 286    RETURN FALSE
 287 END isItemInList ;
 288
 289
 290 (*
 291    foreachItemInListDo - calls procedure, P, foreach item in wlist, l.
 292 *)
 293
 294 PROCEDURE foreachItemInListDo (l: wlist; p: performOperation) ;
 295 VAR
 296    i, n: CARDINAL ;
 297 BEGIN
 298    n := noOfItemsInList(l) ;
 299    i := 1 ;
 300    WHILE i<=n DO
 301       p (getItemFromList (l, i)) ;
 302       INC(i)
 303    END
 304 END foreachItemInListDo ;
 305
 306
 307 (*
 308    duplicateList - returns a duplicate wlist derived from, l.
 309 *)
 310
 311 PROCEDURE duplicateList (l: wlist) : wlist ;
 312 VAR
 313    m   : wlist ;
 314    n, i: CARDINAL ;
 315 BEGIN
 316    m := initList () ;
 317    n := noOfItemsInList (l) ;
 318    i := 1 ;
 319    WHILE i<=n DO
 320       putItemIntoList (m, getItemFromList (l, i)) ;
 321       INC (i)
 322    END ;
 323    RETURN m
 324 END duplicateList ;
 325
 326
 327 END wlists.