<?php

// $Date: 2004/01/13 03:22:20 $
// $Revision: 1.30 $
// $Author: jcrocholl $

require('heads.php');
require(
'formats.php');

$indent_chars = 3; // how many characters to indent per level
$indent_level = 0; // current indentation level
$indent_conti = 2; // indentation for continuing lines

// each of these regex shortcuts
// has exactly one paren group
$i = '("."|"abs"|">="|"<="|[\w\.]+)'; // identifier
$c = '--\s*(.*)'; // comment
$p = '\((.+?)\)'; // parameters

// regex shortcut for variables
$v =
"/^(|\()\s*($i(\s*,\s*$i)*)\s*:\s*" .
"(in)*\s*(out)*\s*(constant|access)*\s*" .
"$i(|$p)\s*(|:=\s*(.+?))\s*";
                              
function
output($text) {
    global
$comment_block;
    if (
$comment_block) myprint($comment_block);
    
$comment_block = '';

    global
$head;
    if (
$head) myprint(format_head($head));

    
myprint($text);
    global
$continuing; $continuing = 0;
}

function
unindent(&$text) {
    
$text = str_replace(indent(), '', $text);
}

$auto_comments = array();
function
auto_comments() {
    global
$head, $comment_block, $auto_comments;
    global
$auto_comments_save, $auto_comments_load;
    
$signature = signature($head);

    if (
$comment_block) {
        
// print $comment_block;
        
$head['comments'][] = $comment_block;
        
$comment_block = '';
    }

    if (
$auto_comments_save) {
        print
"storing $signature\n";
        if (
array_key_exists($signature, $auto_comments))
            exit(
"error: duplicate method signature:\n$signature\n");
        
$auto_comments[$signature] = $head['comments'];
        if (!
array_key_exists($signature, $auto_comments))
            exit(
"error: saving comments failed\n");
    }

    if (
$auto_comments_load) {
        print
"loading $signature\n";
        if (
array_key_exists($signature, $auto_comments)) {
            
$head['comments'] = $auto_comments[$signature];
        } else {
            print
"warning: loading comments failed, only the following signatures found:\n";
            foreach (
array_keys($auto_comments) as $key) print "        $key\n";
        }
    }
}

function
parse($filename) {
    global
$i, $c, $p, $v;
    global
$parsefilename, $line_number, $line;
    global
$procedure_is;
    global
$indent_level, $indent_conti, $continuing;
    global
$comment_block;
    global
$head;

    
$parsefilename = $filename;
    
$input = file($parsefilename);
    while (
$input) {
        
$line_number++;
        
$line = trim(array_shift($input));

        if (
$line_number == 1 and
            !
preg_match('/^--\s\$' . 'Date/', $line)) {
            
output(comment('-- $' . 'Date$') . newline());
            
output(comment('-- $' . 'Revision$') . newline());
            
output(comment('-- $' . 'Author$') . newline());
            
output(newline());
        }
        
        if (
preg_match("/^$/", $line, $m)) {
            
$procedure_is = false;
            
output(newline());
            
            
// comments
        
} elseif (preg_match("/^--(\s*)(.*?)$/", $line, $m)) {
            if (
$m[1]) $m[1] = ' ';
            if (
$head) output(format_head($head));
            
$comment_block .= indent() . comment("--$m[1]$m[2]") . newline();
            
            
// with and use clauses
        
} elseif (preg_match("/^with\s+$i\s*;$/", $line, $m)) {
            
output(indent() . keyword('with ') . package($m[1]) . ';' . newline());
        } elseif (
preg_match("/^use\s+$i\s*;$/", $line, $m)) {
            
output(indent() . keyword('use ') . package($m[1]) . ';' . newline());
        } elseif (
preg_match("/^use\s+type\s+($i(,\s*$i))*\s*;$/", $line, $m)) {
            
output(indent() . keyword('use ') . keyword('type '));
            
output(illegal($m[1]) . ';' . newline());
        } elseif (
preg_match("/^with\s+$i\s*;\s*" .
                             
"use\s+$i\s*;$/", $line, $m)) {
            
output(indent() . keyword('with ') . package($m[1]) . '; ');
            
output(keyword('use ') . package($m[2]) . ';' . newline());
            
            
// generic and private
        
} elseif (preg_match("/^(generic)$/", $line, $m)) {
            
output(indent() . keyword($m[1]) . newline());
            
$indent_level++;
        } elseif (
preg_match("/^(private)$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword($m[1]) . newline());
            
$indent_level++;
            
            
// package
        
} elseif (preg_match("/^(package)\s+((body)\s+)*$i\s+(is)(\s+(.+);)*$/", $line, $m)) {
            if (!
$package_name) {
                
$package_name = $m[4];
                
$indent_level = 1;
                
unindent($comment_block);
            } else
output(indent());
            
output(keyword($m[1]));
            if (
$m[3]) output(keyword(" $m[3]"));
            
output(name(" $m[4] ") . keyword($m[5]));
            if (
$m[7]) {
                if (
preg_match("/^new\s+$i(\((.+)\))$/", $m[7], $m2)) {
                    
output(keyword(' new ') . package($m2[1]));
                    if (
$m2[2]) output('(' . illegal($m2[3]) . ')');
                } else
output(illegal(" $m[7]"));
                
output(';');
            } elseif (
$package_name != $m[4]) {
                
$procedure_is = true;
                
$indent_level++;
            }
            
output(newline());
            
            
// types
        
} elseif (preg_match("/^((sub)*type)\s+$i(|$p)\s*(is)\s+(.+?)\s*(;*)$/", $line, $m)) {
            
output(indent() . keyword($m[1]) . type(" $m[3]"));
            if (
$m[5]) output('(' . bounds($m[5]) . ')');
            
output(keyword(" $m[6]"));
            if (
preg_match("/^(|abstract\s+)(|tagged\s+)record$/", $m[7], $m2)) {
                if (
$m2[1]) output(keyword(' abstract'));
                if (
$m2[2]) output(keyword(' tagged'));
                
output(keyword(' record'));
                
$indent_level++;
            } elseif (
$m[7] == 'private') {
                
output(keyword(" $m[7]"));
            } elseif (
preg_match("/^(access)\s+$i$/", $m[7], $m2)) {
                
output(keyword(" $m2[1] ") . type($m2[2]));
            } elseif (
preg_match("/^new\s+$i*\s+with\s+" .
                                 
"(record|null\s+record)$/", $m[7], $m2)) {
                
output(keyword(' new ') . type($m2[1]) . keyword(' with '));
                if (
$m2[2] == 'record') {
                    
output(keyword('record'));
                    
$indent_level++;
                } else {
                    
output(keyword('null ') . keyword('record'));
                }
            } elseif (
$m[7]) {
                
output(typespec(" $m[7]"));
            }
            
output($m[8] . newline());
        } elseif (
preg_match("/^(type)\s+$i\s*;$/", $line, $m)) {
            
output(indent() . keyword($m[1]) . type(" $m[2]") . ';' . newline());
        } elseif (
preg_match("/^(type)\s+$i(\((.+)\))*\s+(is)$/", $line, $m)) {
            
output(indent() . keyword($m[1]) . type(" $m[2]"));
            if (
$m[3]) output('(' . modifier($m[4]) . ')');
            
output(keyword(" $m[5]") . newline());
            
$indent_level++;
            
$procedure_is = true;
        } elseif (
preg_match("/^(new)\s+$i(\((.+)\))*\s+(with)$/", $line, $m)) {
            
output(indent(-1) . keyword($m[1]) . type(" $m[2]"));
            if (
$m[3]) output('(' . actual($m[4]) . ')');
            if (
$m[5]) {
                
output(keyword(" $m[5]"));
            } else {
                
$indent_level--;
            }
            
output(newline());
        } elseif (
preg_match("/^((abstract)\s+|(tagged)\s+)*(record)$/", $line, $m)) {
            
$extra_record_indent = true;
            
output(indent());
            if (
$m[2]) output(keyword('abstract '));
            if (
$m[3]) output(keyword('tagged '));
            
output(keyword('record') . newline());
            
$indent_level++;
        } elseif (
preg_match("/^array\s*$p\s+of\s+$i;/", $line, $m)) {
            
$indent_level--;
            
output(indent(2));
            
output(keyword('array') . '(' . actual($m[1]) . ')');
            
output(keyword(' of ') . type($m[2]) . ';');
            
output(newline());

            
// exceptions
        
} elseif (preg_match("/^$i\s*:\s*exception(|;)$/", $line, $m)) {
            
output(indent() . $m[1] . ' : ' . type('exception'));
            if (
$m[2]) output(';');
            else
$indent_level++;
            
output(newline());
            
            
// generic and renamed procedures
        
} elseif (preg_match("/^procedure\s+$i\s+is\s+new\s+(.+)\s*;$/", $line, $m)) {
            
output(indent() . keyword('procedure ') . name($m[1]) . keyword(' is'));
            
output(keyword(' new ') . illegal($m[2]) . ';' . newline());
        } elseif (
$procedure_is and preg_match("/^new\s+(.+)\s*;$/", $line, $m)) {
            
output(indent(-1) . keyword('new ') . generic($m[1]) . ';' . newline());
            
$indent_level--;
        } elseif (
preg_match("/^renames\s+$i\s*;$/", $line, $m)) {
            
$indent_level--;
            
output(indent(2) . keyword('renames ') . $m[1] . ';' . newline());
            
            
// procedures and functions
        
} elseif (preg_match("/^(|with\s+)(function|procedure)\s+$i(|\s+(is))$/", $line, $m)) {
            if (!
$m[1] and !$package_name) $package_name = $m[3];
            
$procedure_is = $m[5] == 'is';
            
$indent_level++;
            if (
$m[1]) $head['with'] = 'with ';
            
$head['type'] = $m[2];
            
$head['name'] = $m[3];
            if (
$procedure_is) {
                
auto_comments();
                
output(format_head($head, 'is'));
            }
        } elseif (
preg_match("/^function\s+$i\s+return\s+$i(|$p)\s*(;|is)\s*(|$c)$/", $line, $m)) {
            
output(indent() . keyword('function ') . name($m[1]));
            
output(keyword(' return ') . type($m[2]));
            if (
$m[4]) output('(' . bounds($m[4]) . ')');
            if (
$m[5] == 'is') {
                
$indent_level++;
                
output(keyword(' is'));
            } else
output(';');
            
output(newline());
        } elseif (
preg_match("/^(|with\s+)function\s+$i(|$p)\s+" .
                             
"return\s+$i\s*(;|is\s+<>\s*;)$/", $line, $m)) {
            
output(indent());
            if (
$m[1]) output(keyword('with '));
            
output(keyword('function ') . name($m[2]));
            if (
$m[4]) output('(' . illegal($m[4]) . ')');
            
output(keyword(' return ') . type($m[5]));
            if (
$m[6] == ';') {
                
output(';');
            } else {
                
output(keyword(' is') . ' <>;');
            }
            
output(newline());
            
            
// variables
        
} elseif ((preg_match("$v(|\))\s*(|;|is)\s*(|$c)$/", $line, $m)
                   and
check_parens($m[11])
                   and
check_parens($m[13]))
                  or
                  (
preg_match("$v()\s*(;|is)\s*(|$c)$/", $line, $m)
                   and
check_parens($m[11])
                   and
check_parens($m[13])))
        {
            
// _variable($name, $mode,            $type, $bound, $initial, $comment)
            
add_variable($head, $m[2], "$m[6]$m[7]$m[8]", $m[9], $m[11], $m[13], $m[17]);
            
//            param($m[1], "$m[3]$m[4]$m[5]", $m[6], $m[7],  $m[9],  $m[12]);
            // print "$m[17]<br/>\n"; // should be the comment
            
if ($m[14]) { // closing paren
                
if ($head['type'] == 'procedure') {
                    
auto_comments();
                    
output(format_head($head, $m[15]));
                    if (
$m[15] == ';') $indent_level--;
                } elseif (
$head['type'] == 'function') {
                    if (
$m[15]) exit("error: function return value is missing\n");
                }
            }
            
            
// function return values
        
} elseif ($head['type'] == 'function' and
                  
preg_match("/^return\s+$i(|$p)\s*(|;|is)\s*(|$c)$/", $line, $m)) {
            
// print "function match<br/>\n";
            // _variable($head, $name, $mode, $type, $bound, $initial, $comment)
            
add_variable($head, '', 'return', $m[1], $m[3],  '',       $m[6]);
            
auto_comments();
            
output(format_head($head, $m[4]));
            if (
$m[4] == ';') $indent_level--;
            
            
// function / procedure neck: is
        
} elseif (preg_match("/^is$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('is') . newline());
            
$indent_level++;
        } elseif (
preg_match("/^is\s+(<>|abstract);$/", $line, $m)) {
            
$indent_level--;
            
output(indent(2) . keyword('is '));
            if (
$m[1] == '<>') output('<>');
            else
output(keyword($m[1]));
            
output(';'. newline());
            
            
// pragma
        
} elseif (preg_match("/^pragma\s+(.+?)$/", $line, $m)) {
            
output(indent() . keyword('pragma ') . illegal($m[1]) . newline());
            if (!
preg_match('/;(|\s*--.+)$/', $m[1]))
                
$continuing = $indent_conti;
            
            
// declare
        
} elseif (preg_match("/^declare$/", $line, $m)) {
            
output(indent() . keyword('declare') . newline());
            
$declare_end = true;
            
$indent_level++;
            
            
// begin
        
} elseif (preg_match("/^begin$/", $line, $m)) {
            
$procedure_is = false;
            if (
$head['names']) output(format_head($head));
            
$indent_level--;
            
output(indent() . keyword('begin') . newline());
            
$indent_level++;
            
            
// loop
        
} elseif (preg_match("/^loop/", $line, $m)) {
            
output(indent() . keyword('loop') . newline());
            
$indent_level++;
        } elseif (
preg_match("/^while\s+(.+?)\s+loop/", $line, $m)) {
            
output(indent() . keyword('while ') . illegal($m[1]));
            
output(keyword(' loop') . newline());
            
$indent_level++;
        } elseif (
preg_match("/^for\s+(.+?)\s+in\s+(.+?)\s+loop/", $line, $m)) {
            
output(indent() . keyword('for '));
            
output(illegal($m[1]) . keyword(' in ') . illegal($m[2]));
            
output(keyword(' loop') . newline());
            
$indent_level++;
            
            
// if
        
} elseif (preg_match("/^if\s+(.+?)\s+then\s+(.+?)\s+end\s+if\s*;$/", $line, $m)) {
            
output(indent() . keyword('if ') . illegal($m[1]) . keyword(' then '));
            
output(illegal($m[2]) . keyword(' end ') . keyword('if') . ';' . newline());
        } elseif (
preg_match("/^((els)*if)\s+(.+?)\s+then(|\s+(.+))$/", $line, $m)) {
            if (
$m[2]) $indent_level--;
            
output(indent() . keyword("$m[1] "));
            
output(illegal($m[3]) . keyword(' then'));
            if (
$m[5]) output(' ' . illegal($m[5]));
            
output(newline());
            
$indent_level++;
        } elseif (
preg_match("/^(if|elsif|and|or|while)(\s+(then)|\s+(else)|)\s+(.+?)$/", $line, $m)) {
            if (
$m[1] == 'elsif') $indent_level--;
            
output(indent($continuing) . keyword($m[1]));
            if (
$m[3]) output(keyword(" $m[3]"));
            if (
$m[4]) output(keyword(" $m[4]"));
            
output(illegal(" $m[5]") . newline());
            
$continuing = $indent_conti;
        } elseif (
preg_match("/^then\s*(.*)$/", $line, $m)) {
            
output(indent() . keyword('then'));
            if (
$m[1]) output(' ' . illegal($m[1]));
            
output(newline());
            
$indent_level++;
        } elseif (
preg_match("/^else\s+(.+?)$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('else ') . illegal($m[1]) . newline());
            
$indent_level++;
        } elseif (
preg_match("/^else$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('else') . newline());
            
$indent_level++;
            
            
// case
        
} elseif (preg_match("/^case\s+$i\s+is/", $line, $m)) {
            
output(indent() . keyword('case ') . illegal($m[1]));
            
output(keyword(' is') . newline());
            
$indent_level++;
        } elseif (
preg_match("/^when\s+(.+?)\s*=>\s*(.*)/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('when ') . illegal($m[1]));
            
output(' =>');
            if (
$m[2]) output(' ' . illegal($m[2]));
            
output(newline());
            
$indent_level++;

            
// end
        
} elseif (preg_match("/^end\s*;$/", $line, $m)) {
            
$indent_level--;
            
output(indent());
            if (
$declare_end) output(keyword('end') . ';');
            else
output(illegal($line));
            
output(newline());
            
$declare_end = false;
        } elseif (
preg_match("/^end\s+record\s*;$/", $line, $m)) {
            
output(format_head($head));
            
$indent_level--;
            
output(indent() . keyword('end') . keyword(' record') . ';' . newline());
            if (
$extra_record_indent) $indent_level--;
            
$extra_record_indent = false;
        } elseif (
preg_match("/^end\s+if\s*;$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('end') . keyword(' if') . ';' . newline());
        } elseif (
preg_match("/^end\s+loop\s*;$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('end') . keyword(' loop') . ';' . newline());
        } elseif (
preg_match("/^end\s+case\s*;$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('end') . keyword(' case') . ';' . newline());
        } elseif (
preg_match("/^end\s+$i\s*;$/", $line, $m)) {
            
$indent_level--;
            
output(indent() . keyword('end ') . name($m[1]) . ';' . newline());
            
            
// all other stuff is illegal
        
} else {
            
output(indent($continuing) . illegal($line) . newline());
            if (!
preg_match('/;(|\s*--.+)$/', $line))
                
$continuing = $indent_conti;
        }
    }
}

?>