<> <> <> DIRECTORY Rope USING [ROPE, Fetch, FromChar, Length, Substr, Concat], IO USING [STREAM, NUL, PutF, rope, TokenKind, GetCedarTokenRope], Atom USING [MakeAtom], Convert USING [RopeFromInt, IntFromRope], RussellRuntime USING [RTError, RTValue, RTTuple, MkTuple, SelectFromTuple, QueryTuple, RTCodeBody, PrependValue, PrependProc], RussellInterp; RussellInitEnvImpl: CEDAR PROGRAM IMPORTS Rope, IO, Atom, Convert, RussellRuntime EXPORTS RussellInterp = BEGIN OPEN RussellRuntime ; <> <> 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 <> <> GetStringBody: PRIVATE RTCodeBody <<[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]>> < 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 <> <> PutStringBody: PRIVATE RTCodeBody <<[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]>> < [] ]>> = 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 <> <> 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]>> < 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]>> < 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]>> < val ]>> = BEGIN RETURN[ IF QueryTuple[tuple~arg, name~$t] THEN trueValue ELSE falseValue ] END ; -- BooleanNotBody <> <> characterCluster: RTTuple; -- Initialized below. characterValType: RTValue _ NIL; CharacterFromIntBody: PRIVATE RTCodeBody <<[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]>> < 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]>> < 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]>> < 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]>> < 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 <> <> characterStringCluster: RTTuple; -- Initialized below. characterStringValType: RTValue _ NIL; emptyCharacterStringValue: RTValue; -- Initialized below. CharacterStringLengthBody: PRIVATE RTCodeBody <<[ env: RTTuple, arg: RTValue, ip: REF ANY ] RETURNS[RTValue]>> < 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]>> < 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]>> < 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 <> <> 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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]>> < 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 <> 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]; <> 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]; <> 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]; <> 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 .