/***********************************************************
** These functions are used to translate a given object **
** of class anode() to the equivalent object of class **
** prog(). **
***********************************************************/
// For elaborate dumpings:
var dumpfl = 0;
// Here is the function to parse a program anode. It is very trivial and
// is included for the client's convenience.
func parse_program_anode (program_anode, local_dumpfl = 1) {
// Initialize the dumpings.
dumpfl = local_dumpfl;
var object_program = prog (), intermediate_view;
if (program_anode.name != "program") { // Wrong node.
putln ("! Wrong grammar. Root anode name is : ", program_anode.name);
bad_anode ();
}
if (dumpfl) putln ("& Entering translation phase.");
intermediate_view =
parse_instruction_anode (program_anode.transl[0], dumpfl);
// If we parsed a block, we return it as the object program so as to
// have a bit of efficiency.
if (intermediate_view. name == "block")
object_program = intermediate_view.args[0];
// Otherwise we copy the instruction.
else object_program.exec = [intermediate_view];
if (dumpfl)
putln ("& Entering semantical checking phase.");
object_program = check_block (object_program);
if (dumpfl) {
if (global_errfl) putln ("! Semantic check failed.");
else putln ("& Semantic check sucessful.");
}
return object_program;
}
/* The function parse_instruction_anode() is used to parse an instruction. */
func parse_instruction_anode (instruction_anode) {
// We declare a variable to work on the result, which is an object of class
// instr().
if (dumpfl) {
putln ("@ Initializing instruction parsing operation with node:");
print_anode (instruction_anode);
}
var result = instr ();
if (instruction_anode.name == "assign") { // Assignment statement.
if (dumpfl) putln ("* Identified assignment statement.");
result.name = "assign";
result.args = [3 : nil];
result.args [0] = instruction_anode.transl [0].transl [0].transl;
result.args [2] = parse_expression_anode (instruction_anode.transl[1]);
result.args [1] = (instruction_anode.transl [0].transl [0].transl.type0
== 'I' ?
instruction_anode.transl [0].transl :
bad_anode () );
if (instruction_anode.transl [0].name == "array")
result.args [1] = parse_expression_anode (instruction_anode.
transl [0].transl [1]);
else if (instruction_anode.transl [0].name == "varac") {
result.args [1] = expression ();
result.args [1].opr = "num";
result.args [1].opa1 = token (0);
// For compatibility with the semantic checker.
result.args [1].opa1.type0 = "I";
result.args [1].opa1.value = "0";
result.args [1].opa2 = "integer";
} else bad_anode ();
} else if (instruction_anode.name == "vblock") {
// Parse the block now.
if (dumpfl) putln ("@ Initiating block parsing.");
result.name = "block";
result.args = [1 : nil];
result.args [0] = prog ();
// A block should be an object of class prog().
// Process the declarations:
if (dumpfl) putln ("@ Processing declarations...");
var declarations = flatten (instruction_anode.transl[0], 2),
current_identifier_declared_flag = new {};
for (var current_declaration_processed = 0;
current_declaration_processed < #declarations;
current_declaration_processed++) {
// "Flatten" the identifiers we want to declare.
var identifiers_on_wait = flatten (
declarations [current_declaration_processed]
. transl[0], 1),
// Analyze the specification.
current_specification_analysis =
component (declarations [current_declaration_processed]
. transl [1]. transl [0],
declarations [current_declaration_processed]
. transl [1]. name);
// We just assigned an object of class anode() where it is
// not needed, so we must eradicate that.
// Here we declare a shortcut variable used to declare arrays.
var array_translation = current_specification_analysis.value;
// Declare arrays here by deriving their size.
if (current_specification_analysis.type0 != "constant")
current_specification_analysis.arrfl +=
( array_translation.name == "$nil" ? 0
: array_translation.name == "$term" ?
array_translation.transl.value
: bad_anode () ); // The grammar is corrupted.
current_specification_analysis.value =
( current_specification_analysis.type0 == "constant" ?
+array_translation.transl.value
: array_translation.name == "$nil" ? 0
: [current_specification_analysis.arrfl : 0]
// For arrays.
);
// Now that we have the specification, we may introduce the identifiers
// into the environment.
if (dumpfl) putln ("@ Declaring identifiers...");
for (var current_identifier_processing = 0;
current_identifier_processing < #identifiers_on_wait;
current_identifier_processing++) {
if (identifiers_on_wait [current_identifier_processing]
. transl [0].transl in current_identifier_declared_flag) {
if (dumpfl) putln ("! Identifier declared twice.");
put (program_file, ":",
identifiers_on_wait [current_identifier_processing]
. transl [0].transl.line_num, ":", identifiers_on_wait
[current_identifier_processing]. transl [0].transl.char_num,
": ");
error ("Attempt to declare an identifier twice.");
}
result.args [0].vartable
{identifiers_on_wait [current_identifier_processing]
. transl [0].transl} = new current_specification_analysis;
// Now we make a note of the fact that we have just declared the
// identifier to solve the fact that the semantic checker that is
// applied later to the block has no way of knowing that we attempted
// to declare an identifier twice, so we check it right now.
current_identifier_declared_flag
{identifiers_on_wait
[current_identifier_processing].transl [0].transl} = 1;
}
}
// In case we stumble on a wrong node.
/* The rest is pretty easy sailing. All we have to do now
is let the instructions be parsed, and convert tokens in the table to
strings. */
var current_declaration, declarations_to_convert =
keys (result.args [0].vartable);
if (dumpfl) putln ("* Convert values : ",
sprint (declarations_to_convert));
for (var current_declaration_num = 0;
current_declaration_num < #declarations_to_convert;
current_declaration_num++) {
current_declaration = declarations_to_convert [current_declaration_num];
if (dumpfl)
putln ("* Conversion of ",
sprint (current_declaration));
if (type (current_declaration) == class ()) {
if (dumpfl)
putln ("* Conversion worthy to ",
sprint (current_declaration.value));
result.args [0].vartable {current_declaration.value} =
result.args [0].vartable {current_declaration};
result.args [0].vartable =
del (result.args [0].vartable, current_declaration);
} else if (dumpfl) putln ("* Conversion unworthy.");
}
if (dumpfl) {
putln ("* Result variables :");
println (result.args [0].vartable);
putln ("@ Parsing the instructions...");
}
var instructions = flatten (instruction_anode.transl [1],
1);
// We recursively call parse_instruction_anode() for each instruction.
for (var current_instruction_number = 0;
current_instruction_number < #instructions;
current_instruction_number++) {
result.args [0].exec @=
[parse_instruction_anode (instructions [current_instruction_number].
transl [0])];
}
// Now we must declare the configuration of variables here for the
// other blocks.
if (dumpfl) putln ("@ Redeclaring underlying blocks...");
result.args [0] = redeclare_block (result.args [0]);
func redeclare_block (block) {
func do_redeclaration (block_to_redeclare) {
// We have a block we need to define with synchronized variables.
var current_identifier_processed_key;
for (current_identifier_processed_key in block.vartable)
if (!(current_identifier_processed_key
in block_to_redeclare.vartable)) {
block_to_redeclare.vartable {current_identifier_processed_key} =
block.vartable {current_identifier_processed_key};
}
redeclare_block (block_to_redeclare);
}
func do_instruction (instr) {
if (instr.name == "block") {
do_redeclaration (instr.args [0]);
} else if (instr.name == "for") {
do_instruction (instr.args [0]);
do_instruction (instr.args [2]);
do_instruction (instr.args [3]);
} else if (instr.name == "cond") {
for (var current_alternative_processing = 1;
current_alternative_processing < #instr.args;
current_alternative_processing += 2)
do_instruction (instr.args [current_alternative_processing]);
}
}
try {
for (var current_candidate_number = 0;
current_candidate_number < #block.exec;
current_candidate_number++)
do_instruction (block.exec [current_candidate_number]);
} catch (except (). error ()) {
if (dumpfl) putln ("! Synchronization of declarations failed.");
bad_anode();
}
return block;
}
if (dumpfl) putln ("@ Block parsing over.");
// Now we are done with our work on the block.
} else if (instruction_anode.name == "condit") { // The GRIP conditional.
/* In general, a GRIP conditional is written like this:
'cond' '{'
( )...
['else' ]
'}'
Not unlike the LISP version. */
if (dumpfl) putln ("* Processing conditional.");
// Do any initial poking around with the nodes:
result = instr ();
result.name = "cond";
var option_list = flatten (instruction_anode.transl [0], 2);
/* Now that we've done that, let's translate that conditional.
Args[] for a cond statement look like this:
[condition, statement,...]
and the else part is represented by a expression evaluating to 1. */
for (var current_option_number = 0;
current_option_number < #option_list;
current_option_number++) {
var temp, current_parsed_option;
if (option_list [current_option_number].name == "elsif")
temp = parse_expression_anode (option_list [current_option_number].
transl [0]);
else if (option_list [current_option_number].name == "else") {
temp = expression ();
temp.opr = "num";
temp.opa1 = token (3);
temp.opa1.type0 = 'I';
temp.opa1.value = "1";
temp.opa2 = "integer";
} else bad_anode ();
result.args @= [temp, parse_instruction_anode
(option_list [current_option_number].transl [1])];
}
} else if (instruction_anode.name == "foritr") {
/* The GRIP for statement is exactly like the C one,
except for the fact that a guard expression is REQUIRED.
The internal representation is self-explanatory and represented
by the tuple [initialization, guard, increment, body]. */
// This is a quite trivial process:
if (dumpfl) putln ("* For loop identified.");
result.name = "for";
result.args = [parse_instruction_anode (instruction_anode.transl [0]),
parse_expression_anode (instruction_anode.transl [1]),
parse_instruction_anode (instruction_anode.transl [2]),
parse_instruction_anode (instruction_anode.transl [3])];
/* The remaining commands are very trivial: The put statement, and the
empty statement. */
} else if (instruction_anode.name == "output") {
/* The put statement outputs all its parameters with an additional newline
character at the end. */
// Trivial stuff first:
if (dumpfl) putln ("* Analyzing output statement.");
result.name = "put";
var objects_on_wait_list = flatten (instruction_anode.transl [0],
1);
// Now, a loop to deal with every object we want to output.
for (var current_object_processing = 0;
current_object_processing < #objects_on_wait_list;
current_object_processing++) {
if (objects_on_wait_list [current_object_processing].name
== "expressionel")
result.args @= [parse_expression_anode
(objects_on_wait_list
[current_object_processing].transl [0])];
else if (objects_on_wait_list [current_object_processing].name
== "stringel") {
var temp = expression ();
temp.opr = "num";
temp.opa1 = objects_on_wait_list [current_object_processing].transl[0]
. transl;
temp.opa2 = "string";
result.args @= [temp];
} else {
if (dumpfl) putln ("! Wrong instruction node, name : ",
instruction_anode.name);
bad_anode ();
}
}
} else if (instruction_anode.name == "$nil") {
// The empty statement is represented by a nil-anode.
if (dumpfl) putln ("* Conversion $nil -> empty statement.");
result.name = "empty";
/* If we get an unknown node, we finish with a fatal error message. */
} else {
if (dumpfl) putln ("! Unknown node name : ", instruction_anode.name);
bad_anode ();
}
return result; // Now the result is returned.
}
func parse_expression_anode (expression_anode) {
/* This function parses an expression node into an object of
class expression(). It can take both a factor and an expression. */
if (dumpfl) {
putln ("@ Initiating expression parsing with node :");
print_anode (expression_anode);
}
// A variable on which to work and then return.
var result = expression ();
// For describing a factor.
if (expression_anode.name == "factor") {
if (dumpfl) putln ("* Identified a factor.");
if (expression_anode.transl [0].name == "$term") { // Literal numbers.
if (dumpfl) putln ("* Found literal number.");
result.opr = "num";
result.opa1 = expression_anode.transl [0].transl;
result.opa2 = (expression_anode.transl [0].transl.value ==
int (expression_anode.transl [0].transl.value) ?
"integer" : "real");
} else if (expression_anode.transl [0].name == "varac") {
// Variable acessing.
result.opr = "var";
result.opa1 = expression_anode.transl [0].transl [0].transl;
result.opa2 = expression ();
result.opa2.opr = "num";
result.opa2.opa1 = token (3);
result.opa2.opa1.type0 = 'N';
result.opa2.opa1.value = "0";
result.opa2.opa2 = "integer";
if (dumpfl) putln ("* Parsed an variable reference.");
} else if (expression_anode.transl [0].name == "array") {
// Array referencing -- done by the same operator.
result.opr = "var";
result.opa1 = expression_anode.transl [0].transl [0].transl;
result.opa2 = parse_expression_anode
(expression_anode.transl [0].transl [1]);
if (dumpfl) putln ("* Parsed an array reference.");
} else if (expression_anode.transl [0].name == "expression" ||
expression_anode.transl [0].name == "double" ||
expression_anode.transl [0].name == "single") {
// We have a parenthesized expression for which we just recursively
// invoke parse_expression_anode().
result = parse_expression_anode (expression_anode.transl [0]);
if (dumpfl) putln ("* Processed parenthesized expression.");
} else {
if (dumpfl) putln ("! Bad node, name is ", expression_anode.name);
bad_anode ();
}
} else if (expression_anode.name == "double") { // Binary operators.
result.opr = (expression_anode.transl [1].transl.code == 21 ? // Plus.
"add" :
expression_anode.transl [1].transl.code == 22 ? // Minus.
"sub" :
expression_anode.transl [1].transl.code == 23 ? // Times.
"mul" :
expression_anode.transl [1].transl.code == 24 ?
// Division.
"div" :
expression_anode.transl [1].transl.code == 26 ?
// Logical or.
"or " :
expression_anode.transl [1].transl.code == 25 ?
// Logical and.
"and" :
expression_anode.transl [1].transl.code == 14 ?
"gtt" :
expression_anode.transl [1].transl.code == 13 ?
"ltt" :
expression_anode.transl [1].transl.code == 29 ?
"eqs" : bad_anode () );
result.opa1 = parse_expression_anode (expression_anode.transl [0]);
result.opa2 = parse_expression_anode (expression_anode.transl [2]);
/* Now, for efficiency we replace ltt (A,B) by gtt (B,A). */
if (result.opr == "ltt") {
// Swap the operands.
var temp = result.opa1;
result.opa1 = result.opa2;
result.opa2 = temp;
// Rename the operator.
result.opr = "gtt";
}
} else if (expression_anode.name == "single") {
// To work on unary operators.
if (expression_anode.transl [0].transl.code == 21) {
// We have a unary plus operation that does not affect the operand.
result = parse_expression_anode (expression_anode.transl [1]);
} else {
// Other possible operators include unary minus and negation (!).
result.opr = ( expression_anode.transl [0].transl.code == 22 ?
// Unary minus.
"neg" :
expression_anode.transl [0].transl.code == 27 ?
// Logical negation.
"not" : bad_anode () );
result.opa1 = parse_expression_anode (expression_anode.transl [1]);
}
} else if (expression_anode.name == "expression") {
// This is a reference to a factor.
result = parse_expression_anode (expression_anode.transl [0]);
} else bad_anode ();
return result;
}
/**************************************************
** These are the functions to perform semantical **
** checking. The errors recognized are: **
** 1. Attempt to declare identifier twice (found **
** at translation time). **
** 2. No such identifier declared. **
** 3. Vector in a context expecting a scalar **
** value. **
** 4. Attempt to extract an element of a scalar **
** value. **
** 5. Attempt to assign to a constant. **
**************************************************/
// The function to check a block does nothing but introduce a name scope for
// its two internal functions and call check_instruction() for each statement.
func check_block (block) {
/* check_block() has two internal functions that work on an instruction
(check_instruction()) and expression (check_expression()). */
func check_instruction (instruction) {
/* Most of the commands just cause invocations of other functions,
but assignment finds four important semantic errors (see #2-5). */
// Most important parts first this time.
if (instruction.name == "assign") {
if (dumpfl) putln ("* Checking an assignment statement.");
/* First, check for error #2. */
if (!(instruction.args [0].value in block.vartable)) {
put (program_file, ":", instruction.args [0].line_num, ":",
instruction.args [0].char_num, ": ");
error ("No such variable declared.");
} else {
/* If these would have appeared after the conditional, !keyvalue would
be generated, which is undesirable. */
/* Now, we may check for error #3. */
// if (type (block.vartable {instruction.args [0].value}.value)
// == vector
// && instruction.args [1].opr == "num" &&
// int (instruction.args [1].opa1.value) == 0) {
// put (program_file, ":", instruction.args [0].line_num, ":",
// instruction.args [0].char_num, ": ");
// error ("Structured value in scalar context.");
// }
// /* Lastly, error #4 must be checked. "elsif" is used for efficiency. */
// else
if (type (block.vartable {instruction.args [0].value}.value) !=
vector &&
instruction.args [1].opr != "num" &&
int (instruction.args [1].opa1.value) != 0) {
put (program_file, ":", instruction.args [0].line_num, ":",
instruction.args [0].char_num, ": ");
error ("Attempt to reference element of scalar value.");
} else if (block.vartable {instruction.args [0].value}.type0 ==
"constant") {
put (program_file, ":", instruction.args [0].line_num, ":",
instruction.args [0].char_num, ": ");
error ("Attempt to assign to a constant.");
}
}
// Here, we change the token to its value field.
instruction.args [0] = instruction.args [0].value;
// Now, we invoke check_expression to check two of the expressions:
instruction.args [1] = check_expression (instruction.args [1]);
instruction.args [2] = check_expression (instruction.args [2]);
// Now we are done with our work.
} else if (instruction.name == "put") {
if (dumpfl) putln ("* Checking a put statement.");
/* Here we just invoke check_expression() for every expression. */
for (var current_object_num = 0;
current_object_num < #instruction.args;
current_object_num++) {
instruction.args [current_object_num] =
check_expression (instruction.args [current_object_num]);
}
} else if (instruction.name == "empty") {
if (dumpfl) putln ("* Checking an empty statement.");
// The empty statement is automatically correct.
/* All the recursion is done by the statements that are structured. */
} else if (instruction.name == "cond") {
// Here we juct iterate through all the possible alternatives,
// verifying whether each is correct.
for (var current_alternative_num = 0;
current_alternative_num < #instruction.args;
current_alternative_num += 2) {
instruction.args [current_alternative_num] =
check_expression (instruction.args [current_alternative_num]);
instruction.args [current_alternative_num + 1] =
check_instruction (instruction.args [current_alternative_num + 1]);
}
} else if (instruction.name == "for") {
// Here, it is even more basic.
if (dumpfl) putln ("* Checking a for loop.");
instruction.args [0] = check_instruction (instruction.args [0]);
instruction.args [2] = check_instruction (instruction.args [2]);
instruction.args [3] = check_instruction (instruction.args [3]);
instruction.args [1] = check_expression (instruction.args [1]);
} else if (instruction.name == "block") {
/* The block statement is resolved by a recursive invocation of
check_block(). */
instruction.args [0] = check_block (instruction.args [0]);
} else fatal_error ("Internal error in translator.");
if (dumpfl) {
putln ("* Checked instruction, value :");
print_instruction (instruction);
}
return instruction;
}
/* This function is used to check an expression and replace all tokens with
corresponding values. */
func check_expression (expression) {
/* Let us discuss the values that we need to check. Our errors
shall be found all in one operator: var. Its internal representation
is as follows:
| opr | opa1 | opa2 |
+-------+-------+---------+
| "var" | IDENT | ELEMENT |
As you can see, it acts both as a reference to a scalar value
and a vector. The other operators are trivial:
num : don't do anything.
neg, not : check opa1 only.
Otherwise, we check both operands. */
if (expression.opr == "num") { // Don't do anything except replace tokens:
expression.opa1 = expression.opa1.value;
} else if (expression.opr == "neg" ||
expression.opr == "not") { // Check opa1:
expression.opa1 = check_expression (expression.opa1);
} else if (expression.opr == "var") { // Check for errors.
/* The same errors are fixed here as the ones in the assignment
statement. In fact, almost the same procedure is used here,
except that we do only one recursive invokation at the end, and we
work on a different domain of objects. For a more detailed explanation
of the algorithm's quirks, see the procedure for assignment.*/
if (!(expression.opa1.value in block.vartable)) {
put (program_file, ":", expression.opa1.line_num, ":0: ");
error ("No such variable declared.");
} else {
/* Check for error #3. */
// if (type (block.vartable {expression.opa1.value}.value) == vector &&
// expression.opa2.opr == "num" &&
// int (expression.opa2.opa1.value) == 0) {
// put (program_file, ":", expression.opa1.line_num, ":0: ");
// error ("Structured value in scalar context.");
// }
// else
if (type (block.vartable {expression.opa1.value}.value) !=
vector &&
expression.opa2.opr != "num" &&
int (expression.opa2.opa1.value) != 0) {
put (program_file, ":", expression.opa1.value, ":0: ");
error ("Scalar value in structured context.");
}
}
expression.opa1 = expression.opa1.value;
expression.opa2 = check_expression (expression.opa2);
} else { // A binary operator. Recursively invoke check_expression():
expression.opa1 = check_expression (expression.opa1);
expression.opa2 = check_expression (expression.opa2);
}
return expression;
}
if (dumpfl) putln ("@ Initiating block checking.");
/* The main body of the function is quite trivial and consists of just a
for-loop. Also, we must process the declarations. */
for (var current_instruction_num = 0;
current_instruction_num < #block.exec;
current_instruction_num++)
block.exec [current_instruction_num] =
check_instruction (block.exec [current_instruction_num]);
// Process the declarations.
var current_declaration;
return block;
}
/* What we have left now is a couple of common tasks I found to be
easier to put in separate functions. */
// When an anode that is not supposed to turn up turns up, we finish
// with a diagnostic message.
func bad_anode () {
fatal_error ("Grammar 'grip.g' corrupted or internal error.");
}
// For flattening recursive lists. This is so easily encoded in functional
// programming languages like ML! Wish I could use it here, but the SPI
// doesn't allow it.
func flatten (list_anode_to_flatten, next_num) {
if (dumpfl) {
putln ("@ Executing flatten operation with:");
println (list_anode_to_flatten.transl);
print_anode (list_anode_to_flatten);
}
return // Last element or not?
(list_anode_to_flatten.name != "$nil" ?
[list_anode_to_flatten] @
flatten (list_anode_to_flatten.transl [next_num], next_num) : []);
}