(* ------------------- VERSION 3 17.03.86 ------------------- *)
PACKET name set DEFINES (* Autor: J.Liedtke *)
ALL ,
SOME ,
LIKE ,
+ ,
- ,
/ ,
do ,
FILLBY ,
remainder ,
fetch ,
save ,
fetch all ,
save all ,
forget ,
erase ,
insert ,
edit :
LET cr lf = ""13""10"" ;
TEXT VAR name ;
DATASPACE VAR edit space ;
THESAURUS VAR remaining thesaurus := empty thesaurus ;
THESAURUS OP + (THESAURUS CONST left, right) :
THESAURUS VAR union := left ;
INT VAR index := 0 ;
get (right, name, index) ;
WHILE name <> "" REP
IF NOT (union CONTAINS name)
THEN insert (union, name)
FI ;
get (right, name, index)
PER ;
union .
ENDOP + ;
THESAURUS OP + (THESAURUS CONST left, TEXT CONST right) :
THESAURUS VAR union := left ;
IF NOT (union CONTAINS right)
THEN insert (union, right)
FI ;
union .
ENDOP + ;
THESAURUS OP - (THESAURUS CONST left, right) :
THESAURUS VAR difference := empty thesaurus ;
INT VAR index := 0 ;
get (left, name, index) ;
WHILE name <> "" REP
IF NOT (right CONTAINS name)
THEN insert (difference, name)
FI ;
get (left, name, index)
PER ;
difference .
ENDOP - ;
THESAURUS OP - (THESAURUS CONST left, TEXT CONST right) :
THESAURUS VAR difference := left ;
INT VAR index ;
delete (difference, right, index) ;
difference .
ENDOP - ;
THESAURUS OP / (THESAURUS CONST left, right) :
THESAURUS VAR intersection := empty thesaurus ;
INT VAR index := 0 ;
get (left, name, index) ;
WHILE name <> "" REP
IF right CONTAINS name
THEN insert (intersection, name)
FI ;
get (left, name, index)
PER ;
intersection .
ENDOP / ;
THESAURUS OP ALL (TEXT CONST file name) :
FILE VAR file := sequential file (input, file name) ;
THESAURUS VAR thesaurus := empty thesaurus ;
thesaurus FILLBY file ;
thesaurus .
ENDOP ALL ;
THESAURUS OP SOME (THESAURUS CONST thesaurus) :
copy thesaurus into file ;
edit file ;
copy file into thesaurus .
copy thesaurus into file :
forget (edit space) ;
edit space := nilspace ;
FILE VAR file := sequential file (output, edit space) ;
file FILLBY thesaurus .
edit file :
modify (file) ;
edit (file) .
copy file into thesaurus :
THESAURUS VAR result := empty thesaurus ;
input (file) ;
result FILLBY file ;
forget (edit space) ;
result .
ENDOP SOME ;
THESAURUS OP SOME (TASK CONST task) :
SOME ALL task
ENDOP SOME ;
THESAURUS OP SOME (TEXT CONST file name) :
SOME ALL file name
ENDOP SOME ;
THESAURUS OP LIKE (THESAURUS CONST thesaurus, TEXT CONST pattern) :
THESAURUS VAR result:= empty thesaurus ;
INT VAR index:= 0 ;
REP get (thesaurus, name, index) ;
IF name = ""
THEN LEAVE LIKE WITH result
ELIF name LIKE pattern
THEN insert (result, name)
FI
PER ;
result .
ENDOP LIKE ;
THESAURUS PROC remainder :
remaining thesaurus
ENDPROC remainder ;
PROC do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus) :
INT VAR index := 0 , operation number := 0 ;
TEXT VAR name ;
remaining thesaurus := empty thesaurus ;
disable stop ;
work off thesaurus ;
fill leftover with remainder .
work off thesaurus :
REP
get (thesaurus, name, index) ;
IF name = ""
THEN LEAVE work off thesaurus
FI ;
operation number INCR 1 ;
cout (operation number) ;
execute (PROC (TEXT CONST) operate, name)
UNTIL is error ENDREP .
fill leftover with remainder :
WHILE name <> "" REP
insert (remaining thesaurus, name) ;
get (thesaurus, name, index)
PER .
ENDPROC do ;
PROC execute (PROC (TEXT CONST) operate, TEXT CONST name) :
enable stop ;
operate (name)
ENDPROC execute ;
PROC do (PROC (TEXT CONST, TASK CONST) operate, THESAURUS CONST thesaurus,
TASK CONST task) :
INT VAR index := 0 , operation number := 0 ;
TEXT VAR name ;
remaining thesaurus := empty thesaurus ;
disable stop ;
work off thesaurus ;
fill leftover with remainder .
work off thesaurus :
REP
get (thesaurus, name, index) ;
IF name = ""
THEN LEAVE work off thesaurus
FI ;
operation number INCR 1 ;
cout (operation number) ;
execute (PROC (TEXT CONST, TASK CONST) operate, name, task)
UNTIL is error ENDREP .
fill leftover with remainder :
WHILE name <> "" REP
insert (remaining thesaurus, name) ;
get (thesaurus, name, index)
PER .
ENDPROC do ;
PROC execute (PROC (TEXT CONST, TASK CONST) operate,
TEXT CONST name, TASK CONST task) :
enable stop ;
operate (name, task)
ENDPROC execute ;
OP FILLBY (THESAURUS VAR thesaurus, FILE VAR file) :
WHILE NOT eof (file) REP
getline (file, name) ;
delete trailing blanks ;
IF name <> "" CAND NOT (thesaurus CONTAINS name)
THEN insert (thesaurus, name)
FI
PER .
delete trailing blanks :
WHILE (name SUB LENGTH name) = " " REP
name := subtext (name, 1, LENGTH name - 1)
PER .
ENDOP FILLBY ;
OP FILLBY (FILE VAR file, THESAURUS CONST thesaurus) :
INT VAR index := 0 ;
REP
get (thesaurus, name, index) ;
IF name = ""
THEN LEAVE FILLBY
FI ;
putline (file, name)
PER .
ENDOP FILLBY ;
OP FILLBY (TEXT CONST file name, THESAURUS CONST thesaurus) :
FILE VAR f := sequential file (output, file name) ;
f FILLBY thesaurus
ENDOP FILLBY ;
PROC fetch (THESAURUS CONST nameset) :
do (PROC (TEXT CONST) fetch, nameset)
ENDPROC fetch ;
PROC fetch (THESAURUS CONST nameset, TASK CONST task) :
do (PROC (TEXT CONST, TASK CONST) fetch, nameset, task)
ENDPROC fetch ;
PROC save (THESAURUS CONST nameset) :
do (PROC (TEXT CONST) save, nameset)
ENDPROC save ;
PROC save (THESAURUS CONST nameset, TASK CONST task) :
do (PROC (TEXT CONST, TASK CONST) save, nameset, task)
ENDPROC save ;
PROC fetch all :
fetch all (father)
ENDPROC fetch all ;
PROC fetch all (TASK CONST manager) :
fetch (ALL manager, manager)
ENDPROC fetch all ;
PROC save all :
save all (father)
ENDPROC save all ;
PROC save all (TASK CONST manager) :
save (ALL myself, manager)
ENDPROC save all ;
PROC forget (THESAURUS CONST nameset) :
do (PROC (TEXT CONST) forget, nameset)
ENDPROC forget ;
PROC erase (THESAURUS CONST nameset) :
do (PROC (TEXT CONST) erase, nameset)
ENDPROC erase ;
PROC erase (THESAURUS CONST nameset, TASK CONST task) :
do (PROC (TEXT CONST, TASK CONST) erase, nameset, task)
ENDPROC erase ;
PROC insert (THESAURUS CONST nameset) :
do (PROC (TEXT CONST) insert, nameset)
ENDPROC insert ;
PROC edit (THESAURUS CONST nameset) :
do (PROC (TEXT CONST) edit, nameset)
ENDPROC edit ;
ENDPACKET name set ;