LIB_DEF 'betaenv' '../lib';
BODY 'private/betaenvbody';
(*
* COPYRIGHT
* Copyright (C) Mjolner Informatics, 1984-2003
* All rights reserved.
*
* This fragment implements the very basic patterns, utilized by most
* BETA programs
*)
-- betaenv: descriptor --
(# <<SLOT lib: attributes>>;
(******************************************************************)
(* The simple patterns for simple values and variables. These
* simple patterns are treated special by the compiler.
*)
integer: (* 32 bit signed long *) (# #);
shortInt: (* 16 bit unsigned half *) (# #); (* do not use shortInt anymore,
* use int16u instead.
*)
char: (* 8 bit unsigned byte *) (# #);
boolean: (* 8 bit unsigned byte, values 0 or 1 *) (# #);
false: boolean (* 8 bit unsigned byte with value 0 *) (# #);
true: boolean (* 8 bit unsigned byte with value 1 *) (# #);
real: (* double precision floating point number *) (# #);
real32: (* single precision real for bytecode only *) (# #);
int8: (* 8 bit signed integer *) (# #);
int8u: (* 8 bit unsigned integer *) (# #);
int16: (* 16 bit signed integer *) (# #);
int16u: (* 16 bit unsigned integer.
* int16u will eventually replace shortInt *) (# #);
int32: (* 32 bit signed integer
* int32 is semantically identical to integer *) (# #);
int32u: (* 32 bit unsigned integer *) (# #);
(* int64 and int64u are NOT yet implemented;
* the compiler allows variables of these types,
* but no operations, including assignment,
* are implemented, so don't use them.
*)
int64: (* 64 bit signed integer *) (# #);
int64u: (* 64 bit unsigned integer *) (# #);
(* The pattern wchar is for experimenting with implementing
* support for the UniCode character set. The name wchar
* is preliminary. wchar is semantically identical to int16u.
* Patterns wcharValue and wcharObject have also been introduced below
*)
wchar: (# #); (* 16 bit unsigend integer *)
(* The pattern COM is a general super pattern for
* objects that may used with Microsoft COM
*)
COM: (# #);
(* Holder is general superpattern for holder-patterns used for
* parameters in COM.
*)
Holder: (# adr: @integer #);
object: (* General superpattern *)
(# _struc:
(* Exit a pattern reference for THIS(Object).
* Is now obsolete: the new form obj## is preferred
* to the old form obj.struc
*)
(#
exit this(object)##
#);
_new:
(* returns a new object, that is qualified exactly
* as THIS(object)
*)
(# newObj: ^object; oType: ##object
do this(object)##->oType##; &oType[]->newObj[]; INNER _new
exit newObj[]
#);
_state:
(* Pattern _state is for experimental purpose only
* and using it may give undefined results
*)
(# S: ##object
enter S##
...
#)
do INNER object
#);
(* idx *)
(* The following patterns define 'real' patterns corresponding to
* the predefined simple patterns
*)
integerValue: (# value: @integer do INNER integerValue exit value #);
integerObject: integerValue(# enter value do INNER integerObject #);
charValue: (# value: @char do INNER charValue exit value #);
charObject: charValue(# enter value do INNER charObject #);
wcharValue: (# value: @wchar do INNER wcharValue exit value #);
wcharObject: wcharValue(# enter value do INNER wcharObject #);
booleanValue: (# value: @boolean do INNER booleanValue exit value #);
trueValue: booleanValue(# do true->value; INNER trueValue #);
falseValue: booleanValue(# do false->value; INNER falseValue #);
booleanObject: booleanValue(# enter value do INNER booleanObject #);
trueObject: booleanObject(# do true->value; INNER trueObject #);
falseObject: booleanObject(# do false->value; INNER falseObject #);
realValue: (# value: @real do INNER realValue exit value #);
realObject: realValue(# enter value do INNER realObject #);
textValue: (# value: ^text do INNER textValue exit value[] #);
textObject: textValue(# enter value[] do INNER textObject #);
(**** Integer limits *********************************************)
MaxInt8: (# exit 0x7f #);
MinInt8: (# exit 0x80 #);
MaxInt8u: (# exit 0xff #);
MinInt8u: (# exit 0x00 #);
MaxInt16: (# exit 0x7fff #);
MinInt16: (# exit 0x8000 #);
MaxInt16u: (# exit 0xffff #);
MinInt16u: (# exit 0x0000 #);
MaxInt32: (# exit 0x7fffffff #);
MinInt32: (# exit 0x80000000 #);
MaxInt32u: (# exit 0xffffffff #);
MinInt32u: (# exit 0x00000000 #);
MaxInt: (# exit MaxInt32 #);
MinInt: (# exit MinInt32 #);
MaxReal: (# exit 1.797693134862315E+308 #);
MinReal: (# exit 2.225073858507201E-308 #);
(**** Implementation dependent constants *************************)
infReal: (* Returns the real value 'Infinity' *)
realValue(# ... #);
(***** Functional patterns ***************************************)
min: (* Returns the minimum of 2 integers *)
(# a,b: @integer
enter (a,b)
do (if (a < b) then a->b if)
exit b
#);
max: (* Returns the maximum of 2 integers *)
(# a,b: @integer
enter (a,b)
do (if (a < b) then b->a if)
exit a
#);
abs: (* Returns the absolute value of an integer *)
(# n: @integer
enter n
do (if (n < 0) then -n->n if)
exit n
#);
(***** Simple standard input/output patterns *********************)
keyboard, screen: ^stream;
get:
(# ch: @char;
getC: ^stream.get
do (if getC[]=NONE then &keyboard.get[]->getC[] if);
getC->ch;
INNER;
exit ch
#);
put:
(# ch: @char;
putC: ^stream.put
enter ch
do (if putC[] = NONE then &screen.put[] -> putC[] if);
INNER;
ch->putC
#);
newline:
(# newL: ^stream.newline
do (if newL[] = NONE then &screen.newline[] -> newL[] if);
INNER;
newL
#);
putint:
(# i: @integer;
putI: ^stream.putInt
enter i
do (if puti[] = NONE then &screen.putint[] -> putI[] if);
INNER;
i->putI;
#);
puttext:
(# t: ^text;
putT: ^stream.puttext;
enter t[]
do (if putT[] = NONE then &screen.puttext[] -> putT[] if);
INNER;
t[]->putT;
#);
putline:
(# t: ^text;
putL: ^stream.putline;
enter t[]
do (if putL[] = NONE then &screen.putline[] -> putL[] if);
INNER;
t[]->putL;
#);
getint:
(# i: @integer;
getI: ^stream.getInt;
do (if getI[] = NONE then &keyboard.getint[] -> getI[] if);
INNER;
getI -> i;
exit i
#);
getNonBlank:
(# ch: @char;
getNB: ^stream.getNonBlank;
do (if getNB[] = NONE then &keyboard.getNonBlank[] -> getNB[] if);
INNER;
getNB -> ch;
exit ch
#);
scanAtom:
(# scanA: ^stream.scanAtom;
do (if scanA[] = NONE then &keyboard.scanAtom(# do INNER scanAtom #)[] -> scanA[] if);
scanA;
#);
getAtom:
(# t: ^text;
getA: ^stream.getAtom;
do (if getA[] = NONE then &keyboard.getAtom[] -> getA[] if);
INNER;
getA -> t[];
exit t[]
#);
getline:
(# t: ^text;
getL: ^stream.getLine;
do (if getL[] = NONE then &keyboard.getline[] -> getL[] if);
INNER;
getL -> t[];
exit t[]
#);
(***** Control patterns ******************************************)
forTo: (* for 'inx' in [low:high] do INNER forTo *)
(# low, high, inx: @integer;
enter (low, high)
...
#);
cycle: (* Executes INNER forever *)
(# ... #);
loop:
(# while:< booleanValue(# do true->value; INNER while #);
until:< booleanValue;
whilecondition: @while;
untilcondition: @until;
...
#);
qua:
(* Pattern replacing the BETA language construct QUA. To be
* used as 't1[]->qua(# as::< Tn #)->t2[]'. The 'qua' pattern
* checks, whether 't1' is qualified by 'Tn'. If not, the
* 'quaError' exception is invoked. Otherwise, a reference
* qualified by 'Tn', and referring to the same object as 't1[]'
* is referring, is returned.
*)
(# as:< object; R: ^object; thisObj: ^as;
quaError:< exception
(# do 'Qualification error'->msg.append; INNER quaError #)
enter R[]
...
exit thisObj[]
#);
(***** Stream patterns *******************************************)
stream:
(# <<SLOT streamLib: attributes>>;
length:< integerValue (* returns the length of THIS(stream) *)
(#
do -1->value; INNER length
#);
position: (* current position of THIS(stream) *)
(#
enter setPos
exit getPos
#);
eos:< (* returns 'true' if THIS(stream) is at end-of-stream *)
booleanValue;
reset: (* sets 'position' to zero *)
(#
do 0->setPos
exit THIS(stream)[]
#);
peek:< (* looks at the next character of THIS(stream) *)
(# ch: @char
do INNER peek
exit ch
#);
get:< (* reads a character from THIS(stream) *)
(# ch: @char
do INNER get
exit ch
#);
getNonBlank:
(* Reads first non-whitespace character from THIS(stream).
* If called at end-of-stream the character 'ascii.fs' is
* returned
*)
(# ch: @char;
skipblanks: @scanWhiteSpace;
testEOS: @EOS;
getCh: @get;
...
exit ch
#);
getint: integerValue
(* Reads an integer: skips whitespace characters and
* returns the following digits.
*
* See numberio.bet for more numerical output operations
*)
(# syntaxError:< streamException
(#
...
#);
geti: @...
do geti; INNER getint
#);
getAtom:<
(* Returns the next atom (i.e. sequence of non-white
* characters - skipping leading blanks)
*)
(# txt: ^text;
do &text[]->txt[]; INNER getAtom;
exit txt[]
#);
getline:<
(* Reads a sequence of characters until nl-character
* appears and returns the characters read.
*)
(# txt: ^text;
missing_newline:< Object
(* Called if last line of THIS(Stream) is
* not terminated by a newline character.
*);
do &text[]->txt[]; INNER getline
exit txt[]
#);
asInt:
(* converts THIS(text) to an integer value, ignoring
* leading and trailing whitespace. See numberio.bet for
* more numerical conversion operations.
*)
(# i: @integer;
syntaxError:< streamException
(#
...
#);
...
exit i
#);
put:< (* writes a character to THIS(stream) *)
(# ch: @char
enter ch
do INNER put
exit THIS(stream)[]
#);
newline: (* writes the nl-character *)
(#
do ascii.newline->put
exit THIS(stream)[]
#);
putint:
(* Writes an integer to THIS(stream); The format may be
* controlled by the 'signed', 'blankSign', 'width',
* 'adjustLeft' and 'zeroPadding' variable attributes.
* 'width' is extended if it is too small. Examples:
* '10->putint' yields: '10'; '10*pi->putint(# do 10->width;
* true->adjustLeft #)' yields: '10 '; and '10->putint(# do
* 10->width; true->zeroPadding #)' yields: '0000000010'.
*
* See numberio.bet for more numerical output operations
*)
(# n: @integer;
signed: @boolean
(* If integer is positive, a '+' will always be
* displayed
*);
blankSign: @boolean
(* If integer is positive, a ' ' space is displayed as
* the sign. Ignored if 'signed=true'
*);
width: @integer
(* Minimum width *);
adjustLeft: @boolean
(* Specifies if the number is to be aligned left or
* right, if padding of spaces is necessary to fill up
* the specified width.
*);
zeroPadding: @boolean
(* width is padded with leading zero instead of
* spaces. Ignored if 'adjustLeft=true'
*);
format:< (# do INNER format #);
puti: @...
enter n
do 1->width; format; INNER putint; puti
exit THIS(stream)[]
#);
puttext:< (* Writes a text to THIS(stream). *)
(# txt: ^text
enter txt[]
do (if txt[]<>NONE then INNER puttext if)
exit THIS(stream)[]
#);
putline:
(* 'puttext' followed by 'newline' *)
(# T: ^text; putT: @puttext; newL: @newline
enter T[]
do INNER putline; T[]->putT; newL
exit THIS(stream)[]
#);
scan:
(* Scan chars from current position in THIS(stream) while
* '(ch->while)=true'; perform INNER for each char being
* scanned
*)
(# while:<
(# ch: @char; value: @boolean
enter ch
do true->value; INNER while
exit value
#);
ch: @char;
whilecondition: @while;
testEOS: @EOS;
getPeek: @peek;
getCh: @get;
...
exit THIS(stream)[]
#);
scanWhiteSpace: scan
(* Scan whitespace characters *)
(# while::< (# do ch->ascii.isWhiteSpace->value #)
do INNER scanWhiteSpace
exit THIS(stream)[]
#);
scanAtom:
(* Scan until first non-whitespace char. Scan the next
* sequence of non-whitespace chars. Stop at first
* whitespace char. For each non-whitespace char an INNER
* is performed. Usage: 'scanAtom(# do ch-><destination> #)'
*)
(# ch: @char;
...
exit THIS(stream)[]
#);
scanToNl:
(* Scan all chars in current line including newline char *)
(# ch: @char; getCh: @get;
missing_newline:< Object
(* Called if last line of THIS(Stream) is
* not terminated by a newline character.
*);
...
exit THIS(stream)[]
#);
streamException: exception
(# do INNER streamException #);
EOSerror:< streamException
(* Raised from 'get' and 'peek' when attempted to read past
* the end of the stream.
*)
(#
do 'Attempt to read past end-of-stream'->msg.putline;
INNER EOSerror
#);
otherError:< streamException
(* Raised when some other kind of stream error apart from
* the one mentioned above occurs.
*);
getPos:< (* returns current position of THIS(Stream) *)
integerValue;
setPos:< (* sets current position in THIS(stream) to 'p' *)
(# p: @integer
enter p
do INNER setPos
exit THIS(stream)[]
#)
#); (* pattern stream *)
(***** Text pattern **********************************************)
text: stream
(* A text is a sequence of characters. Let 'T: @text'. The
* range of 'T' is '[1,T.length]'. A text can be initialized by
* executing 'T.clear' or by assigning it another (initialized)
* text. A text-constant has the form 'foo'. The 'text' pattern
* is primarily intended for small texts but there is no upper
* limit in the size. However, most of the operations becomes
* less efficient with larger texts.
*)
(# <<SLOT textLib: attributes>>;
length::< (* Returns the length of THIS(text) *)
(# do lgth->value; INNER length #);
eos::<
(# ... #);
empty:
(# exit (lgth = 0) #);
clear: (* Sets the length and position of THIS(text) to zero *)
(#
do 0->pos->lgth
exit THIS(text)[]
#);
equal: booleanValue
(* Tests if THIS(text) is equal to the entered text. If
* 'NCS' is further bound to 'trueObject', the comparison
* will be done Non Case Sensitive.
*)
(# txt: ^text;
NCS:< booleanObject
enter txt[]
...
#);
equalNCS: equal
(* As 'equal', except the the comparison will be done Non
* Case Sensitive
*)
(# NCS:: trueObject #);
less: booleanValue
(* Tests whether the entered text 'T1[1: length]' is less
* than 'THIS(text)[1: T1.length]'. The lexicographical
* ordering is used.
*)
(# T1: ^text
enter T1[]
...
#);
greater: booleanValue
(* Tests whether the entered text 'T1[1: length]' is
* greater than 'THIS(text)[1: T1.length]'. The
* lexicographical ordering is used.
*)
(# T1: ^text
enter T1[]
...
#);
peek::<
(* Returns the character at current position; does not
* update 'position'
*)
(# ... #);
get::<
(* Returns the character at current position; increments
* 'position'
*)
(# ... #);
inxGet: charValue
(* Returns the character at position 'i' *)
(# i: @integer;
iget: @...
enter i
do iget
#);
getAtom::<
(* Returns the next atom (i.e. sequence of non-white
* characters - skipping leading blanks)
*)
(# ... #);
getline::<
(* Reads a sequence of characters until nl-character
* appears and returns the characters read.
*)
(# ... #);
put::<
(* writes the character 'ch' at current position in
* THIS(text); increments 'position'
*)
(# ... #);
inxPut:
(* Replaces the character at position 'i' *)
(# ch: @char;
i: @integer;
iput: @...
enter (ch,i)
do iput
exit THIS(text)[]
#);
puttext::<
(# ... #);
append:
(* Appends a text to THIS(text); does not change 'position'
*)
(# T1: ^text
enter T1[]
...
exit THIS(text)[]
#);
prepend:
(* Inserts the text in 'T1' in front of THIS(text); updates
* current position to 'position+T1.length' if 'position>0'
*)
(# T1: ^text
enter T1[]
...
exit THIS(text)[]
#);
insert:
(* Inserts a text before the character at position 'inx'.
* Note: inx<1 means inx=1; inx>length means inx=length+1.
* If 'position>=inx' then 'position+T1.length->position'.
*)
(# T1: ^text;
inx: @integer
enter (T1[],inx)
...
exit THIS(text)[]
#);
delete:
(* Deletes THIS(text)[i: j]; updates current position:
* i<=position<j => i-1->position
* j<=position => position-(j-i+1)->position
*)
(# i,j: @integer;
deleteT: @...
enter (i,j)
do deleteT
exit THIS(text)[]
#);
makeLC: (* Converts all characters to lower case *)
(# ...
exit THIS(text)[]
#);
makeUC:
(* Converts all characters to upper case *)
(# ...
exit THIS(text)[]
#);
sub:
(* Returns a copy of THIS(text)[i:j]. If 'i<1', 'i' is
* adjusted to 1. If 'j>length', 'j' is adjusted to
* 'length'. If (after adjustment) 'i>j', an empty text is
* returned.
*)
(# i,j: @integer; T1: ^text;
subI: @...
enter (i,j)
do subI
exit T1[]
#);
copy:
(# T1: ^text;
copyI: @...
do copyI
exit T1[]
#);
scanAll:
(* Scans all the elements in THIS(text). For 'ch' in '[1:
* THIS(text).length]' do INNER
*)
(# ch: @char
do (for i: lgth repeat T[i]->ch; INNER scanAll for)
exit THIS(text)[]
#);
find:
(* find all occurrences of the character 'ch' in
* THIS(text), executing INNER for each occurrence found,
* beginning at 'THIS(text).position'. 'inx' will contain
* the position of each 'ch' in THIS(text). If 'NCS' is
* further bound to 'trueObject', the comparison will be
* done Non Case Sensitive. If 'from' is further bound, the
* search will begin at position 'from'.
*)
(# ch: @char;
inx: @integer;
NCS:< booleanObject;
from:< integerObject(# do pos->value; INNER from #)
enter ch
...
exit THIS(text)[]
#);
findAll: find
(* As 'find', except that the entire text will be searched.
* Replaces 'findCh' in previous versions of betaenv (v1.4
* and earlier)
*)
(# from:: (# do 0->value #)
do INNER findAll
#);
findText:
(* find all occurrences of the 'txt' in THIS(text),
* executing INNER for each occurrence found, beginning at
* 'THIS(text).position'. 'inx' will contain the position
* of the first character of each occurrence found
* THIS(text). If 'NCS' is further bound to 'trueObject',
* the comparison will be done Non Case Sensitive. If
* 'from' is further bound, the search will begin at
* position 'from'.
*)
(# txt: ^text;
inx: @integer;
NCS:< booleanObject;
from:< integerObject(# do pos->value; INNER from #)
enter txt[]
...
exit THIS(text)[]
#);
findTextAll: findText
(* As 'findText', except that the entire text will be
* searched
*)
(# from:: (# do 0->value #)
do INNER findTextAll
#);
extend:
(* Extend THIS(text) with 'L' (undefined) chars. Notice
* that it is only the representation of the THIS(text),
* that is extended, the 'length' and 'position' are not
* changed.
*)
(# L: @integer
enter L do L->T.extend
exit THIS(text)[]
#);
indexError:< streamException
(* Raised from 'Check' when the index goes outside the
* range of the text. Message: "Index error in text!".
*)
(# inx: @integer
enter inx
...
#);
EOSerror::<
(* Raised from 'get' and 'peek' when the end of the stream is
* passed.
*)
(# ... #);
otherError::<
(* Raised when an error other than the Index-/EOSerror
* occurs.
*)
(# ... #);
setPos::<
(# ... #);
getPos::<
(# do pos->value; INNER getPos #);
(* Private attributes: !!OBS!! The 3 attributes 'T', 'lgth'
* and 'pos' declared below MUST be the first data items
* declared in 'stream' and 'text' since their addresses are
* hardcoded into the compiler.
*)
T: [16] @char;
lgth,pos: (* 16 is default size *) @integer;
setT: (# enter T do T.range->lgth->pos #)
enter setT
exit T[1: lgth]
#) (* Pattern text *);
(***** ASCII character constants and attributes ******************)
ascii: @
(# <<SLOT asciiLib: attributes>>;
nul: (# exit 0 #);
soh: (# exit 1 #);
stx: (# exit 2 #);
etx: (# exit 3 #);
eot: (# exit 4 #);
enq: (# exit 5 #);
ack: (# exit 6 #);
bel: (# exit 7 #);
bs: (# exit 8 #);
ht: (# exit 9 #);
nl: (# exit 10 #);
vt: (# exit 11 #);
np: (# exit 12 #);
cr: (# exit 13 #);
so: (# exit 14 #);
si: (# exit 15 #);
dle: (# exit 16 #);
dc1: (# exit 17 #);
dc2: (# exit 18 #);
dc3: (# exit 19 #);
dc4: (# exit 20 #);
nak: (# exit 21 #);
syn: (# exit 22 #);
etb: (# exit 23 #);
can: (# exit 24 #);
em: (# exit 25 #);
sub: (# exit 26 #);
esc: (# exit 27 #);
fs: (# exit 28 #);
gs: (# exit 29 #);
rs: (# exit 30 #);
us: (# exit 31 #);
sp: (# exit 32 #);
capA: (# exit 65 #);
smalla: (# exit 97 #);
del: (# exit 127 #);
newline: @char; (* either 'lf' or 'cr' *)
init: ...;
upCase: @charObject
(# ... #);
lowCase: @charObject
(# ... #);
testChar: booleanValue
(# ch: @char
enter ch
do INNER testchar
#);
isUpper: @testChar
(# ... #);
isLower: @testChar
(# ... #);
isDigit: @testChar
(# ... #);
isLetter: @testChar
(# ... #);
isSpace: @testChar
(* True if 'ch' in {sp,cr,nl,np,ht,vt} *)
(# ... #);
isWhiteSpace: @testChar
(* True if 'ch' is a whitespace char *)
(# ... #);
private: @...
#);
(***** Exception Patterns ****************************************)
stop:
(* Terminates program execution:
* termCode=normal : normal termination;
* termCode=failure : abnormal termination;
* termCode=failureTrace : abnormal termination with trace of
* run-time stack on dump-file;
* termCode=dumpStack : Trace of run-time stack on console
* without termination.
*
* 'T' will be printed on the screen.
*)
(# termCode: @integer; T: ^text
enter (termCode,T[])
...
#);
normal: (# exit 0 #);
failure: (# exit -1 #);
failureTrace: (# exit -2 #);
dumpStack: (# exit -3 #);
(***** Object Pool ***********************************************)
objectPool: @
(# <<SLOT objectPoolLib: attributes>>;
get:
(# type:< object;
obj: ^type;
exact:< booleanValue;
init:< object(* Called if an object was created *)
...
exit obj[]
#);
strucGet:
(# type: ##object;
obj: ^object;
exact:< booleanValue;
init:< object(* Called if an object was created *);
enter type##
...
exit obj[]
#);
scan:
(* Scan through all objects in 'objectPool', (at least)
* qualified by 'type'.
*)
(# type:< object;
current: ^type;
exact:< booleanValue;
...
#);
strucScan:
(* Scan through all objects in 'objectPool', (at least)
* qualified by 'type'
*)
(# type: ##object;
current: ^object;
exact:< booleanValue
enter type##
...
#);
put:
(* Puts a given object into 'objectPool'. If an object with
* (at least) the qualification of the given object is
* already present in 'objectPool', the exception
* 'alreadyThere' is raised.
*)
(# obj: ^object;
exact:< booleanValue;
alreadyThere:< exception;
putObj: @...
enter obj[]
do putObj
#);
private: @...;
#);
(***** Command line arguments ************************************)
argumentHandlerType:
(#
noOfArguments:<
(* Return the number of arguments on command line.
* The number includes the program name.
*)
integervalue;
getArgByNumber:<
(* Returns argument number argNo.
* Number 1 is the program name,
* number 2 is the first program argument, etc.
*)
(# argNo: @integer; theArg: ^text;
enter argNo
do INNER
exit theArg[]
#);
#);
rawArgumentHandler: argumentHandlerType
(#
noOfArguments::
(# ... #);
getArgByNumber::
(# ... #);
#);
expandWildcardsArgumentHandler: argumentHandlerType
(# private: @...;
noOfArguments::
(# ... #);
getArgByNumber::
(# ... #);
#);
argumentHandler: ^argumentHandlerType;
(* Backwards compatible interface *)
noOfArguments: integervalue(# do argumentHandler.noOfArguments -> value #);
arguments:
(# argNo: @integer; theArg: ^text;
enter argNo
do argNo -> argumentHandler.getArgByNumber -> theArg[]
exit theArg[]
#);
(* Explicit array - currently only supported by bytecode implementations *)
ArgVector: [0]^text;
(******************************************************************)
(* External language interface: See file 'external.bet' for further
* patterns.
*)
External:
(* Is only meaningful with interface to externals *)
(# callC,callPascal,pascal,pascalTrap,callStd,
cExternalEntry,pascalExternalEntry,stdExternalEntry: @text
#);
cStruct:
(* Super-pattern for describing structures which can be given
* 'by refererence' (using the usual [] notation) to an external
* function (e.g. a C function described as a specialization
* of the above External pattern). See file external.bet for
* supported operations on cStruct.
*)
(# <<SLOT cStructLib: attributes>>;
(* 'R' is the bytestream containing THIS(cStruct).
* MUST be declared as the first attribute
*);
R: [(byteSize-1) div 4 + 1] @integer;
byteSize:<
(* Number of bytes in THIS(cStruct) *)
IntegerObject;
BoundsExceeded:< Exception
(* Raised if indexing outside range of R *)
(# inx: @integer;
enter inx
...
#);
chk: @(# inx: @integer enter inx ... #);
#);
data:
(* The 'data' pattern may be used for definining simple data
* objects. Data-objects have no 'type' information. They can
* thus NOT be allocated dynamically in the BETA heap. They do
* not have the overhead of extra attributes used for virtual
* dispatch and garbage collection. One main use of data-objects
* is as interface to external data such as 'cstruct'. For
* details see the manuals
*)
(# #);
(* Basic types used for bytecode platforms *)
ExternalClass:
(# classname: @text;
do INNER;
#);
class:
(# (*classname: @text;*) #);
proc:
(# procname: @text; #);
static_proc: (# procname: @text #);
cons: (# procname: @text #);
static_cons: (# procname: @text #);
Structure:
(# (* representing a descriptor sctrurure/ptn variable *)#);
doGC: (* will force a garbage collection to happen *)
(# ... #);
machine_type:
(* Exits a reference to a copy of a text indicating the machine
* type in lowercase, e.g. 'sun4s', 'linux', 'nti'.
*)
(# T: @Text;
...
exit T.copy
#);
program: (* descriptor executed by this environment *)
...;
theProgram: ^|program;
theScheduler: ^|object
(* Scheduler installed by 'basicSystemEnv' (if used in program) *);
(******************************************************************)
(* The following patterns are only used by the compiler and should
* NOT be used for other purposes.
*)
repetition:
(# range: (* Returns the range of THIS(repetition) *)
(# n: @integer
exit n
#);
new:
(* Allocates a new repetition of 'n' elements. The previous
* elements in THIS(repetition) become inaccessible
* hereafter
*)
(# n: @integer
enter n
#);
extend:
(* Extends THIS(repetition) by 'n' elements. The existing
* elements are retained. The new elements are allocated
* after the existing elements (i.e. with index from the
* 'range+1')
*)
(# n: @integer
enter n
#)
#);
state: (# #); (* Pattern STATE is for experimental purpose only
* and using it may give undefined results
*)
errorName: (# #);
exception:
(# <<SLOT exceptionLib: attributes>>;
msg:
(* append text to this 'msg' variable to specify
* the exception error message for
* this(exception)
*)
@text;
continue: @boolean
(* the value of this variable determines the
* control-flow behaviour of this(exception):
* true: continue execution after exception
* false: terminate execution by calling
* 'stop'; default
*);
error:
(* used to define local exception conditions
* which can be handled separately. All error's
* that are not handled separately will be
* handled by this(exception)
*)
(# <<SLOT errorExceptionLib: attributes>>
do false->continue;
INNER;
'**** Error processing\n'->msg.prepend;
(if not continue then this(exception) if)
#);
_notify: error
(* used to define local notification conditions
* which can be handled separately. All
* 'notify's that are not handled separately
* will be handled by this(exception)
*)
(# <<SLOT notifyExceptionLib: attributes>>
do true->continue; INNER
#);
propagate:<
(* if further bound to trueObject, this(exception) allows
* propagation (i.e. this(exception will _not_ terminate)
*)
(* This is to make exception backward compatible *)
booleanValue;
termCode: @integer;
(* Arg. To pattern 'stop'; initial failureTrace *)
...
#);
(* Notification is used to make the new exceptions backward compatible *)
notification: exception
(# do true->continue; INNER notification #);
unknown: exception
(# <<SLOT unknownExceptionLib: attributes>>;
original: ^object;
do INNER
#);
try:
(# <<SLOT tryExceptionLib: attributes>>;
handler:<
(* invoked automatically bu the try block in the search for a
* when clause
*)
(# <<SLOT tryHandlerExceptionLib: attributes>>;
when:
(# <<SLOT tryHandlerWhenExceptionLib: attributes>>;
current: ^type;
type:< object;
predicate:< booleanValue;
continue:
(# ... #);
retry:
(# ... #);
propagate:
(# ... #);
abort:
(# ... #);
do ...
#);
current: ^object; status: @(*private*)integer;
private: @...
enter current[]
do ...
exit status
#);
finally:< (# do INNER; #);
name:< (# n: ^text do INNER exit n[] #);
private: @...
...
#);
throw:
(# <<SLOT throwExceptionLib: attributes>>;
current: ^object;
private: @...
enter current[]
...
#);
init: ...;
betaenvPrivate: @...;
(******************************************************************)
do (#
...
#)
#)
| 13.2 Betaenv Interface | © 1990-2004 Mjølner Informatics |
[Modified: Monday September 1st 2003 at 15:49]
|