510.84 I I 6r I LL I NO I S UN I VERS I TY DEPARTMENT no. 843 OF COMPUTER SCIENCE cop. x. REPORT UNIVERSITY OF ILLINOIS LIBRARY AT URBANA-CHAMFAIQN The person charging this material is re- sponsible for its return to the library from which it was withdrawn on or before the Latest Date stamped below. Theft, mutilation, and underlining of books are reasons for disciplinary action and may result in dismissal from the University. To renew call Telephone Center, 333-8400 UNIVERSITY OF ILLINOIS LIBRARY AT URBANA-CHAMPAIGN FES i 2 RET L161— O-1096 3/C-. < | P H A S E 1 1 i J i i for The convenience of the programmer, ASPEN has many shorthand notations for its basic language constructs. Particularly, in the DCL statement, limited factoring of ":type" is permitted using the general form of the DCL statement: ASPEN LANGUAGE SPECIFICATIONS DCL HI,.. ., idn: type <-• constructor J., . . . , const ructorm; where m.TOP:| O.0O0000I i 1 .STK: | • — -»- I J ->(1) : | 0.OO0000I (2) : |0.000000| i i (N) : | 0.000000I STACK1 and STACK1.STK are constant pointers. Pointers nay be passed to procedures, returned by functions, assigned to other variables, compared for equality and used in conditional expressions, but only if the pointers involved have the same type. Note, however, that no ":type" clause is permitted when declaring a pointer using a literal n-tuple constructor. In ASPEN, each textual instance of a literal n-tuple constructor defines a unique type, which becomes the type of the n-tuple pointer. Consider, for example, the declarations DCL A, B, C <-. {(10) <-0} ; DCL AA, BB CC <-• ((10)<-i0); DCL X, Y, Z <-. (RE, IPK-.0}; DCL XX, YY, ZZ <- {RE, IM<-.0}; which define twelve pointer variables of four different types. Although A and AA are defined to have the same structure, they do not have the same type because they are initialized by different textual instances of the array constructor. Therefore, the values of A and AA cannot be compared or interchanged in an ASPEN program. On the other hand. A, B, and C have the same type, so they may be used interchangeably. The uniqueness of literal n-tuple constructors and the exact type correspondence required by ASPEN severely limit the programs that can be written to manipulate literally defined arrays and records — all n-tuples to be manipulated must have been defined in the same DCL statement. The manipulation of array and record elements, however, is not limited by these rules. Since A {1} and AA{3} and X.PE are all of type REAL they may be combined in expressions with each other and with other values of type REAL. ASPEN LANGUAGE SPECIFICATIONS A.2.S. 'Js^r-D^f ined Types For greater flexibility and improved prograa readability, literal constructors should be qiven meaningful names using the TYPE definition statement: T YP p id: type = constructor; The TYPE statement declares "id" to be a function that, each *ime it is invoked, creates an object that. has the same structure as the objects created by the "constructor" but has typp "id". The value returned by the type function is the value computer) by the "constructor 1 * — i«.e. a REAL number or a pointer +o a STRING or n -tuple. Type functions may also be declared th° syntax with parameters using ^YP 17 Ld(id1_: tynel_;...; idn: typen) : type = constructor; wher° "typei" is either REAL, STRING, or an identifier declared in a TYPH statement. In all invocations of the type function, the typ? of each argument must match the "type" declared in the TYPE statement. (If several parameters are to have the same type, the typ:» nam-* may be factored out of the parameter list in the form H i3 f id, •• • : type 11 . ) Parameters may be used in any cortext that is valid for a variable of the same type as the parameter. Some samples are TYPE INTEGER (I: PEAL): REAL = FLOOR(I); TYPE REALARRAY(N: REAL) = {(N) <- 0}; TYPE CPLX(X, Y: REAL) = {RE, IW: REAL <-• X, Y} ; After a type function has been declared, its name can be used to declare th 3 f ype of an identifier and the function itself can be used as a constructor in subsequent DCL or TYPE statements or as a normal function in an expression. For example, DCL N1, N2: INTEGEF <-• INTEGER(N2), DCL A, 3, C: CPLX <- CPLX(0,0); DCL X: REALARRAY <-. R E AL ARR A Y ( 1 0) ; TY^E C^LXVEC(N: PEAL; X: CPLX) = {(N) INTEGER (N3) CPLX <-. X} ; the type name in the above examples; to name is declaring the type of the while to the right of <-• the t yp? Not* 3 the two roles of the left of <-» the type identifier (s) ♦ o its left, ram° is invoking the function to create an object of that type. ^o avoid unnecessary writinq, ":type-name bond type-name..." may b rt abbreviated "bond type-name...". (Note that this abbreviated form of tyoe specification literally defined arrays and records.) must be used with S^c. A. 2. 5 USER-DEFINED TYPES 9 The coaponents of an n-tuple that has been created by a type function are referenced in the same manner as the components of a literally defined n-tuple — e.g . . we may write A. RE or X{1} based on the above definitions. Th« only operations defined on user-defined types are assignment, identity comparison, parameter passing and conditional selection. In all operations there must be exact type match; there are no "mixed mode" expressions in ASPEM. Even types defined using REAL constructors are not considered to match type REAL. ASPEN does provide, however, a mechanism for writing conversion procedures should the programmer wish to convert between defined types (see discussion of REP below). An important and freguent use of the ASPEN TYPE definition is to bind the unigua type generated by a textual instance of a literal n-tuple constructor to an identifier that can be used many places in a program. Once a structure has been given a user-defined type name, separate instances of the structure can be declared in separate DCL statements using the name both as type declarer and structure constructor, and all instances will have the same type. For example, DCL Y <- REALARPAY(50) ; Declares a REALARRAY pointer that can be compared against and assigned to th^ REALARRAY pointer X declared above. Type parameters are not considered in determining proper type agreement; only the type names must match. For example, a variable of type REALARRAY may be assigned a REALARRAY of any size. A. 2. 6. The Special Constructor: NIL To permit the definition of recursive data structures, ASPEN provides the constructor, NIL, which creates a null value whose type matches any ASPEN type. Using NIL, a representation of a binary tree might be defined TYPE TREE(S: STRING) = {NAHE: STRING <-. S; LEFT, RIGHT: TREE <-. NIL}; Without NIL, TREE could not be defined recursively, since there would be no way to stop the generation of TREEs once the recursive TREE function had been invoiced. Using this type function, the computation tree, CT, for "A«-B*C" could be constructed as follows: 10 ASPEM LANGUAGE SPECIFICATIONS DCL CT <-« t'PFE ("♦") ; CT.LE^T <- TPEF ("A") ; CT. RIGHT <-• T , REE("* n ); CT, RIGHT. LEFT <^. TRFE("B"); CT. RIGHT. RIGHT <-• TRFE("C"); P ach r°f ir^nc to ^RFE, as a function, creates a new 3-tuple and returns a Doin^^r to it. Since the pointer is of type "TREE" it may be assigned to fields LEFT and PIGHT of existing TREE records. In a arhi^ rar pointer, h^ teste quali fie automati A It hough data str recursiv anvpl ac» necpssar recur ily io The I agai I I i o n call y inte ucture e typ a con y for sivp m, val nst of if nri Q d s, t c d stan the data structure the field gualifi cation may be hut it is illegal to attempt to qualify a null up returned by NIL is unique and any field may this value at runtime to avoid th° illegal a null pointer. This test is performed the control verb SRUNCHK is in effect. to facilitate the declaration of recursive h» MIL operator is not restricted to use in a f ini+ions. NIL is a value that is valid t is valid. It always assumes the type context in which it is used. ":tyn» <-• MIL" may h° shortened to ":type". For REAL types, NIL is equal to 0; for STRING types, NIL is equal to "". A. 2.7. The R^P Oualifipr because of th- 3 strict typp rule, the ASPEN programmer occasionally wan + s to treat objects of a defined type T as if they w n r° of thp typp returned by the constructor in the -i^fini^.ion of T. For this purpose, the field name qualifier REP (for REPresentation) may be used. For example, if we have the declarations ^Y^E STACK = LIST; DCL X <^ STACK; and wish to pass x to proepdure F written for arguments of type LIST, we must write F(X.REP) to avoid a type conflict between X and th<=> reguirempn^s of F. PEP may bp used as often as desired to successively pp^l off the type names applied to an object. For e xam ol », if TYPE LIST - PEAHRPAY (20) ; then X.R^P.RFP is of type REALARRAY. PFP may also be combined wi*h other qualifiers. For example, if we have the declaration: OCL AX = {(10) <-. STACK} ; Sec. A. 2. 7 THE REP QUALIFIER 11 then AX(1}.REP is a LIST, AX {1} . REP. REP is a REALARRAY, and AX {1} .REP. REP. SIZE is 20. A. 2. 8. Punctions The general form of a function declaration is PUNC id parm-list: type bond constructor IS declarations and statements END id; which declares "id" to be a function that returns values of type "type". ":type" or "bond constructor" may be omitted in accordance with the rules covered in Sections A. 2 and A.2.6. The returned value of the function is initially the value of "constructor", but it may be changed through references to "id.VAL" as a variable (unless the "bond" was "=") • ASPEN permits the abbreviation FUNC id parm-list: type= constructor; for FUNC id parm-list: type = constructor IS END id; For example, SORT might be written: FUNC SQRT(X: REAL): REAL = EXP (LOG (X) /2) ; A. 2. 8.1. Types as Functions Note that functions in the abbreviated form differ from TYPE declarations in Section A. 2. 5 only in the initial keyword. In fact, ASPEN TYPFs and FONCs are the same in all respects except that a TYPE function gives the returned value a new type naie, while in a FUNC the type of the returned value is the same as the type of the constructor. Except for the implications of returned type, the preceding and following discussions about ASPEN functions apply egually to ASPEN type functions. Treating TYPE definitions as function definitions permits arbitrarily complex initialization code to be associated with user-defined types. It also permits type definitions with side effects: 12 ASPEN LANGUAGE SPECIFICATIONS DCL COLOP_CODE <- 0; TYPE COLOR: PEAL <-. COLOR_CODE IS COLOR_CO')E <-. COLOR_CODE+1 ; END COLOR; Usinq this definition, DCL RED, GREEN, BLUE=COLOR ; generates three constants with unique COLOR codes. Note that within a type definition that renames a record, th? VAL qualifier may he used with the type name to obtain the pointer value that will he returned as the value of the type function. For example, we could write TYPE CELL(X:REAL) = {DATA: PEAL <"-. X; NEXT, BACK: CELL <-> CFLL.VAL}; Th^n, the NEXT and BACK fields of the tuples constructed by CELL would point initially to the newly created n-tuple. A. 2. 8.2. Parameter Lists and Procedure Invocation ^h "Da rm-lis+-" is optional in the function definition, and if present, has th^ form: (fipldj.,. . . ,t ieldn) where "fi«ldi M has th° same form as a field in a record declaration (Section A. 2. 2). If a constructor appears in a parameter declaration, i + indicates that the parameter is a k_ey_wori_ oarameter ; correspondence between arqument and parameter is established by binding the arqument to the name of the parameter at the point of call, rath°r than binding them by position within + hc argument list. The constructor is the default value of th^ parameter, should no argument be supplied. If the constrictor is bound to the parameter using "=", then the parameter may not b«= changed after entry to the procedure. Functions ar° invoked by any reference to the function "id" not qualified by VAT. If the function has been declared with parameters, each ref^r^nce must be followed by a parenthesized list of expressions and assiqnmcnts. Any expressions must come first, and th^ir number and type must match exactly the number and ^ype of formal positional parameters defined in the FUNC statement. Keyword arquments, if any, follow the positional arquments in the form of assiqnments separated by semicolons. Th^ list of keyword arqument assiqnments is delimited by colons inside the parenthesized arqument list. For example, suppose IOTA is defined: Sec. A. 2. 8. 2 PARAHETER LISTS AMD PROCEDURE INVOCATION 13 FONC IOTA(SIZE:REAL; INCR, START<-1) = REALAR RAY (SIZE) IS DCL J<-.0; ONTIL J>=SIZE DO J <-. J*1; IOTA.VALfJ} <- START; START <-. START ♦ INCR; OD; END IOTA; Then the assignment X<-»IOTA(10) generates REALARRAY {(10) = 1, 2,3,4,5,6,7,8,9, 10} and assigns its address to X; IOTA(5:INCR=10:) generates { (5) =1 , 1 1 ,21 , 31,41} . Arguments are passed by value, but remember that the value of an n-tuple or string expression is a pointer to an object and not the object itself. Since arguments are passed by value, the formal function parameters are eguivalent to local variables that ar 3 initialized by assignment from the corresponding argument at the time of invocation. Output from a function is restricted to the value returned by a function and the side effects of assignments to gualified parameters. If a function returns a pointer, its invocation may be qualified with a field name or subscript list. For example, IOTA(100: START=400; INCR=-2:)(U} is 394. A. 2.8. 3. Procedures The general form of a procedure declaration is similar to a FUNC declaration and has the form: PROC id parm-list IS declarations and statements END id; As in the FUNC statement, "parm-list" is optional. A procedure is invoked whenever its name appears as a statement. The arguments to the procedure call are specified the same way the arguments to function calls are specified. Aside from the way PROCs are invoked and the fact that they cannot return a value, PROCs, FUNCs, and TYPEs are essentially identical. In the following discussions, we will use the term procedure to refer to these three constructs collectively. 14 ASPE"J LANGUAGE SPECIFICATIONS A . 1 . Ex pressions f h o forms of expressions permitted in ASPEN are listed below; operations ar« listed in order of decreasing precedence: numeric constant string constant reference NIL ( expression ) ( condition -> expression : expression ) ♦ expression - expression expression * expression expression / expression expression + expression expression - expression assignment where "reference" is one of the following identifier ( reference <-. reference ) ( condition -> reference : reference ) reference . identifier reference {expression,...} idpntifier ( expression,... ) identifier (: id1_r • • • » idn = expression ; . . . :) identifier ( expression,... : id_1 , . . . , idn = expression ; . . . :) T ho assignment operators (see Section A. 4.1) associate to the right, while all other operators associate to the left. Subscripting and pointer dereferencing are performed strictly from left to right within an expression. S*o. A. 3.1 CONDITIONAL EXPBESSIONS 15 A. 3.1. Conditional Expressions ASPEN provides a "conditional expression" of the fori ( condition -> expression : expression ) "condition" is a Boolean expression that determines the value of the conditional expression: if it is true, the expression f3llowing »->« is evaluated and becomes the value of the conditional expression; otherwise, the expression following ":" is evaluated and becomes the value of the conditional expression. The two expressions may be any type, but they both must be the same type; this is the type of the conditional expression. "Condition" has the general form conjunction | ... | conjunction where a "conjunction" is relation 5 ... 8 relation and a "relation" is one of expression < expression expression <= expression expression = expression expression -»= expression expression >= expression expression > expression Both expressions in a relation must be of the same type, and if the relational operator is "<", "<=", ">=", or ">" they must be of type PEAL. For n-tuples and strings, pointers are compared and not the object pointed to. The expressions within a condition are evaluated from left to right, but only when evaluation is necessary to determine the truth value of the condition. An expression in a conjunction is evaluated only if all preceding relations in the conjunction are true, and a conjunction is evaluated only if all preceding conjunctions are false. In all but the leftmost relation, the lefthand expression and the relational operator — or the lefthand expression alone — ■ay be omitted. If a lefthand expression is omitted, the value of the las t- evaluated lefthand expression is used. If a relational operator is omitted, the textually preceding relational operator is used. These conventions permit the following syntactic shorthand: 16 ASPEN LANGUAGE SPECIFICATIONS Shorthand = X | Y | Z Y <10 F, >5 LOG(F) <1 | >2 Z =10 | H | T AS LOG(F)<1 | LOG(F)>2 (except for extra LOG evaluation) Z = 10 | ZH | F>I A=X ft A<10 (ugh!) To avoid possible misinterpretation of conditions like the sixth example, the programmer is advised to omit all lefthand ^xoressions if any expressions are omitted (as in the fifth example above) . A.u. Statements The statement?; discussed here are permitted in the main program and in procedure and packet definitions. Statements are normally terminated by a senicolon, but the semicolon may be omitted preceding an ELSE, OPIF, END, FI, or 01). A . U. 1 . Assignment The forms: assignment statement is written in one of the following leftside <-i expression; leftside ♦<-» expression; leftside -<-• expression; leftside *<-i expression; leftside /<-* expression; where "leftside" is a "reference" that denotes a variable or variable field. The types of "leftside" and "expression" must be identical, and if "♦<-.", "-<-.", ••*<-.", or "/<-" are used, they must be t ypo rfal. If "<-»" is used, the value of "expression" is assigned to the location specified by "leftside". Note, however, that the value of a strinq or n-tuple expression is a 22iHl££ ^° an object and so assignment copies pointers rather than these objects. If "x<-»" is used, operation "x" is performed using the current value of "leftside" and the value of "expression" as operands and the result is stored back into "leftside". Sec. A.U.2 INPUT/OUTPUT 17 A. a. 2. Input/Output The input/output statements are GET leftside, . . . ; and PUT expression,...; "Leftside" Bust be a variable or variable field of type REAL, but "expression" may be type HEAL or STRING. GET reads numeric constants from an implementation defined standard input file. The constants may be separated by blanks or commas. PUT converts the value of REAL expressions to a decimal character representation (implementation defined) and writes them on an implementation defined standard output file. The string "ML" in a PUT statement causes a new line to be started; "PP" (form feed) starts a new page of output. Other strings are written to the output file without conversion. A.U.3. Selection Control Statement ASPEN has two control statements: IF for selection and UNTIL for iteration. The simplest forms of the IP statement are IF condition THEN statement;... PI; and IF condition THEN statement;... ELSE statement;... PI; These have the standard meaning. (Note: "statement;..." denotes a list of statements of the type defined in this Section, which may be omitted if desired.) If selection is based on several disjoint conditions, the form IF condition THEN statement;... ORIF condition THEN statement;... ELSE statement;... PI; may be used instead of nesting IF's in the ELSE-clause. ORIF is shorthand for ELSE IF but. does not reguire an additional PI;. The ELSE-clause is optional. The most general form of the ASPEN selector provides a notation for case selection based on the value of a single expression: 18 ASPFN LANGUAGE. SPECIFICATIONS IP condition THEN statement;., relop targets THEN statement;,. orif condition THEN statement;., relop targets THEN statement;.. ELSE statement;. FI; ^here may be zero or more ORIF phrases and the ELSE clause is optional, "relop" stands for one of the six relational operators and "tarqets" denotes an ASPEN condition without the leading left-hand expression and relational operator. Each "relop" "targets" seguence is a continuation of the preceding "condition". The rules for omitted lefthand expressions and omitted relational operators in conditions are valid in "targets" as well, Wh»n an IF statement is executed, the conjunctions of the continue 1 condition ar<* evaluated in order (from top to bottom and left to riqht) until a conjunction is found to be true. Then the statements in the followinq THEN-clause are executed. If no conjunction is found to be true, the statements in the FLSE-clause are executed. For example, the decoding interpreter might be written: of operation codes in an IF OPCODE=ADD = snp = 1UL = niv FI; ^FEN THEN THEN THEN ELSE ACC ACC ACC ACC PUT ACC + ACC - ACC * ACC / VAL; VAL; VAL; VAL; "NL", "INVALID OP CODE"; Or the computation of a grading histogram could be written: IF ABSENT (1} =YFS THEN » ORIF SCOPE{I}N THEN IF N=A.SIZE THEN •OVERFLOW; ELSE • INSERTED 1 ; A (N*<^1}<-.X; ORIF A[I}=X THEN 'FOUND 1 ; ELSE K-I + 1; PI; OD; The UNTTL-clause preceding DO, declares the loop exit labels. The scope of this declaration is just the body of the loop, and within this scope, the exit labels may not be redeclared. In addition, each exit labpl must appear exactly once within the scope of its declaration. One abbreviated form of the UNTIL is permitted, which is notationally and semantically isomorphic to the WHILE statements in many Algolic lanouaaes. Specifically, nNTIL exit-labeli |...| exit-labeli |...| exit-labeln DO IF condition THEN exit-labeli PI;. statement; OD; may be written with the "condition" in the ONTIL-clause: 20 ASPEN LANGUAGE SPECIFICATIONS UNTIL exit-label^ |...| condition |...| exit-labeln DO statement ; OD; Two examples of UNTIL statements are ! FIND THE GREATEST COMMON DIVISOR OF X AND Y GCD<-.X; UNTIL GCD=Y DO IF GCDN DO GET X; IF X=-1 THEN 'END OF INPUT* FI; PROCESS (X) ; OP; A. U.S. Th^ EXIT Statement Th^ statement EXIT identifier; terminates execution of the procedure or packet identified by "identifier". Th« EXIT statement must be the last statement of a conditional (THEN or ELSE) clause and must be textually nested within the entity that is to be terminated. A . S . object Li f et i mes whil^ an ASPEN procedure is in execution, it may acquire storage dynamically from two separate areas. The local storage ar*M is ^n extension of the procedure's activation record, and any n-tuples created in this area are destroyed when the procei'ir^ returns to its caller. The return storage area survives the invocation of the procedure, and n-tuples created th<=re an returned to the calling procedure and may persist Sec. A. 5 OBJECT LIFETIMES 21 indefinitely. The disposition of n-tuples in a procedure's return area depends on the environment in which the procedure is invoked. By default, if the procedure is called from a DCL statement or formal parameter list, the n-tuples in the return area become part of the local area of the calling procedure. In all other contexts, the n-tuples in the return area become part of the caller's return area. These defaults were chosen so that ASPEN variable declarations will normally act like AUTOMATIC variables in PL/I and so that ASPEN (type) functions will normally return to the invoking procedure all of the n-tuples they have created dynamically. For example, if we define the type E_TREE and the function GFNTREE as in Figure A.1, then, under the default disposition of returned n-tuples, all E_TREE n-tuples created in the execution of GENTREE will be returned to the caller, and so, if we write DCL X1 :E_TREE = GENTREE (Q) ; the linked-list structure that represents the expression tree for the expression in Q will become part of the local storage that also contains the pointer X1. The default disposition of returned n-tuples can be overridden throuah use of the reserved words LOCAL or RETURN immediately preceding the invocation of a procedure. "LOCAL FORM (...)" means all n-tuples returned by FORM are to become part of the caller's local storage; "RETURN STRUC(...)" means all n-tuples returned by STRUC are to become part of the caller's return area. The LOCAL and RETURN operators apply to the disposition of all n-tuples returned in the evaluation of arguments as well as to the n-tuples returned by the procedure or type function itself. The LOCAL and RETURN operators cannot be applied directly to a literal n-tuple constructor; the n-tuple must be returned by a procedure so that the operators can then be applied to invocations of that procedure. As another example of storage management in ASPEN, consider the procedures in Figure A. 2. ADDLINK and FORH_LIST work with lists of CELLs. ADDLINK creates a new cell for value X and links it to cell L, which is presumably in a list. Since we do not want to destroy the newly created cell when ADDLINK exits, we have used "RETURN CELL(X)" to construct the cell locally referenced as C. On exit from ADDLINK, C will be destroyed, but the cell it references will not. FORMALIST reads N numbers from a card and forms them into a linked list using ADDLINK. The cell created in the FUNC statement is a temporary header used to form the list. Since it is discarded before FORM_LIST exits, it should be destroyed on exit, and so it is constructed as a LOCAL CELL. 22 ASPFN LANGUAGE SPECIFICATIONS "•YPE E_TREE(D: STRING; LT, RT: E_TREE) = (NAME: STRING <- D; LEFT, RIGHT: E_TREE <-. LT, RT} ; ^YPE EXPRESSION (N: REAL) ■ {(N): STRING); PHNC GENTREE(A: EXPRESSION; P<-«1): F.JTREE = EXPR IS FUNC EXPP: E_TPEE <-. TERM IS ! TERM ( ("♦" | "-") TEEM)* DCL OP: STRING; UNTIL (OP<-.A {P} )-. = "♦" 5 "-« DO P+<-1; EXPP.VAL <-. E_TREE(OP, EXPR. VAL, TERM) ; OD; END EXPR; FONC TERM: E TREE IS ! "STRING" | "(" EXPR " ) " IF A(P}=" (" THEN P-K-1; TERM. VAL <-• EXPR; ELSE TERM. VAL <- E_TREE ( A (P) , NIL, NIL) ; PI; P-K-.1 ; END TERM; END GENTREE; Figure A.1. An Expression tree Generator in ASPEN No movement of n-tuples is required to implement ASPEN RETURN storaqe. The n-tuples can always he created in their "final restinq place", which will always be in some local storaqe area desiqnated by the program. Since all RETURN storaqe is part of some procedure's local storaqe it will be deleted when that procedure exits. The RETURN storage of the main proqram is equivalent to the heap or dynamic storage available in PASCAL, PL/I, Alqol 68, and other languages, and will be deleted when the program terminates (the assumption teinq that the main proqram is invoked with a LOCAL prefix and the invokinq procedure returns to the operating system when the main proqram returns) . The design of ASPEN should reduce the reed for garbage collection. Subsystems (procedures) can be written with the use of heap storaqe in mind, but then, throuqh ■judicious us» of a LOCAL prefix when the subsystem is invoked, the "heap" used by the subsystem can be deleted when the subsystem finishes processing. A procedur° has no control over the lifetime of data structures generated in its RETURN area, but then it has no way of retaining pointers to that area either. The procedure must rely on its parameters or global variables to maintain commun ic\ tion with n-tuples in the RETURN storage, and these links come from the invoking block, which appropriately has control over the lifetime of the storage returned by the Sec. A. 5 OBJECT LIFETIMES 23 TYPE CELL(X: REAL) = (DATA: REAL <-« X; NEXT, BACK <- CELL.VAL}; PROC ADDLINK(L: CELL; X: REAL) IS DCL C: CELL <- HETUFN CELL(X); C.NEXT <- (C. BACK <- L).NEXT; L. NEXT. BACK <-. L.NEXT <- C; END ADDLINK; FONC FORM_LIST(N: REAL): CELL <- LOCAL CELL(O) IS DCL X: PEAL <- 0; DCL P: CELL <- PORM_LIST.VAL; ONTIL (N<-.N-1)<0 DO GET X; ADDLINK (P,X) ; P <- P. NEXT; OD; FORM_LIST.VAL <-. FORM_LIST. VAL. NEXT; FORM_LIST.VAL.BACK <-.~P; END FOFM_LIST; Figure A. 2. Sample Use of Storage Control procedure. A. 6. Packets A p acke t is the ASPEN encapsulation mechanism that allows the programmer explicit control over the scope of naies in his program. Packets are permitted wherever declarations are permitted and have the following structure: PACKET id IS IMPORT and EXPORT statements statements and declarations END id; The normal Algol 60 scope rules apply to ASPEN procedures — __£*.# the scope of an identifier is automatically extended to the reach of a procedure lying in the scope of the identifier unless the identifier is redefined within the reach of that ?U ASPEN LANGUAGE SPECIFICATIONS procedure. In th<* case of PACKETS, however, names are not automatically inherited from the surrounding environment. The names defined outside a packet that are to be used inside the packet must be explicitly imp orted into the packet using an IMPORT statement of the form: IMPORT name.1 , .. . , namen; Th° IMPORT statement extends the scope of "namei" to include the reach of the packet containing the IMPORT statement. Names defined inside the packet can be referenced outside the packet, but only if they are explicitly listed in an EXPORT statement within the packet. An EXPORT statement has the same form as an IMPORT statement: EXPORT namely ... , namen; Thp EXPORT statement extends the scope of "namei" to include the reach of the immediately enclosing packet or procedure. If a name is to be exported (imported) several levels from its definition, it must be referenced in an EXPORT (IMPORT) statement at each level of packet nesting. Names cannot be exported across procedure borders. And above all, for each identifier in the program, there must be exactly one definition of the identifier in each disjoint scope of the identifier. A nacket may import an name only if it is grant ed permission to do so by a GRANT statement of the form: GRANT id namej.,. . . , namen; wher^ "id" is the packet "id", and the "namei" are the only names that may be IMPOPTed by the packet. These names must be defined in the block containing the GRANT — either through a declaration ther** or because they were IMPORTed or EXPORTed into ♦he block. There must be exactly one GRANT statement for each packet appearinq in a program, it must be located in the procedure or packet that contains the packet, and it must textually precede all statements that reference the names exported from the packet. When the GRANT statement is executed, the packet is initialized--t h«= declarations and statements in the packet are executed in s^guence to construct storage and initialize the variables and constants in the packet. Packet and procedure definitions that reference identifiers exported from a packet iray precede the GRAN" 1 statement for the packet, but these blocks may not be executed before the packet has been initialized. ^h? storage associated with a packet is an extension of the storage for the procedure containing the packet. The lifetime of variables and constants declared in the packet is the lifetime of th«= surrounding procedure; n-tuples are either Sec. A. 6 PACKETS 2S retained in or returned from that procedure. Tn order for two packets to share exclusive use of a resource (naae) , three elements must be present: first, the packet providing the resource must EXPORT the naae of the resource; second, the packet (s) using the resource must IMPORT the name; and third, the block enclosing both packets aust GRANT the exported name to the packet(s) wishing to iaport it. The enclosing block should be viewed as a manager of the two packets that wish to communicate, and then the GRANT statement becoaes a precise statement of the managerial decision to permit the communication reguested by the IMPORT and EXPORT stateaents. A. 6.1. Import, Export, and Grant Specifications Each "namei" specification in an IMPORT, EXPORT, or GRANT statement has one of the following forms: modifier identifier modifier identifier . name modifier {namej^*- • • , namem} where "modifier" is optional, and if present, is a list of letters enclosed in parentheses. The first "identifier" in each name specification is the name of a variable, constant, function, procedure, or type that is to be transported across a packet border. If the identifier has been defined using a literal n-tuple constructor, then field names of the n-tuple aay be transported by including thea as gualifiers in the specification. Several fields of the n-tuple can be transported by enclosing the field names in braces following the gualifying dot. All field names to be transported must be fully qualified (but see the discussion of the X modifier below) . The identifier "#" may be used to transport the subscripting of an array. If keyword parameters are to be transported, the function, procedure, or type name aust be gualified by the (list of) keyword (s) that is to be transported. (In the case of type names, which denote both a function and possibly a literal n-tuple, both keyword paraaeters and subfield names are listed in the same list following the type name.) Some examples based on previous definitions are: IMPORT CELL. {DATA, (R) (NEXT, BACK}} , ADDLINK, FORH_LIST; IMPORT CPLXVEC.*, AX; ! NO SUBSCRIPTING OF AX IMPORT TREE. {NAME}; ! IMPORT NAME FIELD ONLY IMPORT SQRT, IOT A . {ST ART ,INCR} , COLOR; EXPORT STACK1. (X) STK.#; EXPORT TOKEN. (R) {NAME, (X) INFO. CODE} ; 26 ASPEN LANGUAGE SPECIFICATIONS Each modifier indicates which of the possible uses of the name are to b = imported, exported, or granted, but it cannot weaken the access restrictions that have already been assigned to th<> name by virtue of its declaration in, or transportation into, the Mock. If the modifier precedes a bracketed list, the modifier applies to all u nqualified identifiers in the list. In Hp last EXPORT statement, for example, (R) applies to NAME and CODE, but not INFO. The following modifiers are currently recognized: Modifier Use of Name Z Imported, Exported or Granted I Invocations of procedure Z are allowed, D Declarations using type Z are allowed. T T ype. (Implies I and D.) Q Qualification of pointer (of type) Z. R Peading of value of (type) Z. (Also implies Q.) U Updating of variable (of type) Z. V Variable (of type). (Implies R and U.). X Non°. (Name present for gualif ication only.) Th packet. Storaqe of type CELL can not be created directly in statements outside the packet, nor can these statements access the fields DATA, NEXT, HEAD, or TAIL in CELL'S and QUEUE'S. Since all access to the list structures for implementing queues is restricted to just the coding in packet QUEUES, it can easily be proved that the representation is correct and secure. The ASPEN packets in Figure A. 4, illustrate the degree of control the programmer has over access to his data structures. The SYMBOLJTABLE and NAME_TABLE packets encapsulate the symbol table and name table managers of a compiler. The design of the compiler requires that the symbol table manager must have access to th^ STP field of each name table entry so that it can be changed to reflect the varying name-symbol associations in effect at each point in the source program. For security, the STP field should not be accessible to any other packet except the name table manager. The ATTR field of each SYMBOL n-tuple contains language dependent attributes for the symbol. Since these do not influence the symbol table management algorithms, the field is only indirectly specified by referencing the type ATTRIBUTES in the definition of SYMBOL. The environment where the SYMBOLJTABLE packet is used must supply the appropriate definition for this type and will have unrestricted access to it. 28 ASPEN LANGUAGE SPECIFICATIONS PACKET QUEUES IS EXPORT QUEUE, ENQ, DEQ; TYPE CELL(X: PEAL) = (DATA: REAL <- X; NEXT: CELL}; TYPE QUEUE = {HEAD, TAIL: CELL}; DCL FRFE_LTST: CELL; PROC ENQ(Q: QUEUE; DATA: REAL) IS DCL C: CELL <-• FREE_LIST; IF FFEE_LIST=NIL THEN C <- CELL(DATA); ELSE FPFE_LIST <- C.NEXT; C.DATA <-. DATA; C.NEXT <-* NIL; PI; (Q.TAIL=NII. -> Q.HEAD : Q. TAIL. NEXT) <-. C; Q.TAIL <-• C; END FNQ; FUNC DEQ(Q: QUEUE): PEAL IS DCL P: CELL <-. Q.HEAD; IF P-.=NIL THEN DEQ. VAL <-. P. DATA; 0. HEAD <-. P. NEXT; IF Q.HEAD=NIL THEN Q.TAIL <-. NIL PI; P.NFXT <- FREE_LIST; FREF_LIST <-. P; FI; END DEQ; END QUEUES; Figur=» A. 3. A Queue Facility in ASPEN A . 7 . Parawetric Types The combination of TYPFs and PACKETS in ASPEN provide the programmer with a powerful data abstraction mechanism. The data abstraction mechanism is further strengthened by the ability to define TYPEs in which component types are parameters of the definition and th<=» ability to define procedures that can accept and manipulate th<=> parameterized types. Certain restrictions must be placed on this feature, so *hat the programmer is never surprised by tho amount of code that is generated by an ASPEN tVDe cr procedure definition. S^c. A. 7.1 SUPERSTRUCTURES 29 IMPORT ERROR, ATTRIBUTES; EXPORT (Q) SYMBOL. ATTR; GRANT NAME_TABLE (D) SYMBOL; GRANT SYMBOL_TABLE (D) NAME. STP, (D) ATTRIBUTES , ERROH, UNIQUE_NAHE; PACKET NAME_TABLE IS IMPORT (D)SYHBOL; EXPORT (D) NAME. STP, UNIQOE_NAME; TYPE NAME = {NAME: STRING; TYPE: REAL; STP : SYMBOL} END NAME_TABLE; PACKET SYHBOL_TABLE IS IMPORT (D) NAME. STP, ( D) ATTRIBUTES , ERROR, UNIQUE_NAHE; EXPORT (D) SYMBOL. ATTR, ENTER, OPENSCOPE, CLOSESCOPE; TYPE SYMBOL(PTR: NAME) = {NTP :NAHE <-. PTR; BLOCK :BLOCK_RECORD = BLOCK; NAMESAKE :SYMBOL <- PTR. STP; NEIGHBOR :SYMBOL <-. BLOCK. RESIDENTS ; ATTR : ATTRIBUTES <-. NIL); TYPE BLOCK_RECORD = {HEIR :BLOCK_RECORD <-• NIL; SIBLING :BLOCK_RECORD <-« ~(BLOCK=NIL->NIL:BLOCK. HEIR) ; PARENT :BLOCK_RECORD <-. BLOCK; RESIDENTS:SYMBOL <- NIL}; DCL BLOCK <-. BLOCK_RECOBD; ! CURRENT BLOCK FUNC ENTER(PTR: NAME): SYMBOL IS IF PTR.STP-.= NIL 6 PTR .STP. BLOCK=BLOCK THEN ERROR ( : MSG= "MOLTIPL E DECLARATION":); PTR <-• UNIQUE_NAME; PI; ENTER. VAL <-• SYMBOL(PTR); BLOCK. RESIDENTS <-. PTR. STP <-. ENTER. VAL; END ENTER; PROC OPENSCOPE IS BLOCK. HEIR <-. BLOCK <-. BLOCK_RECORD; END OPENSCOPE; PROC CLOSESCOPE IS DCL P: SYMBOL <-. BLOCK. R ESIDENTS ; UNTIL P=NIL DO ! POP NAMESAKE STACKS P. NTP. STP <-. P. NAMESAKE; P <- P. NEIGHBOR; OD; BLOCK <-. BLOCK. PARENT; END CLOSESCOPE; END SYMBOL_TABLE; Figure A.U. A Symbol Table Manager in ASPEN 30 ASPEN LANGUAGE SPECIFICATIONS A. 7.1. Superstructures A s upe rst ruc ture is the framework for a class of data structures. The superstructure defines the characteristics that distinguish its members from other data structures and also defines where members of the class may have different charactprist ics. An array is an example of a commonly used supprstructure; the esspntial characteristics of an array are that all elements have the same structure and each element can be referenced by an index value from a finite set; the structure of the elements of the array are not essential to the concept of an array. To defin<=» a superstructure in ASPEN, component types of the supprstructur° are made parameters of the type definition. Por example, the primitive array constructor can be recast as a user-defined superstructure using the following definitions TYPE(TYP) ARPAY(SIZE: REAL) = { (SIZE) : T YP} ; Enclosing the identifier TYP in parentheses, preceding the superstructure name, declares it to be a type-parameter of the supprstructure definition; it is implicitly of type TYPE and may be user! in any ":type" construct and as a type-argument in a superstructure reference. It may not be used as a function or as a superstructure. Unlike the other parameters of the type definition, type-parameters are bound at compile time, when the parameterizpd superstructure name is used in a declaration or expression. Pxamples of ARRAY dpclarations are DCL AR: (REAL) ARRAY = ARRAY(100); DCL AS: (STRING) ARRAY = ARRAY(10); DCL AP: (STACK) APPAY; DCL AA: ( (REAL) ARRAY) ARRAY = ARRAY (5); TYPE(X) MATPTX(M,N: REAL) :( (X) ARRAY) ARRAY = ARRAY (M) IS DCL J<-.0; UNTIL (7+<-.1)>M DO MATRI X . V AL {J} <-. ARRAY(N) OD; END MATRIX; Note that type-arguments precede the name of the superstructure, following the : in the declarations, and the type-arguments are not uspd when the type function is invoked. As with objects of all types, specific instances of superstructures may be passed to procedures defined to accept t h ° m : Sec. A. 7. 1 SUPERSTRUCTURES 31 PROC SORT(A: (REAL) ARRAY) IS DCL I,J<-.0; UNTIL (T*<-1) >=A. SIZE DO J<-A.SIZE; UNTIL (J-<-.1) A (J*1) THEN T <-. A (J) ; A {J) <-. A{J*1); A {J+1} <- T; PI; OD; OD; END SORT; A. 7. 2. Polymorphic Procedures Procedures that operate on all instances of a superstructure are called egl ym g rp hic procedures since they operate on many different forms of data structures. In ASPE1, polymorphic procedures are defined using the notation of superstructure definitions, but applied to PROC or FUNC identifiers. For example SEARCH is a polymorphic procedure that returns the index of the array element containing the value of its second argument : FUNC(T) SEAPCH(A: (T) ARRAY; X:T):REAL IS UNTIL (SEARCH. VAL-K -.1) >A. SIZE DO IF AfSEARCH.VAL)=X THEN EXIT SEARCH FI; OD; SEARCH. VAK-.NIL; END SEARCH; As with superstructures, when polymorphic procedures are invoked, type-arguments are never specified; e. g. . SEARCH is called via the statement "SEARCH (AS, "TRW") ;". A. 7. 3. Items of Parametric Type In a polymorphic procedure (and in superstructure definitions) the operations that can be performed on items having a parametric type are restricted to the operations that can be performed on all types. In SEARCH, for example, the only operation performed on X (of parametric type T) is identity 32 ASPEN LANGUAGE SPECIFICATIONS comparison. A polymorphic array sort procedure is not definable in ASPEN since not all ASPEN types have an ordering defined for th<=>m. D olymorphic sort procedures can be defined only for superstructures havinq a field known to always be REAL. For example: TYPE(L,F) PAIR(LV:L; R?:P) = {LEFT: L<-LV ; R IGHT: B<-RV} ; PROC(ANY) PSOBT (A: ((ANY, REAL) PAIR) ARRAY) IS DCL I,J<-0; DCL T: (ANY,RE AL) PAIR ; UNTIL (I*<-i1) >=A.SIZE DO J<-.A.SIZE; UNTIL (J-<-.1)A {J+1}. RIGHT THEN T <- A {J} ; A {J} <-. A (J*1) ; A {J+1} <-» T; PI; OD; OD; END PSORT; A mor* 1 complex example of the use of superstructures is shown in Figure A. 5. Sec. A. 7.1 ITEMS OF PARAMETRIC TYPE 33 PACKET ASSOC_MEM IS IMPORT PAIR, PSORT; EXPORT (D) MEMORY, FFTCH, STOBE, MEMSORT; TYPE(ADR,VAL) MEMORY = (LNK: ( ADR, VAL) MEMORY ; AD:ADR; HV:VAL}; FUNC(A,M) FFTCH(MEM: (A, M) MEMORY; X:A):H IS DCL P: (A, H) MEMORY <-• HEM; UNTIL «X FOUND 1 | P=NIL DO IF P.AD=X THEN «X FOUND 1 ; FETCH. YAL <- P. MY; PI; P <- P. LNK; OD; END FETCH; FUNC(A,M) STORE(HEM: (A, M) MEMORY; AD:A; X: M) : (A , M) MEMORY IS DCL P: (A, M) MEMORY <-• STORE. VAL <-. MEM; UNTIL »AD POUND 1 | 'END OF LIST* DO IF P=NIL THEN 'END OF LIST 1 P <-* MEMORY; ! GET NEW CELL P. LNK <-. MEM. LNK; ! ADD TO FRONT MEM. LNK <-. P; ! OF LIST. STORE. VAL <-. P; ORTF P.AD=AD THEN • AD FOUND 1 ; ELSE P <-. P. LNK; EI; OD; P.MV <- X; END STORE; FUNC(A) MEMSORT(MEM: (A, REAL) MEMORY) : ((A, REAL) PAIR) ARBAY IS DCL P: (A, REAL) MEMORY <-* MEM; DCL N<-.0; UNTIL P=NIL DO N*<-,1 ; P <-. P. LNK; OD; MEMSORT. VAL <-• ARRAY (N); DCL J<-.0; P <-. HEM; UNTIL (J+<-1)>N DO MEMSORT. VAL {J} <- PAIR (P. AD, P. HV) ; P<-.P.LNK; OD; PSORT(MEMSORT.VAL) ; END MEMSORT; END ASSOC_MEM; Fiqure A. 5. An Abstraction of Associative Meiory BIBLIOGRAPHIC DATA SHEET 1. Report No Keport No. . _. UIUCDCS-R-76-8U3 3. Recipient's Accession No. 4. Title and Subtitle ASPEN Language Specifications 5- Report Date December 1976 7. Author(s) Thomas R. Wilcox 8- Performing Organization Rept. No. 9. Performing Organization Name and Address Department of Computer Science University of Illinois Urbana, Illinois 10. Project/Task/Work Unit No. 11. Contract /Grant No. 12. Sponsoring Organization Name and Address Department of Computer Science University of Illinois Urbana, Illinois 13. Type of Report & Period Covered 14. 15. Supplementary Notes 16. Abstracts ASPEN is a "toy" language that can be used as a sample source language in the teaching of compiler construction. As such, its design incorporates language constructs that can be handled by fundamental compiler construction techniques and yet are expressive, well-structured and reasonably secure, in keeping with current trends in language design. As a result, ASPEN is goto-less, strongly typed, and provides efficient, orthogonal mechanisms for information hiding and parameterized user -defined types. ASPEN 's dynamic storage allocation mechanism and its polymorphic structures and procedures can be implemented without a heap and with no run-time support routines other than those needed for format-free input and output of strings and numbers. These language specifications define the language and offer some examples of its use. 17. Key Words and Document Analysis. 17a. Descriptors programming languages, information hiding, data abstraction, structured control statements, efficient run-time storage management, recursive and polymorphic types and procedures 17b. Identifiers/Open-Ended Terms 17c. COSATI Field/Group 18. Availability Statement FORM NTIS-35 (10-70) 19. Security Class (This Report) UNCLASSIFIED 20. Security Class (This Page UNCLASSIFIED 21. No. of Pages 22. Price USCOMM-DC 40329-P7 1 f El * 2 19ft