Hosted by
 |
#!/usr/bin/php -qC <?php
// $Date: 2004/01/13 12:45:12 $ // $Revision: 1.12 $ // $Author: jcrocholl $
$adofilename = $argv[1];
if (preg_match('/^(.+)\.ado$/', $adofilename, $m)) { $adsfilename = "$m[1].ads"; $adbfilename = "$m[1].adb"; } else $adofilename = '';
if ($adofilename and !$argv[2]) $input = file($adofilename); else die("usage: $0 <input.ado>\n");
// 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, $access) { global $create_head, $create_body; global $ads_methods, $adb_methods; foreach (preg_split('/\s+/', $access) as $a) { if ($a == 'Create') { add_variable($create_head, $name, 'in', $type, '', '', "The initial " . nametolower($name) . "."); if ($create_body) $create_body .= "\n"; if ($type == 'String') $create_body .= " Result.$name := To_Unbounded_String($name);"; else $create_body .= " Result.$name := $name;"; } elseif ($a == 'Get') { $head = array(); $head['type'] = 'function'; $head['name'] = "Get_$name"; add_variable($head, 'This', 'in', $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', 'in', $object, '', '', "The " . nametolower($object) . " to be updated."); add_variable($head, $name, 'in', $type, '', '', "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 .= " This.$name := To_Unbounded_String($name);\n"; else $adb_methods .= " This.$name := $name;\n"; $adb_methods .= " end Set_$name;\n"; } } }
function method($type, $name) { global $object, $input; global $ads_methods, $adb_methods; $head['type'] = $type; $head['name'] = $name; add_variable($head, 'This', 'in', $object, '', '', 'The ' . nametolower($object) . ' object instance.'); while ($input) { $line = array_shift($input); if (preg_match('/^(.+?)\s*:\s*(in)*\s*(out)*\s*(\S+?)(|;)\s*--\s+(.+)$/x', $line, $m)) { add_variable($head, $m[1], "$m[2]$m[3]", $m[4], '', '', $m[6]); } else { break; // outta here! } }
if ($type == 'function') { if (preg_match('/^return\s*(\S+?)(|;)\s*--\s+(.+)$/x', $line, $m)) { add_variable($head, '', 'return', $m[1], '', '', $m[3]); $line = array_shift($input); } else { die("error: function $name has no return type\n"); } }
while (preg_match('/^--\s/', $line)) { $comment .= " $line"; $line = array_shift($input); } $head['comments'][] = $comment;
while (preg_match('/\S/', $line)) { $line = rtrim($line); $body .= " $line\n"; $line = array_shift($input); }
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"; $adb_methods .= $body; $adb_methods .= " end $name;\n"; }
$state = ''; while ($input) { $line = array_shift($input); if (preg_match('/^object\s+(.+)\s*$/', $line, $m)) { $object = $m[1]; $package = $object . 's'; }
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('/^(procedure|function)\s+(\S+)\s*$/', $line, $m)) { method($m[1], $m[2]); } // no blank lines between attributes if (preg_match('/^\s*$/', $line) and $state == 'attributes') $state = '';
if ($state == 'attributes') { preg_match('/^(\S+)\s*\:\s*(\S+?)(|;)(\s+.*?)\s*(|--\s+(.+))$/', $line, $m); $name = $m[1]; $type = $m[2]; $access = $m[4]; $comment = $m[6]; accessors($object, $package, $name, $type, $access);
if ($type == 'String') { $type = 'Unbounded_String'; $unbounded = 1; } add_variable($attr_head, $name, '', $type, '', '', $comment); }
if ($state == 'pre-public') { $pre_public .= " $line"; }
if ($state == 'pre-private') { $pre_private .= " $line"; }
if (preg_match('/^(attributes)\s*$/', $line, $m)) { $state = $m[1]; } elseif (preg_match('/^(pre-private)\s*$/', $line, $m)) { $state = $m[1]; } elseif (preg_match('/^(pre-public)\s*$/', $line, $m)) { $state = $m[1]; } }
$object_record = $object . '_Record';
if ($pre_public) $pre_public .= "\n"; if ($pre_private) $pre_private .= "\n"; if ($body_with) $body_with .= "\n"; if ($with) $with .= "\n"; if ($unbounded) { $with .= "with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;\n\n"; }
add_variable($create_head, '', 'return', $object, '', '', "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, '', "new $object_record", ''); $ads_methods = format_head($create_head, ';') . "\n" . $ads_methods; $adb_methods = format_head($create_head, '') . " is\n" . format_head($create_var, '') . " begin $create_body return Result; end Create;
" . $adb_methods;
$attributes = format_head($attr_head, '');
$ads = $adb = '-- $'.'Date$ -- $'.'Revision$ -- $'.'Author$
-- This file was automatically created with ado.php. -- Manual changes will be lost when it is updated.
';
$ads .= $with . "package $package is
-- Type for instance variables. type $object is private;
$pre_public$ads_methods private
$pre_private -- Private representation. type $object_record is record $attributes end record;
-- Pointer to representation data. type $object is access $object_record;
end $package; ";
$adb .= $body_with . "package body $package is
$adb_methods end $package; ";
if (!$adsfilehandle = fopen($adsfilename, 'w')) die("could not open $adsfilename with write access\n"); if (!fwrite($adsfilehandle, $ads)) die("could not write $adsfilename\n"); fclose($adsfilehandle);
if (!$adbfilehandle = fopen($adbfilename, 'w')) die("could not open $adbfilename with write access\n"); if (!fwrite($adbfilehandle, $adb)) die("could not write $adbfilename\n"); fclose($adbfilehandle);
?>
|