|
Hosted by
 |
<?php
// $Date: 2004/03/01 01:44:25 $
// $Revision: 1.16 $
// $Author: jcrocholl $
$adofilename = $argv[1];
$dont_clear_head = true;
if ($adofilename and !$argv[2]) $input = file($adofilename);
else die("usage: $0 <input.ado>\n");
if (preg_match('/^(.*?)([^\/]+)\.ado$/', $adofilename, $m)) {
$filepath = $m[1];
$filestem = $m[2];
} else die("error: accept only .ado files");
// if ($adofilehandle = fopen($adofilename, 'r')) {
// fclose($adofilehandle);
// } else die("Cannot open file $outfilename\n");
$indent_level = 2;
require('plain.php');
require('formats.php');
require('heads.php');
function nametolower($input) {
$output = strtolower($input);
$output = preg_replace('/_/', ' ', $output);;
return $output;
}
function accessors($object, $package, $name, $type, $initial, $access) {
global $create_head, $create_body, $create_args;
global $ads_methods, $adb_methods;
if (preg_match('/^(.+_(List|Hash_Table))_Access$/', $type, $m)) {
if ($create_body) $create_body .= "\n";
$create_body .= " Result.$name := $m[1]s.Create;";
}
foreach (preg_split('/\s+/', $access) as $a) {
if ($a == 'Create') {
add_variable($create_head, $name, 'in', $type, '', $initial,
"The initial " . nametolower($name) . ".");
if ($create_body) $create_body .= "\n";
if ($type == 'String')
$create_body .= " To_String_Access($name, Result.$name);";
else $create_body .= " Result.$name := $name;";
if ($create_args) $create_args .= ', ';
$create_args .= $name;
// print "create args: $create_args\n";
} elseif ($a == 'Get') {
$head = array();
$head['type'] = 'function';
$head['name'] = "Get_$name";
add_variable($head, 'This', 'access', $object, '', '',
"The " . nametolower($object) . " to read from.");
add_variable($head, '', 'return', $type, '', '',
"The " . nametolower($name) . " of that " . nametolower($object) . ".");
$head['comments'][] = " -- Accessor to read the " . nametolower($name) .
" of a " . nametolower($object).".\n";
if ($ads_methods) $ads_methods .= "\n";
if ($adb_methods) $adb_methods .= "\n";
$ads_methods .= format_head($head, ';');
$adb_methods .= format_head($head, 'is');
$adb_methods .= " begin\n";
if ($type == 'String')
$adb_methods .= " return To_String(This.$name);\n";
else $adb_methods .= " return This.$name;\n";
$adb_methods .= " end Get_$name;\n";
} elseif ($a == 'Set') {
$head = array();
$head['type'] = 'procedure';
$head['name'] = "Set_$name";
add_variable($head, 'This', 'access', $object, '', '',
"The " . nametolower($object) . " to be updated.");
add_variable($head, $name, 'in', $type, '', $initial,
"The new " . nametolower($name) . " of that " . nametolower($object) . ".");
$head['comments'][] = " -- Mutator to update the " . nametolower($name) .
" of a " . nametolower($object).".\n";
if ($ads_methods) $ads_methods .= "\n";
if ($adb_methods) $adb_methods .= "\n" ;
$ads_methods .= format_head($head, ';');
$adb_methods .= format_head($head, 'is');
$adb_methods .= " begin\n";
if ($type == 'String')
$adb_methods .= " To_String_Access($name, This.$name);\n";
else $adb_methods .= " This.$name := $name;\n";
$adb_methods .= " end Set_$name;\n";
}
}
}
function add_this(&$head, $object) {
add_variable($head, 'This', 'access', $object, '', '',
'The ' . nametolower($object) . ' object instance.');
}
function method($type, $name, $abstract, $is) {
global $object, $input;
global $ads_methods, $adb_methods;
$head['type'] = $type;
$head['name'] = $name;
$first_variable = true;
$begin = false;
while ($input) {
$line = trim(array_shift($input));
if ($is) break;
if (preg_match('/^\(*(.+?)\s*:\s*(in|access)*\s*(out)*\s*(\S+?)' .
'(|\s*:=\s*(\S.+?))' .
'(\s*\)\s*is|\s*\)\s*;|\s*;|\s*\)|)' .
'\s*(|--\s+(.+))$/x', $line, $m)) {
if (!$m[9]) die("error: method $name parameter $m[1] has no comment\n");
if ($first_variable and $m[1] != 'This') add_this($head, $object);
$first_variable = false;
add_variable($head, $m[1], "$m[2]$m[3]", $m[4], '', $m[6], $m[9]);
} else {
break; // outta here!
}
}
if ($first_variable) add_this($head, $object);
if ($type == 'function') {
// die("$line\n");
if (preg_match('/^return\s*(\S+?)(|\s*;|\s+is)\s*(|--\s+(.+))$/x', $line, $m)) {
if (!$m[3]) die("error: return type of function $name has no comment\n");
add_variable($head, '', 'return', $m[1], '', '', $m[4]);
$line = trim(array_shift($input));
} else {
print "found: $line\n";
die("error: function $name has no return type\n");
}
}
if ($line == 'begin') {
$is = true;
$begin = true;
} elseif ($line == 'is') {
$is = true;
$line = trim(array_shift($input));
}
if ($is and !$begin) {
while ($input) {
if (preg_match('/^--/', $line)) break; // outta here!
if ($line == 'begin') break; // outta here!
if ($line) $line = " $line";
$declarations .= "$line\n";
$line = trim(array_shift($input));
}
}
while (preg_match('/^--\s/', $line)) {
$comment .= " $line\n";
$line = trim(array_shift($input));
}
$head['comments'][] = $comment;
if ($is) {
if ($line != 'begin') die("error in $name: expected 'begin', found '$line'\n");
$begin = true;
$line = array_shift($input);
}
while (true) {
if (!trim($line) and !$begin) break;
if (trim($line) == 'end;') break;
$line = ' ' . $line;
if (!$begin) $line = ' ' . $line;
$line = rtrim($line);
$body .= "$line\n";
if (!$input) break;
$line = array_shift($input);
}
if ($abstract) {
if ($ads_methods) $ads_methods .= "\n";
$ads_methods .= format_head($head, '');
$ads_methods .= " is abstract;\n";
} else {
if ($ads_methods) $ads_methods .= "\n";
$ads_methods .= format_head($head, ';');
if ($adb_methods) $adb_methods .= "\n" ;
if ($declarations) {
$adb_methods .= format_head($head, '');
$adb_methods .= " is\n";
$adb_methods .= $declarations;
} else {
$adb_methods .= format_head($head, 'is');
}
$adb_methods .= " begin\n";
$adb_methods .= $body;
$adb_methods .= " end $name;\n";
}
}
function read_attributes(&$input, $object) {
global $strings;
global $attr_head;
while ($input) {
$line = trim(array_shift($input));
if (preg_match('/^\s*$/', $line)) break;
if (preg_match('/^\s*end\s+record\s*;\s*$/', $line)) break;
preg_match('/^(\S+)\s*\:\s*([^\s\:;]+?)(|\s*:=\s*(\S.*?))\s*;' .
'\s*(|[^\s-][^-]*[^\s-])\s*(|--\s+(.+))$/', $line, $m);
$name = $m[1]; $type = $m[2]; $initial = $m[4];
$access = $m[5]; $comment = $m[7];
// print "$name, $type, $initial, $access, $comment\n";
accessors($object, $package, $name, $type, $initial, $access);
if ($type == 'String') {
$type = 'String_Access';
$strings = 1;
}
add_variable($attr_head, $name, '', $type, '', $initial, $comment);
}
}
function package_name($object) {
$package = $object;
if (preg_match('/^(.+)_Data$/', $package, $m2)) $package = $m2[1];
if (preg_match('/^(.+)_Collector$/', $package, $m2)) return $m2[1];
if (preg_match('/^(.+)_Printer$/', $package, $m2)) return $m2[1];
if (preg_match('/^(.+)_Box$/', $package, $m2)) $package = $m2[1];
if (preg_match('/tch$/', $package)) $package .= 'e';
if (preg_match('/x$/', $package)) $package .= 'e';
if ($package != 'Music'
and $package != 'Simple'
and !preg_match('/s$/', $package))
$package .= 's';
return $package;
}
function read_parent_attr($object, $extends) {
global $filepath;
global $attr_head;
global $create_args, $create_head, $create_body;
global $ads_methods, $adb_methods;
$package = package_name($extends);
$filestem = strtolower($package);
$filename = "$filepath$filestem.ado";
if (!file_exists($filename))
die("parent file $filename not found\n");
$input = file($filename);
while ($input) {
$line = trim(array_shift($input));
if (preg_match('/^(attributes)\s*$/', $line, $m) or
preg_match("/type\s+$extends\s+is(|\s+.+)\s+record\s*\$/", $line, $m)) {
read_attributes($input, $object);
if ($create_args) $create_args = "($create_args)";
$object_access = $object . '_Access';
// $create_body = " Result := $object($package.Create$create_args.All)'Access;";
// die("create head " . $create_head['types'][0] . "\n");
$attr_head = array();
$ads_methods = '';
$adb_methods = '';
break;
}
}
}
$state = '';
while ($input) {
$line = rtrim(array_shift($input));
// Convert legacy object declarations to new style.
$line2 = '';
if (preg_match('/^\s*(|abstract\s+)(|tagged\s+)object\s+(\S+)' .
'(|\s+extends\s+(\S+))\s*$/', $line, $m)) {
if ($m[1]) $line2 .= 'abstract ';
$line2 .= "type $m[3]";
$line2 .= ' is';
if ($m[5]) $line2 .= " new $m[5] with";
if ($m[2]) $line2 .= ' tagged';
$line2 .= ' record';
// print("old: $line\n");
// print("new: $line2\n");
// die("converted\n");
$line = $line2;
}
if (preg_match('/^\s*(|abstract\s+)type\s+(\S+)\s+is\s+' .
'(|new\s+(\S+)\s+with\s+)(|tagged\s+)(|null\s+)record\s*;*$/', $line, $m)) {
$abstract = $m[1];
if ($abstract) $abstract = ' abstract';
$tagged = $m[5];
if ($tagged) $tagged = ' tagged';
$null = $m[6];
$object = $m[2];
// $create_body = " Result := new $object;";
$extends = $m[4];
if ($extends) read_parent_attr($object, $extends);
$object_access = $object . '_Access';
$object_lower = nametolower($object);
$object_hyphen = str_replace(' ', '-', $object_lower);
// print "$object_lower\n";
$package = package_name($object);
if ($extends) $package = package_name($extends) . '.' . $package;
// read attributes, unless legacy style
if (!$line2 and !$null) read_attributes($input, $object);
}
if (preg_match('/^(|body-)with\s+(\S.+\S)\s*$/', $line, $m)) {
foreach (preg_split('/\s+/', $m[2]) as $pkg) {
if (preg_match('/\+(.+)/', $pkg, $m2))
$pkg = "$m2[1]; use $m2[1]";
if (!$m[1]) $with .= "with $pkg;\n";
else $body_with .= "with $pkg;\n";
}
}
if (preg_match('/^(|abstract\s+)(procedure|function)\s+' .
'([^\s;]+)(\s+(is)|\s*;|)\s*$/', $line, $m)) {
method($m[2], $m[3], $m[1], $m[5]);
}
if (trim($line) == 'end;') $state = '';
elseif (trim($line) == 'attributes') read_attributes($input, $object);
elseif (trim($line) == 'pre-public') $state = trim($line);
elseif (trim($line) == 'post-public') $state = trim($line);
elseif (trim($line) == 'pre-private') $state = trim($line);
else {
if (preg_match('/^(--.+\S)/', $line, $m)) $head_comment .= "$m[1]\n";
else {
if (preg_match('/\S/', $line)) $line = ' ' . $line;
if ($state == 'pre-public') { $pre_public .= "$line\n"; }
elseif ($state == 'post-public') { $post_public .= "$line\n"; }
elseif ($state == 'pre-private') { $pre_private .= "$line\n"; }
}
}
}
$object_access = $object . '_Access';
if ($pre_public) $pre_public .= "\n";
if ($post_public) $post_public .= "\n";
if ($pre_private) $pre_private .= "\n";
if ($body_with) $body_with .= "\n";
if ($create_body) $create_body .= "\n";
if ($with) $with .= "\n";
if ($strings) {
$with .= "with Strings; use Strings;\n\n";
}
add_variable($create_head, '', 'return', $object_access, '', '',
"The newly created " . nametolower($object) . ".");
$create_head['comments'][] = " -- Constructor for instances.\n";
$create_head['type'] = 'function';
$create_head['name'] = 'Create';
// add_variable($create_var, 'Result', '', $object_access, '', '', '');
// if ($extends) {
// add_variable($create_var, 'Result', '', $object_access, '',
// "$extends.Create($parent_create_args)", '');
// } else {
add_variable($create_var, 'Result', '', $object_access, '', "new $object", '');
// }
if (!$abstract) {
if ($ads_methods) $ads_methods = "\n" . $ads_methods;
$ads_methods = format_head($create_head, ';') . $ads_methods;
if ($adb_methods) $adb_methods = "\n" . $adb_methods;
$adb_methods =
format_head($create_head, '') .
" is\n" .
format_head($create_var, '') .
" begin
$create_body return Result;
end Create;
" . $adb_methods;
}
if ($extends) $indent_level++;
$attributes = format_head($attr_head, '');
$auto_header = '
-- This file was automatically created with ado.php.
-- Manual changes will be lost when it is updated.
' . "\n";
?>
|
