vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 21:32:26 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

voc compiler first commit

Browse source
This commit is contained in:
Norayr Chilingarian 2013-09-27 22:34:17 +04:00
parent 4a7dc4b549
commit 760d826948
119 changed files with 30394 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

34
src/lib/ooc2/gnuc/oocwrapperlibc.Mod Normal file
View file

@ -0,0 +1,34 @@
MODULE oocwrapperlibc;
IMPORT SYSTEM;
PROCEDURE -includeStdio()
"#include <stdio.h>";
PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER
"system(str)";
PROCEDURE system*(cmd : ARRAY OF CHAR);
VAR r : INTEGER;
BEGIN
r := sys(cmd);
END system;
(*
PROCEDURE strtod* (string: C.address;
VAR tailptr: C.charPtr1d): C.double;
PROCEDURE strtof* (string: C.address;
VAR tailptr: C.charPtr1d): C.float;
PROCEDURE sscanf* (s: C.address; template: ARRAY OF CHAR; ...) : C.int;
*)
PROCEDURE -sprntf(s, t0, t1, t2: ARRAY OF CHAR): INTEGER
"sprintf(s, t0, t1, t2)";
PROCEDURE sprintf* (VAR s: ARRAY OF CHAR; template0: ARRAY OF CHAR; template1: ARRAY OF CHAR; template2: ARRAY OF CHAR);
VAR r : INTEGER;
BEGIN
r := sprntf (s, template0, template1, template2);
END sprintf;
BEGIN
END oocwrapperlibc.

37
src/lib/ooc2/ooc2Ascii.Mod Normal file
View file

@ -0,0 +1,37 @@
(* $Id: Ascii.Mod,v 1.2 2003/01/04 10:19:19 mva Exp $ *)
MODULE ooc2Ascii;
(* Standard short character names for control chars.
Copyright (C) 2002 Michael van Acken
This module is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation; either version 2 of
the License, or (at your option) any later version.
This module 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with OOC. If not, write to the Free Software Foundation,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
CONST
nul* = 00X; soh* = 01X; stx* = 02X; etx* = 03X;
eot* = 04X; enq* = 05X; ack* = 06X; bel* = 07X;
bs * = 08X; ht * = 09X; lf * = 0AX; vt * = 0BX;
ff * = 0CX; cr * = 0DX; so * = 0EX; si * = 0FX;
dle* = 10X; dc1* = 11X; dc2* = 12X; dc3* = 13X;
dc4* = 14X; nak* = 15X; syn* = 16X; etb* = 17X;
can* = 18X; em * = 19X; sub* = 1AX; esc* = 1BX;
fs * = 1CX; gs * = 1DX; rs * = 1EX; us * = 1FX;
del* = 7FX;
CONST (* often used synonyms *)
sp * = " ";
xon* = dc1;
xoff* = dc3;
END ooc2Ascii.

89
src/lib/ooc2/ooc2CharClass.Mod Normal file
View file

@ -0,0 +1,89 @@
(* $Id: CharClass.Mod,v 1.1 2002/04/15 22:42:48 mva Exp $ *)
MODULE ooc2CharClass;
(* Classification of values of the type CHAR.
Copyright (C) 1997-1998, 2002 Michael van Acken
This module is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation; either version 2 of
the License, or (at your option) any later version.
This module 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with OOC. If not, write to the Free Software Foundation,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
IMPORT
Ascii := ooc2Ascii;
CONST
eol* = Ascii.lf;
(**The implementation-defined character used to represent end of line
internally for OOC. *)
VAR
systemEol-: ARRAY 3 OF CHAR;
(**End of line marker used by the target system for text files. The string
defined here can contain more than one character. For one character eol
markers, @ovar{systemEol} must not necessarily equal @oconst{eol}. Note
that the string cannot contain the termination character @code{0X}. *)
PROCEDURE IsNumeric* (ch: CHAR): BOOLEAN;
(**Returns @code{TRUE} if and only if @oparam{ch} is classified as a numeric
character. *)
BEGIN
RETURN ("0" <= ch) & (ch <= "9")
END IsNumeric;
PROCEDURE IsLetter* (ch: CHAR): BOOLEAN;
(**Returns @code{TRUE} if and only if @oparam{ch} is classified as a letter. *)
BEGIN
RETURN ("a" <= ch) & (ch <= "z") OR ("A" <= ch) & (ch <= "Z")
END IsLetter;
PROCEDURE IsUpper* (ch: CHAR): BOOLEAN;
(**Returns @code{TRUE} if and only if @oparam{ch} is classified as an upper
case letter. *)
BEGIN
RETURN ("A" <= ch) & (ch <= "Z")
END IsUpper;
PROCEDURE IsLower* (ch: CHAR): BOOLEAN;
(**Returns @code{TRUE} if and only if @oparam{ch} is classified as a lower case
letter. *)
BEGIN
RETURN ("a" <= ch) & (ch <= "z")
END IsLower;
PROCEDURE IsControl* (ch: CHAR): BOOLEAN;
(**Returns @code{TRUE} if and only if @oparam{ch} represents a control
function. *)
BEGIN
RETURN (ch < Ascii.sp)
END IsControl;
PROCEDURE IsWhiteSpace* (ch: CHAR): BOOLEAN;
(**Returns @code{TRUE} if and only if @oparam{ch} represents a space character
or a format effector. *)
BEGIN
RETURN (ch = Ascii.sp) OR (ch = Ascii.ff) OR (ch = Ascii.lf) OR
(ch = Ascii.cr) OR (ch = Ascii.ht) OR (ch = Ascii.vt)
END IsWhiteSpace;
PROCEDURE IsEol* (ch: CHAR): BOOLEAN;
(**Returns @code{TRUE} if and only if @oparam{ch} is the implementation-defined
character used to represent end of line internally for OOC. *)
BEGIN
RETURN (ch = eol)
END IsEol;
BEGIN
systemEol[0] := Ascii.lf; systemEol[1] := 0X
END ooc2CharClass.

45
src/lib/ooc2/ooc2ConvTypes.Mod Normal file
View file

@ -0,0 +1,45 @@
(* $Id: ConvTypes.Mod,v 1.1 2002/05/10 22:25:18 mva Exp $ *)
MODULE ooc2ConvTypes;
(**Common types used in the string conversion modules. *)
TYPE
ConvResults*= SHORTINT;
(**Values of this type are used to express the format of a string. *)
CONST
strAllRight*=0;
(**The string format is correct for the corresponding conversion. *)
strOutOfRange*=1;
(**The string is well-formed but the value cannot be represented. *)
strWrongFormat*=2;
(**The string is in the wrong format for the conversion. *)
strEmpty*=3;
(**The given string is empty. *)
TYPE
ScanClass*= SHORTINT;
(**Values of this type are used to classify input to finite state scanners. *)
CONST
padding*=0;
(**A leading or padding character at this point in the scan---ignore it. *)
valid*=1;
(**A valid character at this point in the scan---accept it. *)
invalid*=2;
(*An invalid character at this point in the scan---reject it *)
terminator*=3;
(**A terminating character at this point in the scan (not part of token). *)
TYPE
ScanState*=POINTER TO ScanDesc;
ScanDesc*=RECORD
(**The type of lexical scanning control procedures. *)
p*: PROCEDURE (ch: CHAR; VAR cl: ScanClass; VAR st: ScanState);
(**A procedure that produces the next state corresponding to the
character @var{ch}. The class of the character is returned
in @var{cl}, the next state in @var{st}. *)
END;
END ooc2ConvTypes.

249
src/lib/ooc2/ooc2IntConv.Mod Normal file
View file

@ -0,0 +1,249 @@
(* $Id: IntConv.Mod,v 1.6 2002/05/26 12:15:17 mva Exp $ *)
MODULE ooc2IntConv;
(*
IntConv - Low-level integer/string conversions.
Copyright (C) 2000, 2002 Michael van Acken
Copyright (C) 1995 Michael Griebling
This module is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This module 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
IMPORT
Char := ooc2CharClass, Conv := ooc2ConvTypes;
TYPE
ConvResults* = Conv.ConvResults;
(**One of @oconst{strAllRight}, @oconst{strOutOfRange},
@oconst{strWrongFormat}, or @oconst{strEmpty}. *)
CONST
strAllRight*=Conv.strAllRight;
(**The string format is correct for the corresponding conversion. *)
strOutOfRange*=Conv.strOutOfRange;
(**The string is well-formed but the value cannot be represented. *)
strWrongFormat*=Conv.strWrongFormat;
(**The string is in the wrong format for the conversion. *)
strEmpty*=Conv.strEmpty;
(**The given string is empty. *)
VAR
W, S, SI: Conv.ScanState;
minInt, maxInt: ARRAY 11 OF CHAR;
CONST
maxDigits = 10; (* length of minInt, maxInt *)
(* internal state machine procedures *)
PROCEDURE WState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
BEGIN
IF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=W
ELSE chClass:=Conv.terminator; nextState:=NIL
END
END WState;
PROCEDURE SState(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
BEGIN
IF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=W
ELSE chClass:=Conv.invalid; nextState:=S
END
END SState;
PROCEDURE ScanInt*(inputCh: CHAR; VAR chClass: Conv.ScanClass; VAR nextState: Conv.ScanState);
(**Represents the start state of a finite state scanner for signed whole
numbers---assigns class of @oparam{inputCh} to @oparam{chClass} and a
procedure representing the next state to @oparam{nextState}.
The call of @samp{ScanInt(inputCh,chClass,nextState)} shall assign values
to @oparam{chClass} and @oparam{nextState} depending upon the value of
@oparam{inputCh} as shown in the following table.
@example
Procedure inputCh chClass nextState (a procedure
with behaviour of)
--------- --------- -------- ---------
ScanInt space padding ScanInt
sign valid SState
decimal digit valid WState
other invalid ScanInt
SState decimal digit valid WState
other invalid SState
WState decimal digit valid WState
other terminator --
@end example
NOTE 1 -- The procedure @oproc{ScanInt} corresponds to the start state of a
finite state machine to scan for a character sequence that forms a signed
whole number. It may be used to control the actions of a finite state
interpreter. As long as the value of @oparam{chClass} is other than
@oconst{Conv.terminator} or @oconst{Conv.invalid}, the
interpreter should call the procedure whose value is assigned to
@oparam{nextState} by the previous call, supplying the next character from
the sequence to be scanned. It may be appropriate for the interpreter to
ignore characters classified as @oconst{Conv.invalid}, and proceed
with the scan. This would be the case, for example, with interactive
input, if only valid characters are being echoed in order to give
interactive users an immediate indication of badly-formed data. If the
character sequence end before one is classified as a terminator, the
string-terminator character should be supplied as input to the finite state
scanner. If the preceeding character sequence formed a complete number,
the string-terminator will be classified as @oconst{Conv.terminator},
otherwise it will be classified as @oconst{Conv.invalid}. *)
BEGIN
IF Char.IsWhiteSpace(inputCh) THEN chClass:=Conv.padding; nextState:=SI
ELSIF (inputCh="+") OR (inputCh="-") THEN chClass:=Conv.valid; nextState:=S
ELSIF Char.IsNumeric(inputCh) THEN chClass:=Conv.valid; nextState:=W
ELSE chClass:=Conv.invalid; nextState:=SI
END
END ScanInt;
PROCEDURE FormatInt*(str: ARRAY OF CHAR): ConvResults;
(**Returns the format of the string value for conversion to LONGINT. *)
VAR
ch: CHAR;
index, start: INTEGER;
state: Conv.ScanState;
positive: BOOLEAN;
prev, class: Conv.ScanClass;
PROCEDURE LessOrEqual (VAR high: ARRAY OF CHAR; start, end: INTEGER): BOOLEAN;
VAR
i: INTEGER;
BEGIN (* pre: index-start = maxDigits *)
i := 0;
WHILE (start # end) DO
IF (str[start] < high[i]) THEN
RETURN TRUE;
ELSIF (str[start] > high[i]) THEN
RETURN FALSE;
ELSE (* str[start] = high[i] *)
INC (start); INC (i);
END;
END;
RETURN TRUE; (* full match *)
END LessOrEqual;
BEGIN
index:=0; prev:=Conv.padding; state:=SI; positive:=TRUE; start := -1;
LOOP
ch:=str[index];
state.p(ch, class, state);
CASE class OF
| Conv.padding: (* nothing to do *)
| Conv.valid:
IF ch="-" THEN positive:=FALSE
ELSIF ch="+" THEN positive:=TRUE
ELSIF (start < 0) & (ch # "0") THEN
start := index;
END
| Conv.invalid:
IF (prev = Conv.padding) & (ch = 0X) THEN
RETURN strEmpty;
ELSE
RETURN strWrongFormat;
END;
| Conv.terminator:
IF (ch = 0X) THEN
IF (index-start < maxDigits) OR
(index-start = maxDigits) &
(positive & LessOrEqual (maxInt, start, index) OR
~positive & LessOrEqual (minInt, start, index)) THEN
RETURN strAllRight;
ELSE
RETURN strOutOfRange;
END;
ELSE
RETURN strWrongFormat;
END;
END;
prev:=class; INC(index)
END;
END FormatInt;
PROCEDURE ValueInt*(str: ARRAY OF CHAR): LONGINT;
(**Returns the value corresponding to the signed whole number string value
@oparam{str} if @oparam{str} is well-formed. Otherwise, result is
undefined. *)
VAR
i: INTEGER;
int: LONGINT;
positive: BOOLEAN;
BEGIN
IF FormatInt(str)=strAllRight THEN
(* here holds: `str' is a well formed string and its value is in range *)
i:=0; positive:=TRUE;
WHILE (str[i] < "0") OR (str[i] > "9") DO (* skip whitespace and sign *)
IF (str[i] = "-") THEN
positive := FALSE;
END;
INC (i);
END;
int := 0;
IF positive THEN
WHILE (str[i] # 0X) DO
int:=int*10 + (ORD(str[i]) - ORD("0"));
INC (i);
END;
ELSE
WHILE (str[i] # 0X) DO
int:=int*10 - (ORD(str[i]) - ORD("0"));
INC (i);
END;
END;
RETURN int;
ELSE (* result is undefined *)
RETURN 0;
END
END ValueInt;
PROCEDURE LengthInt*(int: LONGINT): INTEGER;
(**Returns the number of characters in the string representation of
@oparam{int}. This value corresponds to the capacity of an array @samp{str}
which is of the minimum capacity needed to avoid truncation of the result in
the call @samp{IntStr.IntToStr(int,str)}. *)
VAR
cnt: INTEGER;
BEGIN
IF int=MIN(LONGINT) THEN
RETURN maxDigits+1;
ELSE
IF int<=0 THEN int:=-int; cnt:=1
ELSE cnt:=0
END;
WHILE int>0 DO INC(cnt); int:=int DIV 10 END;
RETURN cnt;
END;
END LengthInt;
BEGIN
(* kludge necessary because of recursive procedure declaration *)
NEW(S); NEW(W); NEW(SI);
S.p:=SState; W.p:=WState; SI.p:=ScanInt;
minInt := "2147483648";
maxInt := "2147483647";
END ooc2IntConv.

103
src/lib/ooc2/ooc2IntStr.Mod Normal file
View file

@ -0,0 +1,103 @@
(* $Id: IntStr.Mod,v 1.1 2002/05/12 21:58:14 mva Exp $ *)
MODULE ooc2IntStr;
(* IntStr - Integer-number/string conversions.
Copyright (C) 1995 Michael Griebling
This module is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This module 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
IMPORT
Conv := ooc2ConvTypes, IntConv := ooc2IntConv;
TYPE
ConvResults*= Conv.ConvResults;
(**One of @oconst{strAllRight}, @oconst{strOutOfRange},
@oconst{strWrongFormat}, or @oconst{strEmpty}. *)
CONST
strAllRight*=Conv.strAllRight;
(**The string format is correct for the corresponding conversion. *)
strOutOfRange*=Conv.strOutOfRange;
(**The string is well-formed but the value cannot be represented. *)
strWrongFormat*=Conv.strWrongFormat;
(**The string is in the wrong format for the conversion. *)
strEmpty*=Conv.strEmpty;
(**The given string is empty. *)
(* the string form of a signed whole number is
["+" | "-"] decimal_digit {decimal_digit}
*)
PROCEDURE StrToInt*(str: ARRAY OF CHAR; VAR int: LONGINT; VAR res: ConvResults);
(**Converts string to integer value. Ignores any leading spaces in
@oparam{str}. If the subsequent characters in @oparam{str} are in the
format of a signed whole number, assigns a corresponding value to
@oparam{int}. Assigns a value indicating the format of @oparam{str} to
@oparam{res}. *)
BEGIN
res:=IntConv.FormatInt(str);
IF (res = strAllRight) THEN
int:=IntConv.ValueInt(str)
END
END StrToInt;
PROCEDURE Reverse (VAR str : ARRAY OF CHAR; start, end : INTEGER);
(* Reverses order of characters in the interval [start..end]. *)
VAR
h : CHAR;
BEGIN
WHILE start < end DO
h := str[start]; str[start] := str[end]; str[end] := h;
INC(start); DEC(end)
END
END Reverse;
PROCEDURE IntToStr*(int: LONGINT; VAR str: ARRAY OF CHAR);
(**Converts the value of @oparam{int} to string form and copies the possibly
truncated result to @oparam{str}. *)
CONST
maxLength = 11; (* maximum number of digits representing a LONGINT value *)
VAR
b : ARRAY maxLength+1 OF CHAR;
s, e: INTEGER;
BEGIN
(* build representation in string 'b' *)
IF int = MIN(LONGINT) THEN (* smallest LONGINT, -int is an overflow *)
b := "-2147483648";
e := 11
ELSE
IF int < 0 THEN (* negative sign *)
b[0] := "-"; int := -int; s := 1
ELSE (* no sign *)
s := 0
END;
e := s; (* 's' holds starting position of string *)
REPEAT
b[e] := CHR(int MOD 10+ORD("0"));
int := int DIV 10;
INC(e)
UNTIL int = 0;
b[e] := 0X;
Reverse(b, s, e-1)
END;
COPY(b, str) (* truncate output if necessary *)
END IntToStr;
END ooc2IntStr.

106
src/lib/ooc2/ooc2LRealConv.Mod Normal file
View file

@ -0,0 +1,106 @@
(* $Id: LRealConv.Mod,v 1.13 2003/04/06 12:11:15 mva Exp $ *)
MODULE ooc2LRealConv;
(* String to LONGREAL conversion functions.
Copyright (C) 2002 Michael van Acken
This module is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation; either version 2 of
the License, or (at your option) any later version.
This module 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with OOC. If not, write to the Free Software Foundation,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
IMPORT
SYSTEM, libc := oocwrapperlibc, CharClass := ooc2CharClass, ConvTypes := ooc2ConvTypes, Real0 := ooc2Real0;
(**
The regular expression for a signed fixed-point real number is
@samp{[+-]?\d+(\.\d* )?}. For the optional exponent part, it is
@samp{E[+-]?\d+}.
*)
TYPE
ConvResults* = ConvTypes.ConvResults;
(**One of @oconst{strAllRight}, @oconst{strOutOfRange},
@oconst{strWrongFormat}, or @oconst{strEmpty}. *)
CONST
strAllRight*=ConvTypes.strAllRight;
(**The string format is correct for the corresponding conversion. *)
strOutOfRange*=ConvTypes.strOutOfRange;
(**The string is well-formed but the value cannot be represented. *)
strWrongFormat*=ConvTypes.strWrongFormat;
(**The string is in the wrong format for the conversion. *)
strEmpty*=ConvTypes.strEmpty;
(**The given string is empty. *)
CONST
maxValue = "17976931348623157";
(* signifcant digits of the maximum value 1.7976931348623157D+308 *)
maxExp = 308;
(* maxium positive exponent of a normalized number *)
PROCEDURE ScanReal*(inputCh: CHAR;
VAR chClass: ConvTypes.ScanClass;
VAR nextState: ConvTypes.ScanState);
BEGIN
Real0.ScanReal (inputCh, chClass, nextState);
END ScanReal;
PROCEDURE FormatReal* (str: ARRAY OF CHAR): ConvResults;
BEGIN
RETURN Real0.FormatReal (str, maxExp, maxValue);
END FormatReal;
PROCEDURE ValueReal*(str: ARRAY OF CHAR): LONGREAL;
(* result is undefined if FormatReal(str) # strAllRight *)
VAR
i: LONGINT;
value: LONGREAL;
BEGIN
i := 0;
WHILE CharClass.IsWhiteSpace(str[i]) DO
(* skip our definition of whitespace *)
INC (i);
END;
IF libc.sscanf(SYSTEM.ADR(str[i]), "%lf", SYSTEM.ADR(value)) = 1 THEN
(* <*PUSH; Warnings:=FALSE*> *)
RETURN value (* syntax is ok *)
(* <*POP*> *)
ELSE
RETURN 0; (* error *)
END;
END ValueReal;
PROCEDURE LengthFloatReal*(real: LONGREAL; sigFigs: INTEGER): INTEGER;
BEGIN
(*<*PUSH; Assertions:=TRUE*>*)
ASSERT (FALSE)
(*<*POP*>*)
END LengthFloatReal;
PROCEDURE LengthEngReal*(real: LONGREAL; sigFigs: INTEGER): INTEGER;
BEGIN
(*<*PUSH; Assertions:=TRUE*>*)
ASSERT (FALSE)
(*<*POP*>*)
END LengthEngReal;
PROCEDURE LengthFixedReal*(real: LONGREAL; place: INTEGER): INTEGER;
BEGIN
(*<*PUSH; Assertions:=TRUE*>*)
ASSERT (FALSE)
(*<*POP*>*)
END LengthFixedReal;
END ooc2LRealConv.

447
src/lib/ooc2/ooc2Real0.Mod Normal file
View file

@ -0,0 +1,447 @@
(* $Id: Real0.Mod,v 1.3 2002/08/12 18:11:30 mva Exp $ *)
MODULE ooc2Real0;
(* Helper functions used by the real conversion modules.
Copyright (C) 2002 Michael van Acken
This module is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation; either version 2 of
the License, or (at your option) any later version.
This module 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with OOC. If not, write to the Free Software Foundation,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
IMPORT
CharClass := ooc2CharClass, ConvTypes := ooc2ConvTypes, Strings := ooc2Strings;
TYPE
ConvResults = ConvTypes.ConvResults;
CONST
strAllRight=ConvTypes.strAllRight;
strOutOfRange=ConvTypes.strOutOfRange;
strWrongFormat=ConvTypes.strWrongFormat;
strEmpty=ConvTypes.strEmpty;
CONST
padding=ConvTypes.padding;
valid=ConvTypes.valid;
invalid=ConvTypes.invalid;
terminator=ConvTypes.terminator;
TYPE
ScanClass = ConvTypes.ScanClass;
ScanState = ConvTypes.ScanState;
CONST
expChar* = "E";
VAR
RS-, P-, F-, E-, SE-, WE-, SR-: ScanState;
(* internal state machine procedures *)
PROCEDURE IsSign (ch: CHAR): BOOLEAN;
(* Return TRUE for '+' or '-' *)
BEGIN
RETURN (ch='+') OR (ch='-')
END IsSign;
PROCEDURE RSState(inputCh: CHAR;
VAR chClass: ScanClass; VAR nextState: ScanState);
BEGIN
IF CharClass.IsNumeric(inputCh) THEN
chClass:=valid; nextState:=P
ELSE
chClass:=invalid; nextState:=RS
END
END RSState;
PROCEDURE PState(inputCh: CHAR;
VAR chClass: ScanClass; VAR nextState: ScanState);
BEGIN
IF CharClass.IsNumeric(inputCh) THEN
chClass:=valid; nextState:=P
ELSIF inputCh="." THEN
chClass:=valid; nextState:=F
ELSIF inputCh=expChar THEN
chClass:=valid; nextState:=E
ELSE
chClass:=terminator; nextState:=NIL
END
END PState;
PROCEDURE FState(inputCh: CHAR;
VAR chClass: ScanClass; VAR nextState: ScanState);
BEGIN
IF CharClass.IsNumeric(inputCh) THEN
chClass:=valid; nextState:=F
ELSIF inputCh=expChar THEN
chClass:=valid; nextState:=E
ELSE
chClass:=terminator; nextState:=NIL
END
END FState;
PROCEDURE EState(inputCh: CHAR;
VAR chClass: ScanClass; VAR nextState: ScanState);
BEGIN
IF IsSign(inputCh) THEN
chClass:=valid; nextState:=SE
ELSIF CharClass.IsNumeric(inputCh) THEN
chClass:=valid; nextState:=WE
ELSE
chClass:=invalid; nextState:=E
END
END EState;
PROCEDURE SEState(inputCh: CHAR;
VAR chClass: ScanClass; VAR nextState: ScanState);
BEGIN
IF CharClass.IsNumeric(inputCh) THEN
chClass:=valid; nextState:=WE
ELSE
chClass:=invalid; nextState:=SE
END
END SEState;
PROCEDURE WEState(inputCh: CHAR;
VAR chClass: ScanClass; VAR nextState: ScanState);
BEGIN
IF CharClass.IsNumeric(inputCh) THEN
chClass:=valid; nextState:=WE
ELSE
chClass:=terminator; nextState:=NIL
END
END WEState;
PROCEDURE ScanReal*(inputCh: CHAR;
VAR chClass: ScanClass; VAR nextState: ScanState);
BEGIN
IF CharClass.IsWhiteSpace(inputCh) THEN
chClass:=padding; nextState:=SR
ELSIF IsSign(inputCh) THEN
chClass:=valid; nextState:=RS
ELSIF CharClass.IsNumeric(inputCh) THEN
chClass:=valid; nextState:=P
ELSE
chClass:=invalid; nextState:=SR
END
END ScanReal;
PROCEDURE FormatReal* (str: ARRAY OF CHAR; maxExp: LONGINT;
maxValue: ARRAY OF CHAR): ConvResults;
VAR
i: LONGINT;
ch: CHAR;
state: ConvTypes.ScanState;
class: ConvTypes.ScanClass;
wSigFigs, fLeadingZeros, exp, startOfExp: LONGINT;
expNegative, allZeroDigit: BOOLEAN;
CONST
expCutoff = 100000000;
(* assume overflow if the value of the exponent is larger than this *)
PROCEDURE NonZeroDigit (): LONGINT;
(* locate first non-zero digit in str *)
BEGIN
i := 0;
WHILE (i # startOfExp) & ((str[i] < "1") OR (str[i] > "9")) DO
INC (i);
END;
RETURN i;
END NonZeroDigit;
PROCEDURE LessOrEqual (upperBound: ARRAY OF CHAR): BOOLEAN;
VAR
i, j: LONGINT;
BEGIN
i := NonZeroDigit();
IF (i # startOfExp) THEN (* str[i] is non-zero digit *)
j := 0;
WHILE (i # startOfExp) & (upperBound[j] # 0X) DO
IF (str[i] < upperBound[j]) THEN
RETURN TRUE;
ELSIF (str[i] > upperBound[j]) THEN
RETURN FALSE;
ELSE
INC (j); INC (i);
IF (str[i] = ".") THEN (* skip decimal point *)
INC (i);
END;
END;
END;
IF (upperBound[j] = 0X) THEN
(* any trailing zeros don't change the outcome: skip them *)
WHILE (str[i] = "0") OR (str[i] = ".") DO
INC (i);
END;
END;
END;
RETURN (i = startOfExp);
END LessOrEqual;
BEGIN
(* normalize exponent character *)
i := 0;
WHILE (str[i] # 0X) & (str[i] # "e") DO
INC (i);
END;
IF (str[i] = "e") THEN
str[i] := expChar;
END;
(* move index `i' over padding characters *)
i := 0;
state := SR;
REPEAT
ch := str[i];
state.p(ch, class, state);
INC (i);
UNTIL (class # ConvTypes.padding);
IF (ch = 0X) THEN
RETURN strEmpty;
ELSE
(* scan part before decimal point or exponent *)
WHILE (class = ConvTypes.valid) & (state # F) & (state # E) &
((ch < "1") OR (ch > "9")) DO
ch := str[i];
state.p(ch, class, state);
INC (i);
END;
wSigFigs := 0;
WHILE (class = ConvTypes.valid) & (state # F) & (state # E) DO
INC (wSigFigs);
ch := str[i];
state.p(ch, class, state);
INC (i);
END;
(* here holds: wSigFigs is the number of significant digits in
the whole number part of the number; 0 means there are only
zeros before the decimal point *)
(* scan fractional part exponent *)
fLeadingZeros := 0; allZeroDigit := TRUE;
WHILE (class = ConvTypes.valid) & (state # E) DO
ch := str[i];
IF allZeroDigit THEN
IF (ch = "0") THEN
INC (fLeadingZeros);
ELSIF (ch # ".") THEN
allZeroDigit := FALSE;
END;
END;
state.p(ch, class, state);
INC (i);
END;
(* here holds: fLeadingZeros holds the number of zeros after
the decimal point *)
(* scan exponent *)
startOfExp := i-1; exp := 0; expNegative := FALSE;
WHILE (class = ConvTypes.valid) DO
ch := str[i];
IF (ch = "-") THEN
expNegative := TRUE;
ELSIF ("0" <= ch) & (ch <= "9") & (exp < expCutoff) THEN
exp := exp*10 + (ORD(ch)-ORD("0"));
END;
state.p(ch, class, state);
INC (i);
END;
IF expNegative THEN
exp := -exp;
END;
(* here holds: exp holds the value of the exponent; if it's absolute
value is larger than expCutoff, then there has been an overflow *)
IF (class = ConvTypes.invalid) OR (ch # 0X) THEN
RETURN strWrongFormat;
ELSE (* (class = ConvTypes.terminator) & (ch = 0X) *)
(* normalize the number: calculate the exponent if the number would
start with a non-zero digit, immediately followed by the
decimal point *)
IF (wSigFigs > 0) THEN
exp := exp+wSigFigs-1;
ELSE
exp := exp-fLeadingZeros-1;
END;
IF (exp > maxExp) & (NonZeroDigit() # startOfExp) OR
(exp = maxExp) & ~LessOrEqual (maxValue) THEN
RETURN strOutOfRange;
ELSE
RETURN strAllRight;
END;
END;
END;
END FormatReal;
PROCEDURE NormalizeFloat* (VAR s: ARRAY OF CHAR);
VAR
i, d: INTEGER;
BEGIN
(* massage the output of sprintf to match our requirements; note: this
code should also handle "Inf", "Infinity", "NaN", etc., gracefully
but this is untested *)
IF (s[0] = "+") THEN d := 1; ELSE d := 0; END; (* erase "+" sign *)
i := 1;
WHILE (s[i] # 0X) DO
IF (s[i] = ".") & (s[i+1] = expChar) THEN
INC (d); (* eliminate "." if no digits follow *)
ELSIF (s[i] = "0") & (i-d-1 >= 0) & IsSign (s[i-d-1]) THEN
INC (d); (* eliminate zeros after exponent sign *)
ELSE
s[i-d] := s[i];
END;
INC (i);
END;
IF (s[i-d-2] = "E") THEN
s[i-d-2] := 0X; (* remove "E+" or "E-" *)
ELSE
s[i-d] := 0X;
END;
END NormalizeFloat;
PROCEDURE FormatForEng* (VAR s: ARRAY OF CHAR);
VAR
i, d, fract, exp, posExp, offset: INTEGER;
BEGIN
(* find out how large the exponent is, and how many digits are in the
fractional part *)
fract := 0; exp := 0; posExp := 0;
IF CharClass.IsNumeric (s[1]) THEN (* skip for NaN, Inf *)
i := 0; d := 0;
WHILE (s[i] # "E") DO
fract := fract + d;
IF (s[i] = ".") THEN d := 1; END;
INC (i);
END;
INC (i);
IF (s[i] = "-") THEN d := -1; ELSE d := 1; END;
posExp := i;
INC (i);
WHILE (s[i] # 0X) DO
exp := exp*10 + d*(ORD (s[i]) - ORD ("0"));
INC (i);
END;
END;
offset := exp MOD 3;
IF (offset # 0) THEN
WHILE (fract < offset) DO (* need more zeros before "E" *)
Strings.Insert ("0", posExp-1, s); INC (fract); INC (posExp);
END;
i := 2;
WHILE (i < offset+2) DO (* move "." offset places to right *)
s[i] := s[i+1]; INC (i);
END;
s[i] := ".";
(* write new exponent *)
exp := exp-offset;
IF (exp < 0) THEN
exp := -exp; s[posExp] := "-";
ELSE
s[posExp] := "+";
END;
s[posExp+1] := CHR (exp DIV 100 + ORD("0"));
s[posExp+2] := CHR (exp DIV 10 MOD 10 + ORD("0"));
s[posExp+3] := CHR (exp MOD 10 + ORD("0"));
s[posExp+4] := 0X;
END;
NormalizeFloat (s);
END FormatForEng;
PROCEDURE FormatForFixed* (VAR s: ARRAY OF CHAR; place: INTEGER);
VAR
i, d, c, fract, point, suffix: INTEGER;
PROCEDURE NotZero (VAR s: ARRAY OF CHAR; pos: INTEGER): BOOLEAN;
BEGIN
WHILE (s[pos] # 0X) DO
IF (s[pos] # "0") & (s[pos] # ".") THEN
RETURN TRUE;
END;
INC (pos);
END;
RETURN FALSE;
END NotZero;
BEGIN
IF (place < 0) THEN
(* locate position of decimal point in string *)
point := 1;
WHILE (s[point] # ".") DO INC (point); END;
(* number of digits before point is `point-1'; position in string
of the first digit that will be converted to zero due to rounding:
`point+place+1'; rightmost digit that may be incremented because
of rounding: `point+place' *)
IF (point+place >= 0) THEN
suffix := point+place+1; IF (s[suffix] = ".") THEN INC (suffix); END;
IF (s[suffix] > "5") OR
(s[suffix] = "5") &
(NotZero (s, suffix+1) OR
(point+place # 0) & ODD (ORD (s[point+place]))) THEN
(* we are rounding up *)
i := point+place;
WHILE (s[i] = "9") DO s[i] := "0"; DEC (i); END;
IF (i = 0) THEN (* looking at sign *)
Strings.Insert ("1", 1, s); INC (point);
ELSE
s[i] := CHR (ORD (s[i])+1); (* increment non-"9" digit by one *)
END;
END;
(* zero everything after the digit at `place' *)
i := point+place+1;
IF (i = 1) THEN (* all zero *)
s[1] := "0"; s[2] := 0X;
ELSE
WHILE (s[i] # ".") DO s[i] := "0"; INC (i); END;
END;
ELSE (* round to zero *)
s[1] := "0"; s[2] := 0X;
END;
s[point] := 0X;
END;
(* correct sign, and add trailing zeros if necessary *)
IF (s[0] = "+") THEN d := 1; ELSE d := 0; END; (* erase "+" sign *)
i := 1; fract := 0; c := 0;
WHILE (s[i] # 0X) DO
s[i-d] := s[i];
fract := fract+c;
IF (s[i] = ".") THEN
c := 1;
END;
INC (i);
END;
WHILE (fract < place) DO
s[i-d] := "0"; INC (fract); INC (i);
END;
s[i-d] := 0X;
END FormatForFixed;
BEGIN
NEW(RS); RS.p:=RSState;
NEW(P); P.p:=PState;
NEW(F); F.p:=FState;
NEW(E); E.p:=EState;
NEW(SE); SE.p:=SEState;
NEW(WE); WE.p:=WEState;
NEW(SR); SR.p:=ScanReal;
END ooc2Real0.

524
src/lib/ooc2/ooc2Strings.Mod Normal file
View file

@ -0,0 +1,524 @@
(* $Id: Strings.Mod,v 1.2 2002/03/11 21:33:22 mva Exp $ *)
MODULE ooc2Strings;
(* Facilities for manipulating strings in character arrays.
Copyright (C) 1996, 1997 Michael van Acken
This module is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation; either version 2 of
the License, or (at your option) any later version.
This module 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with OOC. If not, write to the Free Software Foundation,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
(**
Unlike Modula-2, the behaviour of a procedure is undefined, if one of its input
parameters is an unterminated character array. All of the following procedures
expect to get 0X terminated strings, and will return likewise terminated
strings.
All input parameters that represent an array index or a length are
expected to be non-negative. In the descriptions below these
restrictions are stated as pre-conditions of the procedures, but they
aren't checked explicitly. If this module is compiled with run-time
index enabled, checks some illegal input values may be caught. By
default it is installed @emph{without} index checks.
*)
TYPE
CompareResults* = SHORTINT;
(**Result type of @oproc{Compare}. *)
CONST
less* = -1;
(**Result of @oproc{Compare} if the first argument is lexically less
than the second one. *)
equal* = 0;
(**Result of @oproc{Compare} if the first argument is equal to the second
one. *)
greater* = 1;
(**Result of @oproc{Compare} if the first argument is lexically greater
than the second one. *)
PROCEDURE Length* (stringVal: ARRAY OF CHAR): INTEGER;
(**Returns the length of @oparam{stringVal}. This is equal to the number of
characters in @oparam{stringVal} up to and excluding the first @code{0X}. *)
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (stringVal[i] # 0X) DO
INC (i)
END;
RETURN i
END Length;
PROCEDURE Assign* (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
(**Copies @oparam{source} to @oparam{destination}. Equivalent to the
predefined procedure @code{COPY}. Unlike @code{COPY}, this procedure can be
assigned to a procedure variable. *)
VAR
i: INTEGER;
BEGIN
i := -1;
REPEAT
INC (i);
destination[i] := source[i]
UNTIL (destination[i] = 0X) OR (i = LEN (destination)-1);
destination[i] := 0X
END Assign;
PROCEDURE Extract* (source: ARRAY OF CHAR; startPos, numberToExtract: INTEGER;
VAR destination: ARRAY OF CHAR);
(**Copies at most @oparam{numberToExtract} characters from @oparam{source} to
@oparam{destination}, starting at position @oparam{startPos} in
@oparam{source}. An empty string value will be extracted if
@oparam{startPos} is greater than or equal to @samp{Length(source)}.
@precond
@oparam{startPos} and @oparam{numberToExtract} are not negative.
@end precond *)
VAR
sourceLength, i: INTEGER;
BEGIN
(* make sure that we get an empty string if `startPos' refers to an array
index beyond `Length (source)' *)
sourceLength := Length (source);
IF (startPos > sourceLength) THEN
startPos := sourceLength
END;
(* make sure that `numberToExtract' doesn't exceed the capacity
of `destination' *)
IF (numberToExtract >= LEN (destination)) THEN
numberToExtract := SHORT (LEN (destination))-1
END;
(* copy up to `numberToExtract' characters to `destination' *)
i := 0;
WHILE (i < numberToExtract) & (source[startPos+i] # 0X) DO
destination[i] := source[startPos+i];
INC (i)
END;
destination[i] := 0X
END Extract;
PROCEDURE Delete* (VAR stringVar: ARRAY OF CHAR;
startPos, numberToDelete: INTEGER);
(**Deletes at most @oparam{numberToDelete} characters from @oparam{stringVar},
starting at position @oparam{startPos}. The string value in
@oparam{stringVar} is not altered if @oparam{startPos} is greater than or
equal to @samp{Length(stringVar)}.
@precond
@oparam{startPos} and @oparam{numberToDelete} are not negative.
@end precond *)
VAR
stringLength, i: INTEGER;
BEGIN
stringLength := Length (stringVar);
IF (startPos+numberToDelete < stringLength) THEN
(* `stringVar' has remaining characters beyond the deleted section;
these have to be moved forward by `numberToDelete' characters *)
FOR i := startPos TO stringLength-numberToDelete DO
stringVar[i] := stringVar[i+numberToDelete]
END
ELSIF (startPos < stringLength) THEN
stringVar[startPos] := 0X
END
END Delete;
PROCEDURE Insert* (source: ARRAY OF CHAR; startPos: INTEGER;
VAR destination: ARRAY OF CHAR);
(**Inserts @oparam{source} into @oparam{destination} at position
@oparam{startPos}. After the call @oparam{destination} contains the string
that is contructed by first splitting @oparam{destination} at the position
@oparam{startPos} and then concatenating the first half, @oparam{source},
and the second half. The string value in @oparam{destination} is not
altered if @oparam{startPos} is greater than @samp{Length(source)}. If
@samp{startPos = Length(source)}, then @oparam{source} is appended to
@oparam{destination}.
@precond
@oparam{startPos} is not negative.
@end precond *)
VAR
sourceLength, destLength, destMax, i: INTEGER;
BEGIN
destLength := Length (destination);
sourceLength := Length (source);
destMax := SHORT (LEN (destination))-1;
IF (startPos+sourceLength < destMax) THEN
(* `source' is inserted inside of `destination' *)
IF (destLength+sourceLength > destMax) THEN
(* `destination' too long, truncate it *)
destLength := destMax-sourceLength;
destination[destLength] := 0X
END;
(* move tail section of `destination' *)
FOR i := destLength TO startPos BY -1 DO
destination[i+sourceLength] := destination[i]
END
ELSIF (startPos <= destLength) THEN
(* `source' replaces `destination' from `startPos' on *)
destination[destMax] := 0X; (* set string terminator *)
sourceLength := destMax-startPos (* truncate `source' *)
ELSE (* startPos > destLength: no change in `destination' *)
sourceLength := 0
END;
(* copy characters from `source' to `destination' *)
FOR i := 0 TO sourceLength-1 DO
destination[startPos+i] := source[i]
END
END Insert;
PROCEDURE Replace* (source: ARRAY OF CHAR; startPos: INTEGER;
VAR destination: ARRAY OF CHAR);
(**Copies @oparam{source} into @oparam{destination}, starting at position
@oparam{startPos}. Copying stops when all of @oparam{source} has been
copied, or when the last character of the string value in
@oparam{destination} has been replaced. The string value in
@oparam{destination} is not altered if @oparam{startPos} is greater than or
equal to @samp{Length(source)}.
@precond
@oparam{startPos} is not negative.
@end precond *)
VAR
destLength, i: INTEGER;
BEGIN
destLength := Length (destination);
IF (startPos < destLength) THEN
(* if `startPos' is inside `destination', then replace characters until
the end of `source' or `destination' is reached *)
i := 0;
WHILE (startPos # destLength) & (source[i] # 0X) DO
destination[startPos] := source[i];
INC (startPos);
INC (i)
END
END
END Replace;
PROCEDURE Append* (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
(**Appends @oparam{source} to @oparam{destination}. *)
VAR
destLength, i: INTEGER;
BEGIN
destLength := Length (destination);
i := 0;
WHILE (destLength < LEN (destination)-1) & (source[i] # 0X) DO
destination[destLength] := source[i];
INC (destLength);
INC (i)
END;
destination[destLength] := 0X
END Append;
PROCEDURE Concat* (source1, source2: ARRAY OF CHAR;
VAR destination: ARRAY OF CHAR);
(**Concatenates @oparam{source2} onto @oparam{source1} and copies the result
into @oparam{destination}. *)
VAR
i, j: INTEGER;
BEGIN
(* copy `source1' into `destination' *)
i := 0;
WHILE (source1[i] # 0X) & (i < LEN(destination)-1) DO
destination[i] := source1[i];
INC (i)
END;
(* append `source2' to `destination' *)
j := 0;
WHILE (source2[j] # 0X) & (i < LEN (destination)-1) DO
destination[i] := source2[j];
INC (j); INC (i)
END;
destination[i] := 0X
END Concat;
PROCEDURE CanAssignAll* (sourceLength: INTEGER; VAR destination: ARRAY OF CHAR): BOOLEAN;
(**Returns @code{TRUE} if a number of characters, indicated by
@oparam{sourceLength}, will fit into @oparam{destination}; otherwise returns
@code{FALSE}.
@precond
@oparam{sourceLength} is not negative.
@end precond *)
BEGIN
RETURN (sourceLength < LEN (destination))
END CanAssignAll;
PROCEDURE CanExtractAll* (sourceLength, startPos, numberToExtract: INTEGER;
VAR destination: ARRAY OF CHAR): BOOLEAN;
(**Returns @code{TRUE} if there are @oparam{numberToExtract} characters
starting at @oparam{startPos} and within the @oparam{sourceLength} of some
string, and if the capacity of @oparam{destination} is sufficient to hold
@oparam{numberToExtract} characters; otherwise returns @code{FALSE}.
@precond
@oparam{sourceLength}, @oparam{startPos}, and @oparam{numberToExtract} are
not negative.
@end precond *)
BEGIN
RETURN (startPos+numberToExtract <= sourceLength) &
(numberToExtract < LEN (destination))
END CanExtractAll;
PROCEDURE CanDeleteAll* (stringLength, startPos,
numberToDelete: INTEGER): BOOLEAN;
(**Returns @code{TRUE} if there are @oparam{numberToDelete} characters starting
at @oparam{startPos} and within the @oparam{stringLength} of some string;
otherwise returns @code{FALSE}.
@precond
@oparam{stringLength}, @oparam{startPos} and @oparam{numberToDelete} are not
negative.
@end precond *)
BEGIN
RETURN (startPos+numberToDelete <= stringLength)
END CanDeleteAll;
PROCEDURE CanInsertAll* (sourceLength, startPos: INTEGER;
VAR destination: ARRAY OF CHAR): BOOLEAN;
(**Returns @code{TRUE} if there is room for the insertion of
@oparam{sourceLength} characters from some string into @oparam{destination}
starting at @oparam{startPos}; otherwise returns @code{FALSE}.
@precond
@oparam{sourceLength} and @oparam{startPos} are not negative.
@end precond *)
VAR
lenDestination: INTEGER;
BEGIN
lenDestination := Length (destination);
RETURN (startPos <= lenDestination) &
(sourceLength+lenDestination < LEN (destination))
END CanInsertAll;
PROCEDURE CanReplaceAll* (sourceLength, startPos: INTEGER;
VAR destination: ARRAY OF CHAR): BOOLEAN;
(**Returns @code{TRUE} if there is room for the replacement of
@oparam{sourceLength} characters in @oparam{destination} starting at
@oparam{startPos}; otherwise returns @code{FALSE}.
@precond
@oparam{sourceLength} and @oparam{startPos} are not negative.
@end precond *)
BEGIN
RETURN (sourceLength+startPos <= Length(destination))
END CanReplaceAll;
PROCEDURE CanAppendAll* (sourceLength: INTEGER;
VAR destination: ARRAY OF CHAR): BOOLEAN;
(**Returns @code{TRUE} if there is sufficient room in @oparam{destination} to
append a string of length @oparam{sourceLength} to the string in
@oparam{destination}; otherwise returns @code{FALSE}.
@precond
@oparam{sourceLength} is not negative.
@end precond *)
BEGIN
RETURN (Length (destination)+sourceLength < LEN (destination))
END CanAppendAll;
PROCEDURE CanConcatAll* (source1Length, source2Length: INTEGER;
VAR destination: ARRAY OF CHAR): BOOLEAN;
(**Returns @code{TRUE} if there is sufficient room in @oparam{destination} for
a two strings of lengths @oparam{source1Length} and @oparam{source2Length};
otherwise returns @code{FALSE}.
@precond
@oparam{source1Length} and @oparam{source2Length} are not negative.
@end precond *)
BEGIN
RETURN (source1Length+source2Length < LEN (destination))
END CanConcatAll;
PROCEDURE Compare* (stringVal1, stringVal2: ARRAY OF CHAR): CompareResults;
(**Returns @oconst{less}, @oconst{equal}, or @oconst{greater}, according as
@oparam{stringVal1} is lexically less than, equal to, or greater than
@oparam{stringVal2}. Note that Oberon-2 already contains predefined
comparison operators on strings. *)
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO
INC (i)
END;
IF (stringVal1[i] < stringVal2[i]) THEN
RETURN less
ELSIF (stringVal1[i] > stringVal2[i]) THEN
RETURN greater
ELSE
RETURN equal
END
END Compare;
PROCEDURE Equal* (stringVal1, stringVal2: ARRAY OF CHAR): BOOLEAN;
(**Returns @samp{stringVal1 = stringVal2}. Unlike the predefined operator
@samp{=}, this procedure can be assigned to a procedure variable. *)
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO
INC (i)
END;
RETURN (stringVal1[i] = 0X) & (stringVal2[i] = 0X)
END Equal;
PROCEDURE FindNext* (pattern, stringToSearch: ARRAY OF CHAR; startPos: INTEGER;
VAR patternFound: BOOLEAN; VAR posOfPattern: INTEGER);
(**Looks forward for next occurrence of @oparam{pattern} in
@oparam{stringToSearch}, starting the search at position @oparam{startPos}.
If @samp{startPos < Length(stringToSearch)} and @oparam{pattern} is found,
@oparam{patternFound} is returned as @code{TRUE}, and @oparam{posOfPattern}
contains the start position in @oparam{stringToSearch} of @oparam{pattern}.
The position is a value in the range [startPos..Length(stringToSearch)-1].
Otherwise @oparam{patternFound} is returned as @code{FALSE}, and
@oparam{posOfPattern} is unchanged. If @samp{startPos >
Length(stringToSearch)-Length(Pattern)} then @oparam{patternFound} is
returned as @code{FALSE}.
@precond
@oparam{startPos} is not negative.
@end precond *)
VAR
patternPos: INTEGER;
BEGIN
IF (startPos < Length (stringToSearch)) THEN
patternPos := 0;
LOOP
IF (pattern[patternPos] = 0X) THEN
(* reached end of pattern *)
patternFound := TRUE;
posOfPattern := startPos-patternPos;
EXIT
ELSIF (stringToSearch[startPos] = 0X) THEN
(* end of string (but not of pattern) *)
patternFound := FALSE;
EXIT
ELSIF (stringToSearch[startPos] = pattern[patternPos]) THEN
(* characters identic, compare next one *)
INC (startPos);
INC (patternPos)
ELSE
(* difference found: reset indices and restart *)
startPos := startPos-patternPos+1;
patternPos := 0
END
END
ELSE
patternFound := FALSE
END
END FindNext;
PROCEDURE FindPrev* (pattern, stringToSearch: ARRAY OF CHAR; startPos: INTEGER;
VAR patternFound: BOOLEAN; VAR posOfPattern: INTEGER);
(**Looks backward for the previous occurrence of @oparam{pattern} in
@oparam{stringToSearch} and returns the position of the first character of
the @oparam{pattern} if found. The search for the pattern begins at
@oparam{startPos}. If @oparam{pattern} is found, @oparam{patternFound} is
returned as @code{TRUE}, and @oparam{posOfPattern} contains the start
position in @oparam{stringToSearch} of pattern in the range [0..startPos].
Otherwise @oparam{patternFound} is returned as @code{FALSE}, and
@oparam{posOfPattern} is unchanged. The pattern might be found at the given
value of @oparam{startPos}. The search will fail if @oparam{startPos} is
negative. If @samp{startPos > Length(stringToSearch)-Length(pattern)} the
whole string value is searched. *)
VAR
patternPos, stringLength, patternLength: INTEGER;
BEGIN
(* correct `startPos' if it is larger than the possible searching range *)
stringLength := Length (stringToSearch);
patternLength := Length (pattern);
IF (startPos > stringLength-patternLength) THEN
startPos := stringLength-patternLength
END;
IF (startPos >= 0) THEN
patternPos := 0;
LOOP
IF (pattern[patternPos] = 0X) THEN
(* reached end of pattern *)
patternFound := TRUE;
posOfPattern := startPos-patternPos;
EXIT
ELSIF (stringToSearch[startPos] # pattern[patternPos]) THEN
(* characters differ: reset indices and restart *)
IF (startPos > patternPos) THEN
startPos := startPos-patternPos-1;
patternPos := 0
ELSE
(* reached beginning of `stringToSearch' without finding a match *)
patternFound := FALSE;
EXIT
END
ELSE (* characters identic, compare next one *)
INC (startPos);
INC (patternPos)
END
END
ELSE
patternFound := FALSE
END
END FindPrev;
PROCEDURE FindDiff* (stringVal1, stringVal2: ARRAY OF CHAR;
VAR differenceFound: BOOLEAN;
VAR posOfDifference: INTEGER);
(**Compares the string values in @oparam{stringVal1} and @oparam{stringVal2}
for differences. If they are equal, @oparam{differenceFound} is returned as
@code{FALSE}, and @code{TRUE} otherwise. If @oparam{differenceFound} is
@code{TRUE}, @oparam{posOfDifference} is set to the position of the first
difference; otherwise @oparam{posOfDifference} is unchanged. *)
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (stringVal1[i] # 0X) & (stringVal1[i] = stringVal2[i]) DO
INC (i)
END;
differenceFound := (stringVal1[i] # 0X) OR (stringVal2[i] # 0X);
IF differenceFound THEN
posOfDifference := i
END
END FindDiff;
PROCEDURE Capitalize* (VAR stringVar: ARRAY OF CHAR);
(**Applies the function @code{CAP} to each character of the string value in
@oparam{stringVar}. *)
VAR
i: INTEGER;
BEGIN
i := 0;
WHILE (stringVar[i] # 0X) DO
stringVar[i] := CAP (stringVar[i]);
INC (i)
END
END Capitalize;
END ooc2Strings.