DIRECTORY BigCardinals USING [BigCARD], IO USING [STREAM], Rope USING [ROPE], SafeStorage USING [Type]; Scheme: CEDAR DEFINITIONS ~ BEGIN Any: TYPE ~ REF ANY; PrimitiveSyntax: TYPE ~ REF PrimitiveSyntaxRep; PrimitiveSyntaxRep: TYPE ~ {quote, define, setBang, lambda, begin, if}; Pair: TYPE ~ REF PairRep; PairRep: TYPE ~ RECORD [car, cdr: Any]; ProperList: TYPE ~ Pair; Symbol: TYPE ~ ATOM; SimpleVector: TYPE ~ REF SimpleVectorRep; SimpleVectorRep: TYPE ~ RECORD [SEQUENCE length: NAT OF Any]; Vector: TYPE ~ REF VectorRep; VectorRep: TYPE ~ RECORD [ length: INT, ref: PROC [self: Vector, index: INT] RETURNS [Any], set: PROC [self: Vector, index: INT, value: Any], data: REF ANY ]; Char: TYPE ~ REF CHAR; String: TYPE ~ REF StringRep; StringRep: TYPE ~ RECORD [ base: Rope.ROPE, buffer: REF TEXT ¬ NIL, where: INT ¬ 0 ]; Port: TYPE ~ IO.STREAM; Fixnum: TYPE ~ REF INT; -- small integers; always exact NumberKind: TYPE ~ {flonum, bignum, ratnum, complex, general}; Number: TYPE ~ REF NumberRep; NumberRep: TYPE ~ RECORD [ exact: BOOL, v: SELECT tag: NumberKind FROM flonum => [real: REAL], bignum => [neg: BOOL, magnitude: BigCardinals.BigCARD], ratnum => [numerator, denominator: Any], complex => [x, y: Any], general => [class: REF, data: Any], ENDCASE ]; Flonum: TYPE ~ REF NumberRep.flonum; Bignum: TYPE ~ REF NumberRep.bignum; Ratnum: TYPE ~ REF NumberRep.ratnum; Complex: TYPE ~ REF NumberRep.complex; Record: TYPE ~ REF RecordRep; RecordRep: TYPE ~ RECORD [SEQUENCE length: NAT OF Any]; Environment: TYPE ~ REF EnvironmentRep; EnvironmentRep: TYPE ~ RECORD [ parent: Environment, -- the static link names: SimpleVector, -- of Symbols mark: CARDINAL ¬ 0, -- for internal use values: SEQUENCE size: NAT OF Any ]; Procedure: TYPE ~ Any; Primitive: TYPE ~ REF PrimitiveRep; PrimitiveRep: TYPE ~ RECORD [ minArgs: [0..256), -- minimum number of args maxArgs: [0..256), -- max. number of args, not including rest dotted: BOOL, -- if TRUE, allow extra args proc: PROC [Primitive, Any, Any, Any, ProperList] RETURNS [Any], doc: Rope.ROPE, -- documentation data: REF, -- implementation's data symbol: Symbol -- for error reporting ]; Syntax: TYPE ~ REF SyntaxRep; SyntaxRep: TYPE ~ RECORD [ expander: Procedure -- maps the (unevaluated) parameters to the form. ]; false: READONLY Any; true: READONLY Any; endOfFile: READONLY Any; unspecified: READONLY Any; -- when there is nothing better to return undefined: READONLY Any; -- a value a Scheme program cannot get to emptyString: READONLY String; symbolForPrimitiveSyntaxRep: READONLY REF ARRAY PrimitiveSyntaxRep OF Symbol; primitiveSyntaxForPrimitiveSyntaxRep: READONLY REF ARRAY PrimitiveSyntaxRep OF PrimitiveSyntax; Marker: TYPE ~ MACHINE DEPENDENT { list0, list1, list2, list3, listN, dottedList, symbolTable, symbol, quote, define, setBang, lambda, begin, if, true, false, char, string, vector, zero, one, inexact, negFixnum, fixnum, negFlonum, flonum, negBignum, bignum, ratnum, complex, unspecified, byteCodes, byteCodeTemplate }; ReadBinary: PROC [stream: IO.STREAM, symbolTable: SimpleVector ¬ NIL, encodingID: BYTE ¬ 0] RETURNS [Any]; WriteBinary: PROC [a: Any, stream: IO.STREAM, encodingID: BYTE ¬ 0]; Cons: PROC [a, b: Any] RETURNS [Pair]; Car: PROC [any: Any] RETURNS [Any]; Cdr: PROC [any: Any] RETURNS [Any]; ListLength: PROC [a: Any] RETURNS [INT]; Reverse: PROC [a: Any] RETURNS [Any]; MakeBoolean: PROC [b: BOOL] RETURNS [Any]; TheBOOL: PROC [any: Any] RETURNS [BOOL]; True: PROC [any: Any] RETURNS [BOOL]; False: PROC [any: Any] RETURNS [BOOL]; MakeChar: PROC [char: CHAR] RETURNS [Char]; TheChar: PROC [any: Any] RETURNS [Char]; StringFromRope: PROC [rope: Rope.ROPE] RETURNS [String]; RopeFromString: PROC [string: String] RETURNS [Rope.ROPE]; StringLength: PROC [string: String] RETURNS [INT]; StringRef: PROC [string: String, i: INT] RETURNS [CHAR]; StringSet: PROC [string: String, i: INT, c: CHAR]; TheString: PROC [any: Any] RETURNS [String]; MakeFixnum: PROC [int: INT] RETURNS [Fixnum]; MakeReal: PROC [negative: BOOL, numerator, denominator: BigCardinals.BigCARD, exponent: INT, radix: INT, exact: BOOL] RETURNS [Any]; MakeRectangular: PROC [realPart, imagPart: Any] RETURNS [Any]; MakePolar: PROC [magnitude, angle: Any] RETURNS [Any]; KCheck: PROC [any: Any, max: INT ¬ INT.LAST] RETURNS [INT]; TheINT: PROC [any: Any] RETURNS [INT]; TheCARD: PROC [any: Any] RETURNS [CARD]; TheREAL: PROC [a: Any] RETURNS [REAL]; IsInteger: PROC [a: Any] RETURNS [BOOL]; TheInteger: PROC [a: Any] RETURNS [Any]; TheFlonum: PROC [a: Any] RETURNS [Flonum]; TheComplex: PROC [a: Any] RETURNS [Complex]; Negative: PROC [any: Any] RETURNS [BOOL]; Exact: PROC [a: Any] RETURNS [BOOL]; ConvertExactness: PROC [a: Any, exact: BOOL] RETURNS [Any]; Arith: PROC [op: ArithOp, a: Any, b: Any] RETURNS [Any]; ArithOp: TYPE ~ {plus, minus, mult, divide, quotient, remainder, equality, compare}; VectorFromList: PROC [a: Any] RETURNS [Any]; VectorLength: PROC [a: Any] RETURNS [INT]; VectorRef: PROC [a: Any, i: INT] RETURNS [Any]; VectorSet: PROC [a: Any, i: INT, value: Any]; ThePort: PROC [a: Any] RETURNS [Port]; Read: PROC [stream: IO.STREAM, forceLower: BOOL ¬ TRUE] RETURNS [Any]; ReadRope: PROC [rope: Rope.ROPE, forceLower: BOOL ¬ TRUE] RETURNS [Any]; Print: PROC [a: Any, stream: IO.STREAM, depth: INT ¬ INT.LAST, width: INT ¬ INT.LAST]; PrintProc: TYPE ~ PROC [stream: IO.STREAM, value: Any, display: BOOL] RETURNS [ok: BOOL ¬ TRUE]; RegisterPrintProc: PROC [proc: PrintProc, type: SafeStorage.Type]; RegisterFallbackPrintProc: PROC [proc: PrintProc]; RegisterSimplePrintProc: PROC [typeName: Rope.ROPE, type: SafeStorage.Type]; TheROPE: PROC [a: Any] RETURNS [Rope.ROPE]; SymbolFromRope: PROC [Rope.ROPE] RETURNS [Symbol]; RopeFromSymbol: PROC [Symbol] RETURNS [Rope.ROPE]; IsProcedure: PROC [any: Any] RETURNS [BOOL]; ProcedureDocumentation: PROC [procedure: Procedure] RETURNS [Rope.ROPE]; MakeContinuation: PROC RETURNS [Procedure]; Expand: PROC [form: Any, env: Environment] RETURNS [Any]; Compile: PROC [form: Any, env: Environment] RETURNS [Any]; Eval: PROC [exp: Any, env: Environment] RETURNS [Any]; Apply: PROC [proc: Procedure, arguments: Any] RETURNS [Any]; GetUserEnvironment: SIGNAL RETURNS [env: Environment]; ReadEvalPrintLoop: PROC [in, out: IO.STREAM, userEnv: Environment]; Complain: ERROR [object: Any, msg: Rope.ROPE]; -- primitives raise this to bail out NewEnvironmentStructure: PROC RETURNS [userEnv: Environment]; InitializeEnvironmentStructure: PROC [userEnv: Environment]; LookupVariableValue: PROC [variable: Any, env: Environment] RETURNS [Any]; SetVariableValue: PROC [variable: Any, value: Any, env: Environment] RETURNS [ok: BOOL]; DefineVariable: PROC [variable: Any, value: Any, env: Environment]; DefinePrimitive: PROC [name: Rope.ROPE, nArgs: NAT, dotted: BOOL, proc: PROC [Primitive, Any, Any, Any, ProperList] RETURNS [Any], doc: Rope.ROPE, env: Environment, data: REF ¬ NIL, optional: NAT ¬ 0]; ExportVariable: PROC [fromEnv, toEnv: Environment, fromName, toName: Symbol]; RegisterInit: PROC [initProc: PROC [Environment]]; END. @ Scheme.mesa Copyright Σ 1987, 1991 by Xerox Corporation. All rights reserved. Michael Plass, March 3, 1989 12:56:07 pm PST Last changed by Pavel on March 20, 1989 3:53:24 pm PST Primitive Syntax Cons cells Symbols Vectors Characters and Strings I/O Ports Numeric types Records Environments if names # NIL, these are the slots for local variables if name = NIL, env[0] is a RefTab.Ref, and env[1] is the identifier for this environment Procedures May be a Primitive or some kind of compiled procedure. Concrete types for compiled procedures are defined elsewhere to allow them to evolve more freely. Up to 3 required args are passed in the Any slots. Any additional required args are consed to the front of the list of optional args and passed in the ProperList slot. Syntax Special Values NIL represents an empty list External Binary Representation This defines the codes used for binary (fast-loading) external representations. ReadBinary is used by the Read implemention, and is here only for completeness. encodingID allows for the possibility of supporting different encodings. Operations Lists Note: Car and Cdr also work for LIST OF REF ANY Booleans Requires #t or #f Scheme semantics for truth values (i.e., what if does) NOT True[any] Characters Keeps a table of small values to avoid having to allocate Strings Numbers Keeps a table of small values to avoid having to allocate Compute and return the appropriate real number that is (perhaps approximately) equal to (IF negative THEN -1 ELSE 1) * (numerator / denominator) * (radix ^ exponent) any must represent an exact non-negative integer not exceeding max, or we Complain any must represent an integer that can fit in an INT, or we Complain any must represent an integer that can fit in a CARD, or we Complain Result will be either a Fixnum or a Bignum, or else we Complain Tests for a negative real number; complains if not real. Vectors Ports The absolute value of depth controls how deeply the printer recurs. If depth is negative, the printer behaves as if the Scheme primitive display were used, as opposed to write. The width parameter is only used in the printing of lists and vectors. Customizing the printer display is true iff this PrintProc is being called from within a use of the Scheme primitive display as opposed to write. When it is convenient to provide a SafeStorage.Type, this form of registration is prefered, as the PrintRefProc will be registerd in a hash table. The type is that of the referent. When it is clumsy to get a SafeStorage.Type for the referent (for example, for LIST types), use this form of registration. The fallback printers are called in order (most-recently-registered first) until one of them returns TRUE. For many purposes, any printed representation will do as long as it contains the name of the type of the object. This registers procs that simply print the name of the type and the address of the object. For example: #. Again, the type is that of the referent. ROPEs Convenience for implementations of Primitives; coerces Strings into ROPEs Procedures Continuations Gets the current continuation, packaged as a procedure of one argument Evaluation Calls the system syntax expander to expand the form Performs a relatively fast compilation, returning a Procedure if successful and #!unspecified otherwise. Applying the returned Procedure (which takes no arguments) evaluates the compiled version of the given form in the given environment. Essentially an abbreviation for Apply[Compile[Expand[exp, env], env], NIL]. Applys proc to arguments; arguments is a ProperList. Any continuations formed within proc or its callees become unusable when Apply returns or UNWINDs. Note: the apply primitive does not use this. It is provided for primitives that cannot be implemented using CallWith, e.g., because they need to apply a function form within a Cedar callback. Raised by the evaluator (i.e., Expand, Eval, and Apply) and certain primitives that need to know the USER environment, in which they are virtually "closed". Top-level callers of Expand, Eval or Apply need to handle this. Uses in and out as the (current-input-port) and (current-output-port) and userEnv as the USER environment for a Scheme read-eval-print loop. Calling the Scheme procedure (quit), defined in the USER environment, will exit the loop and cause this Cedar procedure to return. Unlike Expand, Compile, Eval, and Apply, callers of this need not handle any special signals. Errors Environments This creates a new, initialized copy of the initial environment structure as documented in the Scheme manual. This assumes that userEnv is linked to the "right" ancestors, as described in the Scheme manual; it redefines all of the built-in variables. The initProc will get called with the USER environment whenever a new top-level environment is created. This is how an initial environment is set up. Κ K•NewlineDelimiter –(cedarcode) style™šœ ™ Icodešœ Οeœ7™BK™,K™6K™—šΟk ˜ Kšœ žœ ˜Kšžœžœžœ˜Kšœžœžœ˜Kšœ žœ˜—K™KšΠlnœžœž ˜šœž˜K˜Kšœžœžœžœ˜—head™Kšœžœžœ˜/Kšœžœ/˜G—™ Kšœžœžœ ˜Kšœ žœžœ˜'Kšœ žœ˜—™Kšœžœžœ˜—™Kšœžœžœ˜)š œžœžœžœ žœžœ˜=K˜—Kšœžœžœ ˜šœ žœžœ˜Kšœžœ˜ Kšœžœžœžœ˜3Kšœžœžœ˜1Kšœžœž˜ Kšœ˜——™Kšœžœžœžœ˜Kšœžœžœ ˜šœ žœžœ˜Kšœ žœ˜Kšœžœžœžœ˜Kšœžœ˜Kšœ˜K˜——™ Kšœžœžœžœ˜—™ šœžœžœžœΟc˜7K˜—šœ žœ.˜>K˜—Kšœžœžœ ˜šœ žœžœ˜Kšœžœ˜ šœžœž˜Kšœžœ˜Kšœžœ#˜7Kšœ(˜(Kšœ˜Kšœžœ ˜#Kšž˜—Kšœ˜K˜—Kšœžœžœ˜$Kšœžœžœ˜$Kšœžœžœ˜$Kšœ žœžœ˜&—™Kšœžœžœ ˜Kš œ žœžœžœ žœžœ˜7—™ Kšœ žœžœ˜'šœžœžœ˜Kšœ ˜'Kšœ  ˜"Kšœžœ ˜'šœžœžœžœ˜!Kšœ žœ)™7Kšœ žœ  œ ™X—Kšœ˜——šœ ™ šœ žœ˜Kšœ™™™K˜—Kšœ žœžœ˜#šœžœžœ˜Kšœ ˜,Kšœ *˜=Kšœžœ ˜*šœžœ(žœ˜@Iargsšœ¨™¨—Kšœ žœ ˜ Kšœžœ ˜#Kšœ ˜%Kšœ˜——™Kšœžœžœ ˜šœ žœžœ˜Kšœ 1˜EKšœ˜——™K™Kšœžœ˜Kšœžœ˜Kšœ žœ˜Kšœ žœ )˜DKšœ žœ )˜BKšœ žœ˜Kš œžœžœžœžœ˜MKš œ&žœžœžœžœ˜_—™šœ’™’šœžœžœž œž˜ΎK˜—KšΟn œžœ žœžœžœžœžœ˜jš ‘ œžœžœžœžœ˜DKšœH™H———™ ™Kš‘œžœ žœ˜&K™/Kš‘œžœ žœ˜#Kš‘œžœ žœ˜#K˜Kš‘ œžœ žœžœ˜(Kš‘œžœ žœ˜%—™Kš‘ œžœžœžœ˜*š‘œžœ žœžœ˜(K™—š‘œžœ žœžœ˜%Kšœ.Οoœ™6—š‘œžœ žœžœ˜&Kšœ ™ ——™ š‘œžœžœžœ˜+K™9—Kš‘œžœ žœ˜(—™Kš‘œžœ žœžœ ˜8Kš‘œžœžœžœ˜:Kš‘ œžœžœžœ˜2Kš ‘ œžœžœžœžœ˜8Kš‘ œžœžœžœ˜2Kš‘ œžœ žœ ˜,—™š‘ œžœžœžœ ˜-K™9—š‘œžœ žœ:žœ žœ žœžœ˜„™WK™M——Kš‘œžœžœ˜>Kš‘ œžœžœ˜6K˜š‘œžœžœžœžœžœžœ˜;K™R—š‘œžœ žœžœ˜&K™D—š‘œžœ žœžœ˜(K™D—Kš‘œžœ žœžœ˜&K˜Kš‘ œžœ žœžœ˜(š‘ œžœ žœ˜(K™?—Kš‘ œžœ žœ ˜*Kš‘ œžœ žœ ˜,š‘œžœ žœžœ˜)K™8—Kš‘œžœ žœžœ˜$Kš‘œžœžœžœ˜;š‘œžœžœ˜8Kšœ žœG˜T——™Kš‘œžœ žœ˜,Kš‘ œžœ žœžœ˜*Kš‘ œžœ žœžœ˜/Kš‘ œžœ žœ˜-—™Kš‘œžœ žœ˜&Kš‘œžœ žœžœžœžœžœ˜FKš ‘œžœ žœžœžœžœ˜Hš‘œžœžœžœ žœžœžœ žœžœžœ˜VKšœŠΟfœ£œI™ω—™šœ žœžœ žœžœžœžœžœžœ˜`Kšœ]£œ£œ™y—K˜š‘œžœ+˜BKšœ΅™΅—š‘œžœ˜2Kšœζ™ζ—š‘œžœžœ˜LKšœ˜™˜K˜———™š‘œžœ žœžœ˜+K™I—Kš‘œžœžœžœ ˜2Kš‘œžœ žœžœ˜2—™ Kš‘ œžœ žœžœ˜,Kš‘œžœžœžœ˜H—™ š‘œžœžœ ˜+K™F——™ š‘œžœžœ˜9K™3—š‘œžœžœ˜:K™ο—š‘œžœžœ˜6K™K—š‘œžœ#žœ˜