vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-05 23:22:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

StreamDisciplines

Browse source 
Former-commit-id: ab6cd805d5
This commit is contained in:
Norayr Chilingarian 2013-10-22 16:43:03 +04:00
parent 999a3baa33
commit 6f24bfc67d
2 changed files with 250 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/lib/ulm/ulmIndirectDisciplines.Mod
View file

@ -31,7 +31,7 @@
MODULE ulmIndirectDisciplines;
IMPORT Disciplines := ulmDisciplines, Forwarders := ulmForwarders;
IMPORT Disciplines := ulmDisciplines, Forwarders := ulmForwarders, SYSTEM;
TYPE
Object* = Disciplines.Object;
@ -72,7 +72,7 @@ MODULE ulmIndirectDisciplines;
VAR
disc: IndDiscipline;
BEGIN
WHILE Disciplines.Seek(object, discID, disc) DO
WHILE Disciplines.Seek(object, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) DO
object := disc.forwardTo;
END;
Disciplines.Add(object, discipline);
@ -88,7 +88,7 @@ MODULE ulmIndirectDisciplines;
Disciplines.Remove(object, id);
EXIT
END;
IF ~Disciplines.Seek(object, discID, disc) THEN
IF ~Disciplines.Seek(object, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
EXIT
END;
object := disc.forwardTo;
@ -104,7 +104,7 @@ MODULE ulmIndirectDisciplines;
IF Disciplines.Seek(object, id, discipline) THEN
RETURN TRUE
END;
IF ~Disciplines.Seek(object, discID, disc) THEN
IF ~Disciplines.Seek(object, discID, SYSTEM.VAL(Disciplines.Discipline, disc)) THEN
RETURN FALSE
END;
object := disc.forwardTo;

246
src/lib/ulm/ulmStreamDisciplines.Mod Normal file
View file

@ -0,0 +1,246 @@
(* Ulm's Oberon Library
Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
----------------------------------------------------------------------------
Ulm's Oberon Library is free software; you can redistribute it
and/or modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
Ulm's Oberon Library 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
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
----------------------------------------------------------------------------
E-mail contact: oberon@mathematik.uni-ulm.de
----------------------------------------------------------------------------
$Id: StreamDisci.om,v 1.2 1994/07/04 14:53:25 borchert Exp $
----------------------------------------------------------------------------
$Log: StreamDisci.om,v $
Revision 1.2 1994/07/04 14:53:25 borchert
parameter for indentation width added
Revision 1.1 1994/02/22 20:10:34 borchert
Initial revision
----------------------------------------------------------------------------
AFB 10/91
----------------------------------------------------------------------------
*)
MODULE StreamDisciplines;
(* definition of general-purpose disciplines for streams *)
IMPORT ASCII, Disciplines := IndirectDisciplines, Events, Sets, Streams;
TYPE
LineTerminator* = ARRAY 4 OF CHAR;
VAR
badfieldsepset*: Events.EventType;
TYPE
StreamDiscipline = POINTER TO StreamDisciplineRec;
StreamDisciplineRec =
RECORD
(Disciplines.DisciplineRec)
lineterm: LineTerminator;
fieldseps: Sets.CharSet;
fieldsep: CHAR; (* one of them *)
whitespace: Sets.CharSet;
indentwidth: INTEGER;
END;
VAR
id: Disciplines.Identifier;
(* default values *)
defaultFieldSeps: Sets.CharSet;
defaultFieldSep: CHAR;
defaultLineTerm: LineTerminator;
defaultWhiteSpace: Sets.CharSet;
defaultIndentWidth: INTEGER;
PROCEDURE InitDiscipline(VAR disc: StreamDiscipline);
BEGIN
NEW(disc); disc.id := id;
disc.fieldseps := defaultFieldSeps;
disc.fieldsep := defaultFieldSep;
disc.lineterm := defaultLineTerm;
disc.whitespace := defaultWhiteSpace;
disc.indentwidth := defaultIndentWidth;
END InitDiscipline;
PROCEDURE SetLineTerm*(s: Streams.Stream; lineterm: LineTerminator);
VAR
disc: StreamDiscipline;
BEGIN
IF ~Disciplines.Seek(s, id, disc) THEN
InitDiscipline(disc);
END;
disc.lineterm := lineterm;
Disciplines.Add(s, disc);
END SetLineTerm;
PROCEDURE GetLineTerm*(s: Streams.Stream; VAR lineterm: LineTerminator);
(* default line terminator is ASCII.nl *)
VAR
disc: StreamDiscipline;
BEGIN
IF Disciplines.Seek(s, id, disc) THEN
lineterm := disc.lineterm;
ELSE
lineterm := defaultLineTerm;
END;
END GetLineTerm;
PROCEDURE SetFieldSepSet*(s: Streams.Stream; fieldsepset: Sets.CharSet);
(* cardinality of fieldsepset must be >= 1 *)
VAR
disc: StreamDiscipline;
ch: CHAR; found: BOOLEAN;
fieldsep: CHAR;
event: Events.Event;
BEGIN
ch := 0X;
LOOP (* seek for the first element inside fieldsepset *)
IF Sets.CharIn(fieldsepset, ch) THEN
found := TRUE; fieldsep := ch; EXIT
END;
IF ch = MAX(CHAR) THEN
found := FALSE; EXIT
END;
ch := CHR(ORD(ch) + 1);
END;
IF ~found THEN
NEW(event);
event.message := "StreamDisciplines.SetFieldSepSet: empty fieldsepset";
event.type := badfieldsepset;
Events.Raise(event);
RETURN
END;
IF ~Disciplines.Seek(s, id, disc) THEN
InitDiscipline(disc);
END;
disc.fieldseps := fieldsepset;
disc.fieldsep := fieldsep;
Disciplines.Add(s, disc);
END SetFieldSepSet;
PROCEDURE GetFieldSepSet*(s: Streams.Stream; VAR fieldsepset: Sets.CharSet);
(* default field separators are ASCII.tab and ASCII.sp *)
VAR
disc: StreamDiscipline;
BEGIN
IF Disciplines.Seek(s, id, disc) THEN
fieldsepset := disc.fieldseps;
ELSE
fieldsepset := defaultFieldSeps;
END;
END GetFieldSepSet;
PROCEDURE SetFieldSep*(s: Streams.Stream; fieldsep: CHAR);
VAR
disc: StreamDiscipline;
BEGIN
IF ~Disciplines.Seek(s, id, disc) THEN
InitDiscipline(disc);
END;
Sets.InclChar(disc.fieldseps, fieldsep);
disc.fieldsep := fieldsep;
Disciplines.Add(s, disc);
END SetFieldSep;
PROCEDURE GetFieldSep*(s: Streams.Stream; VAR fieldsep: CHAR);
(* default field separator is ASCII.tab;
if a set of field separators has been given via SetFieldSepSet,
one of them is returned
*)
VAR
disc: StreamDiscipline;
BEGIN
IF Disciplines.Seek(s, id, disc) THEN
fieldsep := disc.fieldsep;
ELSE
fieldsep := defaultFieldSep;
END;
END GetFieldSep;
PROCEDURE GetWhiteSpace*(s: Streams.Stream; VAR whitespace: Sets.CharSet);
(* default: ASCII.tab, ASCII.sp, ASCII.np and ASCII.nl *)
VAR
disc: StreamDiscipline;
BEGIN
IF Disciplines.Seek(s, id, disc) THEN
whitespace := disc.whitespace;
ELSE
whitespace := defaultWhiteSpace;
END;
END GetWhiteSpace;
PROCEDURE SetWhiteSpace*(s: Streams.Stream; whitespace: Sets.CharSet);
VAR
disc: StreamDiscipline;
BEGIN
IF ~Disciplines.Seek(s, id, disc) THEN
InitDiscipline(disc);
END;
disc.whitespace := whitespace;
Disciplines.Add(s, disc);
END SetWhiteSpace;
PROCEDURE SetIndentationWidth*(s: Streams.Stream; indentwidth: INTEGER);
VAR
disc: StreamDiscipline;
BEGIN
IF indentwidth >= 0 THEN
IF ~Disciplines.Seek(s, id, disc) THEN
InitDiscipline(disc);
END;
disc.indentwidth := indentwidth;
Disciplines.Add(s, disc);
END;
END SetIndentationWidth;
PROCEDURE GetIndentationWidth*(s: Streams.Stream; VAR indentwidth: INTEGER);
VAR
disc: StreamDiscipline;
BEGIN
IF Disciplines.Seek(s, id, disc) THEN
indentwidth := disc.indentwidth;
ELSE
indentwidth := defaultIndentWidth;
END;
END GetIndentationWidth;
PROCEDURE IncrIndentationWidth*(s: Streams.Stream; incr: INTEGER);
VAR
disc: StreamDiscipline;
BEGIN
IF ~Disciplines.Seek(s, id, disc) THEN
InitDiscipline(disc);
END;
IF disc.indentwidth + incr >= 0 THEN
INC(disc.indentwidth, incr);;
END;
Disciplines.Add(s, disc);
END IncrIndentationWidth;
BEGIN
Events.Define(badfieldsepset);
id := Disciplines.Unique();
Sets.InitSet(defaultFieldSeps);
Sets.InclChar(defaultFieldSeps, ASCII.tab);
Sets.InclChar(defaultFieldSeps, ASCII.sp);
defaultFieldSep := ASCII.tab;
defaultLineTerm[0] := ASCII.nl; defaultLineTerm[1] := 0X;
Sets.InitSet(defaultWhiteSpace);
Sets.InclChar(defaultWhiteSpace, ASCII.tab);
Sets.InclChar(defaultWhiteSpace, ASCII.sp);
Sets.InclChar(defaultWhiteSpace, ASCII.np);
Sets.InclChar(defaultWhiteSpace, ASCII.nl);
defaultIndentWidth := 0;
END StreamDisciplines.