=
BEGIN
Creating an initial environment
The following procedure builds an initial environment with standard input and output streams as supplied. Everything bound in an environment is immutable, but may be a location. The locations bound in initial environments created by separate calls to RussellMkInitEnv are guaranteed not to alias (except possibly for the standard input and output streams themselves). Note most types are constructed once, at module initialization, and are shared in all initial environments.
RussellMkInitEnv:
PUBLIC PROCEDURE [in:
IO.
STREAM, out:
IO.
STREAM]
RETURNS [RTTuple]
=
BEGIN
stdout: REF IO.STREAM;
stdin: REF IO.STREAM;
initEnv: RTTuple;
stdin ← NEW[ IO.STREAM ← in ];
stdout ← NEW[ IO.STREAM ← out ];
initEnv ← MkTuple[name~$stdin, value~stdin];
initEnv ← PrependProc[tuple~initEnv, name~$getString, body~GetStringBody];
initEnv ← PrependValue[tuple~initEnv, name~$stdout, value~stdout];
initEnv ← PrependProc[tuple~initEnv, name~$putString, body~PutStringBody];
initEnv ← PrependValue[tuple~initEnv, name~$character, value~characterCluster];
initEnv ← PrependValue[tuple~initEnv, name~$characterString, value~characterStringCluster];
initEnv ← PrependValue[tuple~initEnv, name~$boolean, value~booleanCluster];
initEnv ← PrependValue[tuple~initEnv, name~$integer, value~integerCluster];
RETURN[ initEnv ]
END ; -- RussellMkInitEnv
The standard input stream.
The representation is a Cedar IO.STREAM. The only operation is reading a string.
GetStringBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ inputStream -> characterString.val ]
=
BEGIN
token: Rope.ROPE;
tokenKind: IO.TokenKind;
stdin: IO.STREAM;
WITH arg
SELECT
FROM
rs: REF IO.STREAM => stdin ← rs^ ;
ENDCASE => ERROR RTError[$badArg];
[token~token, tokenKind~tokenKind] ← IO.GetCedarTokenRope[stream~stdin];
SELECT tokenKind
FROM
tokenERROR, tokenEOF => RETURN[ NIL ] ;
ENDCASE => RETURN[ NEW[ Rope.ROPE ← token ]]
END ; -- GetStringBody
The standard output stream.
The representation is a Cedar IO.STREAM. The only operation is printing a string.
PutStringBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [string:characterString.val, stream:outputStream] -> [] ]
=
BEGIN
r: Rope.ROPE;
stdout: IO.STREAM;
WITH SelectFromTuple[arg,$string]
SELECT
FROM
rr: REF Rope.ROPE => r ← rr^ ;
ENDCASE => ERROR RTError[$badArg];
WITH SelectFromTuple[arg,$stream]
SELECT
FROM
rs: REF IO.STREAM => stdout ← rs^ ;
ENDCASE => ERROR RTError[$badArg];
IO.PutF[stdout, "%g", IO.rope[r]];
RETURN[ NIL ]
END ; -- PutStringBody
The boolean cluster
The representation is {t:[]}, with the usual Boolean operations provided in the cluster.
booleanCluster: RTTuple; -- Initialized below.
booleanValType: RTValue ← NIL;
trueValue: RTValue ← NIL; -- Initialized below to MkTuple[name~$t, value~NIL];
falseValue: RTValue ← NIL;
BooleanAndBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> val ]
=
BEGIN
a: BOOL ← QueryTuple[tuple~SelectFromTuple[arg,$a], name~$t];
b: BOOL ← QueryTuple[tuple~SelectFromTuple[arg,$b], name~$t];
RETURN[ IF a AND b THEN trueValue ELSE falseValue ]
END ; -- BooleanAndBody
BooleanOrBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> val ]
=
BEGIN
a: BOOL ← QueryTuple[tuple~SelectFromTuple[arg,$a], name~$t];
b: BOOL ← QueryTuple[tuple~SelectFromTuple[arg,$b], name~$t];
RETURN[ IF a OR b THEN trueValue ELSE falseValue ]
END ; -- BooleanOrBody
BooleanNotBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ val -> val ]
=
BEGIN
RETURN[ IF QueryTuple[tuple~arg, name~$t] THEN trueValue ELSE falseValue ]
END ; -- BooleanNotBody
The character cluster
The representation is Cedar CHAR. The only operations are conversions to integer and characterString.
characterCluster: RTTuple; -- Initialized below.
characterValType: RTValue ← NIL;
CharacterFromIntBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ integer.val -> val ]
=
BEGIN
i: INT;
WITH arg
SELECT
FROM
ri: REF INT => i ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ NEW[ CHAR ← (IO.NUL + i) ]];
END ; -- CharacterFromIntBody
CharacterToIntBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ val -> integer.val ]
=
BEGIN
c: CHAR;
WITH arg
SELECT
FROM
rc: REF CHAR => c ← rc^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ NEW[ INT ← (c - IO.NUL) ]];
END ; -- CharacterToIntBody
CharacterFromStringBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ characterString.val -> val ]
=
BEGIN
r: Rope.ROPE;
WITH arg
SELECT
FROM
rr: REF Rope.ROPE => r ← rr^ ;
ENDCASE => ERROR RTError[$badType];
IF Rope.Length[r] = 0
THEN ERROR RTError[$nullString];
RETURN[ NEW[ CHAR ← Rope.Fetch[r] ]];
END ; -- CharacterFromStringBody
CharacterToStringBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ val -> characterString.val ]
=
BEGIN
c: CHAR;
WITH arg
SELECT
FROM
rc: REF CHAR => c ← rc^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ NEW[ Rope.ROPE ← Rope.FromChar[c] ]];
END ; -- CharacterToStringBody
The characterString cluster
The representation is Cedar Rope.ROPE.
characterStringCluster: RTTuple; -- Initialized below.
characterStringValType: RTValue ← NIL;
emptyCharacterStringValue: RTValue; -- Initialized below.
CharacterStringLengthBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ characterString.val -> integer.val ]
=
BEGIN
r: Rope.ROPE;
WITH arg
SELECT
FROM
rr: REF Rope.ROPE => r ← rr^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ NEW[ INT ← Rope.Length[r] ] ]
END ; -- CharacterStringLengthBody
CharacterStringSubstrBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [string:characterString.val, start:integer.val, length:integer.val] -> characterString.val ]
=
BEGIN
string: Rope.ROPE;
start: INT;
length: INT;
WITH SelectFromTuple[arg,$string]
SELECT
FROM
rr: REF Rope.ROPE => string ← rr^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$start]
SELECT
FROM
ri: REF INT => start ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$length]
SELECT
FROM
ri: REF INT => length ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ NEW[ Rope.ROPE ← Rope.Substr[string, start, length] ] ]
END ; -- CharacterStringSubstrBody
CharacterStringConcatBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:characterString.val, b:characterString.val] -> characterString.val ]
=
BEGIN
a: Rope.ROPE;
b: Rope.ROPE;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
rr: REF Rope.ROPE => a ← rr^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
rr: REF Rope.ROPE => b ← rr^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ NEW[ Rope.ROPE ← Rope.Concat[a, b] ] ]
END ; -- CharacterStringConcatBody
The integer cluster
The representation is Cedar INT, with the usual operations provided in the cluster.
integerCluster: RTTuple; -- Initialized below.
integerValType: RTValue ← NIL;
lowPredefinedInteger: INT ~ 0;
highPredefinedInteger: INT ~ 1024;
PredefinedInteger: TYPE = INT [lowPredefinedInteger..highPredefinedInteger];
predefinedIntegerValue: ARRAY PredefinedInteger OF RTValue;
MkPredefinedIntegerValues:
PRIVATE
PROCEDURE []
=
BEGIN
i: INT;
FOR i ← lowPredefinedInteger, i+1
WHILE i <= highPredefinedInteger
DO
predefinedIntegerValue[i] ← NEW[ INT ← i ]
ENDLOOP
END ; -- MkPredefinedIntegerValues
MkIntegerValue:
PRIVATE
PROCEDURE [n: INT]
RETURNS [RTValue]
=
INLINE
BEGIN
RETURN [
IF (n >= lowPredefinedInteger)
AND (n <= highPredefinedInteger)
THEN predefinedIntegerValue[n]
ELSE NEW[ INT ← n ]
]
END ; -- MkIntegerValue
IntegerAddBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ MkIntegerValue[a+b] ]
END ; -- IntegerAddBody
IntegerSubtractBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ MkIntegerValue[a-b] ]
END ; -- IntegerSubtractBody
IntegerMultiplyBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ MkIntegerValue[a*b] ]
END ; -- IntegerMultiplyBody
IntegerDivideBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ MkIntegerValue[a/b] ]
END ; -- IntegerDivideBody
IntegerLessBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> boolean.val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ IF a < b THEN trueValue ELSE falseValue ]
END ; -- IntegerLessBody
IntegerLeqBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> boolean.val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ IF a <= b THEN trueValue ELSE falseValue ]
END ; -- IntegerLeqBody
IntegerEqBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> boolean.val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ IF a = b THEN trueValue ELSE falseValue ]
END ; -- IntegerEqBody
IntegerNeqBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> boolean.val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ IF a # b THEN trueValue ELSE falseValue ]
END ; -- IntegerNeqBody
IntegerGeqBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> boolean.val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ IF a >= b THEN trueValue ELSE falseValue ]
END ; -- IntegerGeqBody
IntegerGreaterBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ [a:val,b:val] -> boolean.val ]
=
BEGIN
a, b: INT;
WITH SelectFromTuple[arg,$a]
SELECT
FROM
ri: REF INT => a ← ri^ ;
ENDCASE => ERROR RTError[$badType];
WITH SelectFromTuple[arg,$b]
SELECT
FROM
ri: REF INT => b ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ IF a > b THEN trueValue ELSE falseValue ]
END ; -- IntegerGreaterBody
IntegerToStringBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ val -> characterString.val ]
=
BEGIN
n: INT;
WITH arg
SELECT
FROM
ri: REF INT => n ← ri^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ NEW[ Rope.ROPE ← Convert.RopeFromInt[n] ]];
END ; -- IntegerToStringBody
IntegerFromStringBody:
PRIVATE RTCodeBody
[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]
Russell type: func[ characterString.val -> val ]
=
BEGIN
r: Rope.ROPE;
WITH arg
SELECT
FROM
rr: REF Rope.ROPE => r ← rr^ ;
ENDCASE => ERROR RTError[$badType];
RETURN[ MkIntegerValue[ Convert.IntFromRope[r] ] ];
END ; -- IntegerFromStringBody
Create Boolean cluster.
trueValue ← MkTuple[name~$t, value~NIL];
falseValue ← NIL;
booleanCluster ← MkTuple[name~$val, value~booleanValType];
booleanCluster ← PrependValue[tuple~booleanCluster, name~$false, value~falseValue];
booleanCluster ← PrependValue[tuple~booleanCluster, name~$true, value~trueValue];
booleanCluster ← PrependProc[tuple~booleanCluster, name~$not, body~BooleanNotBody];
booleanCluster ← PrependProc[tuple~booleanCluster, name~$and, body~BooleanAndBody];
booleanCluster ← PrependProc[tuple~booleanCluster, name~$or, body~BooleanOrBody];
Create character cluster.
characterCluster ← MkTuple[name~$val, value~characterValType];
characterCluster ← PrependProc[tuple~characterCluster, name~$fromInt, body~CharacterFromIntBody];
characterCluster ← PrependProc[tuple~characterCluster, name~$toInt, body~CharacterToIntBody];
characterCluster ← PrependProc[tuple~characterCluster, name~$fromString, body~CharacterFromStringBody];
characterCluster ← PrependProc[tuple~characterCluster, name~$toString, body~CharacterToStringBody];
Create characterString cluster.
characterStringCluster ← MkTuple[name~$val, value~characterStringValType];
emptyCharacterStringValue ← NIL;
characterStringCluster ← PrependValue[tuple~characterStringCluster, name~$empty, value~emptyCharacterStringValue];
characterStringCluster ← PrependProc[tuple~characterStringCluster, name~$length, body~CharacterStringLengthBody];
characterStringCluster ← PrependProc[tuple~characterStringCluster, name~$substr, body~CharacterStringSubstrBody];
characterStringCluster ← PrependProc[tuple~characterStringCluster, name~$concat, body~CharacterStringConcatBody];
Create integer cluster.
MkPredefinedIntegerValues[];
integerCluster ← MkTuple[name~$val, value~integerValType];
integerCluster ← PrependProc[tuple~integerCluster, name~Atom.MakeAtom["*"], body~IntegerMultiplyBody];
integerCluster ← PrependProc[tuple~integerCluster, name~Atom.MakeAtom["/"], body~IntegerDivideBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$toString, body~IntegerToStringBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$fromString, body~IntegerFromStringBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$less, body~IntegerLessBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$leq, body~IntegerLeqBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$eq, body~IntegerEqBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$neq, body~IntegerNeqBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$geq, body~IntegerGeqBody];
integerCluster ← PrependProc[tuple~integerCluster, name~$greater, body~IntegerGreaterBody];
integerCluster ← PrependProc[tuple~integerCluster, name~Atom.MakeAtom["-"], body~IntegerSubtractBody];
integerCluster ← PrependProc[tuple~integerCluster, name~Atom.MakeAtom["+"], body~IntegerAddBody];
END .