MODULE calculator;
!++
!    A sample VAX SCAN program that demonstrates many of the scanning
!    features peculiar to VAX SCAN.
!    
!    It implements this simple grammar shown in production format:
!    
!	<exp>    :== <exp> + <term> | <exp> - <term> | <term>
!	<term>   :== <term> * <factor> | <factor>
!	<factor> :== ( <exp> ) | number
!    
!    Expressions are evaluated and each result displayed.
!    
!    number can be any combination of the following:
!    
!	integer
!	pica&point
!       hour:minutes
!       integer.integer (in hundreths)
!    
!--

    CONSTANT add_op = 1;
    CONSTANT sub_op = 2;
    CONSTANT mul_op = 3;
    CONSTANT div_op = 4;

    CONSTANT time_unit = 60;
    CONSTANT real_unit = 100;
    CONSTANT pica_point_unit = 12;

    DECLARE operator, unit: TREE( STRING ) OF INTEGER;
    DECLARE result_type, error_msg : STRING;

    SET digit ( '0' .. '9' );
    SET white_space ( ' ' OR S'HT' );

    TOKEN number { digit ... };
    TOKEN space IGNORE { white_space ... };

    TOKEN left_paren ALIAS '(' { '(' };
    TOKEN right_paren ALIAS ')' { ')' };

    TOKEN start_up { S'SOS' };
    TOKEN end_of_expression { S'EOL' };
    TOKEN finish_up { S'EOS' };

    TOKEN unit_type { '.' | ':' | '&' };

    TOKEN add_operator { '+' };
    TOKEN subtract_operator { '-' };
    TOKEN multiply_operator { '*' };
    TOKEN divide_operator { '/' };

    GROUP expression_operator ( add_operator OR subtract_operator );
    GROUP term_operator ( multiply_operator OR divide_operator );


    INCLUDE FILE 'sysdeflib$:recovery_packet.scndef';

    CONSTANT def_err = 0;
    DECLARE exp_err : BOOLEAN;

    PROCEDURE expression_error( error_packet: recovery_packet );

	exp_err = TRUE;

    END PROCEDURE /* expression_error */;

    MACRO calculation TRIGGER { start_up ERROR( expression_error(def_err) ): {
	e: expression end_of_expression } finish_up };

!   This is the only trigger macro.
!   The error construct prevents universal tokens from slipping through.

	IF exp_err
	THEN
	    error_msg = '** improper expression **';
	    ANSWER '';
	ELSE
	    ANSWER e;
	END IF;

	ANSWER S'EOS';

    END MACRO /* calculation */;


    MACRO expression SYNTAX { t: term \ op: expression_operator };
    DECLARE i, v : INTEGER;

	v = INTEGER( t( 1 ) );

	FOR i = 2 TO SUBSCRIPT( LAST( t ) );

	    CASE operator( op( i ) ) FROM add_op TO sub_op;
		[ add_op ] :
		    v = v + INTEGER( t( i ) );
		[ sub_op ] :
		    v = v - INTEGER( t( i ) );
		[ INRANGE, OUTRANGE ] :
		    error_msg = '** bad case index for expression **';
		    STOP SCAN;
	    END CASE;

	END FOR;

	ANSWER STRING( v );

    END MACRO /* expression */;

    MACRO term SYNTAX { f: factor \ op: term_operator };
    DECLARE i, v : INTEGER;

	v = INTEGER( f( 1 ) );

	FOR i = 2 TO SUBSCRIPT( LAST( f ) );

	    CASE operator( op( i ) ) FROM mul_op TO div_op;
		[ mul_op ] :
		    v = v * INTEGER( f( i ) );
		    IF result_type = '.' 
		    THEN
			v = v / unit( result_type );
		    END IF;
		[ div_op ] :
		    v = v / INTEGER( f( i ) );
		    IF result_type = '.' 
		    THEN
			v = v * unit( result_type );
		    END IF;
		[ INRANGE, OUTRANGE ] :
		    error_msg = '** bad case index for term **';
		    STOP SCAN;
	    END CASE;

	END FOR;

	ANSWER STRING( v );

    END MACRO /* term */;

    MACRO factor SYNTAX { n: compound_number | '(' e: expression ')' };

	ANSWER n & e;

	END MACRO /* factor */;

    MACRO compound_number SYNTAX { n: number [ u: unit_type [ w: number ] ]
	| uo: unit_type wo: number };
    DECLARE v : INTEGER;

	IF n = '' 
	THEN
	    v = 0;
	    u = uo;
	    w = wo;
	ELSE
	    v = INTEGER( n );
	    IF w = '' 
	    THEN
		w = '0';
	    END IF;
	END IF;

	IF u <> '' 
	THEN
	    IF result_type <> '' AND result_type <> u
	    THEN
		error_msg = '** mixed calculation modes **';
		STOP SCAN;
	    END IF;

	    v = unit( u ) * v + INTEGER( w );
	ELSE
	    IF result_type <> ''
	    THEN
		v = unit( result_type ) * v;
	    END IF;
	END IF;

	ANSWER STRING( v );

    END MACRO /* compound_number */;

    LIST PAGE;

    PROCEDURE calculate MAIN;
    DECLARE evaluatee, result, decimal : STRING;
    DECLARE i : INTEGER;

    operator( ''   ) = 0;
    operator( '+'  ) = add_op;
    operator( '-'  ) = sub_op;
    operator( '*'  ) = mul_op;
    operator( '/'  ) = div_op;

    unit( ':' ) = time_unit;
    unit( '.' ) = real_unit;
    unit( '&' ) = pica_point_unit;

    READ PROMPT ('> ') evaluatee;
    WHILE ( NOT ENDFILE() );

	error_msg = '';
	exp_err = FALSE;
	result = '';
	result_type = '';
	i = INDEX(evaluatee, '.');
	IF i = 0 THEN i = INDEX(evaluatee, ':'); END IF;
	IF i = 0 THEN i = INDEX(evaluatee, '&'); END IF;
	IF i > 0 THEN result_type = evaluatee[ i ]; END IF;

	START SCAN
	    INPUT STRING evaluatee & S'EOL'
	    OUTPUT STRING result;

	IF error_msg <> '' 
	THEN
	    WRITE error_msg;
	    GOTO next_exp;
	END IF;

	IF result_type <> '' 
	THEN
	    i = INTEGER( result );
	    result = STRING( i / unit( result_type ) ) & result_type;
	    decimal = STRING( MOD( i, unit( result_type ) ) );
	    IF result_type = '.' AND LENGTH( decimal ) = 1
	    THEN
		decimal = '0' & decimal;
	    END IF;
	    result = result & decimal;
	END IF;

	result = '  = ' & result;
	WRITE result;

next_exp:
        READ PROMPT ('> ') evaluatee;
    END WHILE;

    END PROCEDURE /* calculate */;

END MODULE /* calculator */;