#!/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);

?>