On 10 Aug 2005, at 09:56, Pascal Viandier wrote:

Hi,

...

Pascal Viandier wrote:

...

...

When I say "compatible types", I say records with the same fields in the same order so I presume the padding bits and bytes would be done the same way.

Yes, but the pad bits and bytes can have random values ...

Ha! If only I could use FillChar() on the record before using it, there would be no problem! (Did you read the FillChar Suggestion thread?) This looks like a typical good reason to use it... I suppose the Extended Pascal's initial-state-specifier does not make initialization on padding bits and bytes neither.

Strings vary in length, record components take on different variants. Even if there were block-memory initialization, comparing whole records as memory blocks is hazardous. I wonder if the Sun compiler is really just generating code to do field-by-field comparisons? Knowing yoru own data and algorithm, I bet you could write a user program recordcompare function (you'd need one for each record type) taking account of your algorithm, that would usually only need to compare one field and thus would be very fast.

Willett Kempton

...

Yes, but the pad bits and bytes can have random values ...

Ha! If only I could use FillChar() on the record before using it, there would be no problem! (Did you read the FillChar Suggestion thread?) This looks like a typical good reason to use it... I suppose the Extended Pascal's initial-state-specifier does not make initialization on padding bits and bytes neither.

You could do this:

FillChar( record with zeros ) Initialize( record ) fill in fields.

Changes are good that from then on the padding would stay valid, since you typically either pass pointers to records or assign them completely, which should preserve the padding bits as zero.

Personally, I'd have a serious word with any a programmer who worked with me who did such a thing and relied on it, but perhaps it would get you going for the short term.

At 11:28 -0400 10/8/05, Pascal Viandier wrote:

For sure I will have to generate functions to do the comparisons thus making the code bigger than it was. I already generated procedures to initialize them field by field, and conditional-compiled procedures to print their contents for debugging purpose since gdb cannot display them properly. Hard times...

Actually, it might make more source code, but smaller binary if they are done as functions rather than inline, especially if the Sun compiler actually does the right thing and compares by fields.

That said, I don't think it would be all that much work to define = and <> operators for any given record type - heck you could probably write a quick script which would generate the code.

In fact, since I have way too much to do, here is a script to create operators from record types, eg:

type PersonRec = record Age: Integer; case EyeColor: EyeColorType of Red, Green : (WearsGlasses: Boolean); Blue, Brown: (LengthOfLashes: Integer); end;

generates:

operator = ( protected var r1: PersonRec; protected var r2: PersonRec ) = Result : Boolean; begin Result := (r1.Age = r2.Age) and (r1.EyeColor = r2.EyeColor); if Result then begin if (r1.EyeColor = Red) or (r1.EyeColor = Green) then begin Result := (r1.WearsGlasses = r2.WearsGlasses); end else if (r1.EyeColor = Blue) or (r1.EyeColor = Brown) then begin Result := (r1.LengthOfLashes = r2.LengthOfLashes); end else begin Result := True; // Assert( false ); ? end; end; end;

operator <> ( protected var r1: PersonRec; protected var r2: PersonRec ) = Result : Boolean; begin Result := not (r1 = r2); end;

Enjoy, Peter.

#!/usr/bin/perl -wT

use lib (($ENV{HOME} =~ m!(/Users/(?:peter|matthew|exim))!) ? "$1/perl" : '/Library/Perl'); use warnings; use strict; use diagnostics;

my $source = <<EOM; type FileMappingEntry = record entryName: String255; extension: String255; // change name check no dot

flags: FileMappingEntryFlags; // change name flags MIMEType: String255;

fileType: OSType; fileCreator: OSType; creatorName: String255; creatorBundleID: String255;

postCreator: OSType; postName: String255; postBundleID: String255;

editCreator: OSType; // kNoOSType,'','' for none/default editName: String255; editBundleID: String255;

viewCreator: OSType; viewName: String255; viewBundleID: String255;

openAction: FileMappingOpenAction; end;

type MyHICommand = record attributes: UInt32; commandID: UInt32; case kind: Integer of 0: ( control: ControlRef; ); 1: ( window: WindowRef; ); 2: ( mnRef: MenuRef; menuIndex: MenuItemIndex; ); 3: ( toolbarItem: HIToolbarItemRef; ); end;

type PersonRec = record Age: Integer; case EyeColor: EyeColorType of Red, Green : (WearsGlasses: Boolean); Blue, Brown: (LengthOfLashes: Integer); end;

PersonRec2 = record Age: Integer; case EyeColor: (Red2, Green2, Blue2, Brown2) of Red2, Green2 : (WearsGlasses: Boolean); Blue2, Brown2: (LengthOfLashes: Integer); end; EOM

# remove comments $source =~ s!//.*!!g; $source =~ s!(*(.|[\r\n])*?*)!!g; $source =~ s!{(.|[\r\n])*?}!!g; $source =~ s!\btype\b!!gi; $source =~ s!\bend\b! ; end !gi; $source =~ s!;\s*;!;!g; print $source;

our $token; our $token_kind; get_token(); while ( token_is( 'IDENT' ) ) { process_record(); } die "Failed to parse everything, leaving $source" unless token_is( 'EOF' );

sub process_record { expect( 'IDENT' ); my $record_name = $token; my $variant_name = undef; my @keys = (); get_token(); skip( '=' ); skip( 'RECORD' ); my $fields = {}; get_fields( $fields, '-BASE-' ); if ( $token eq 'CASE' ) { get_token(); expect( 'IDENT' ); # we must have a named variant variable or fieldwise comparison is not possible $variant_name = $token; get_token(); expect( ':' ); skip_past( 'OF' ); while ( token_is( 'IDENT' ) ) { my $keys = $token; get_token(); while ( token_is( ',' ) ) { skip( ',' ); expect( 'IDENT' ); $keys .= ','.$token; get_token(); } skip( ':' ); skip( '(' ); get_fields( $fields, $keys ); skip( ')' ); skip_optional_semicolon(); push @keys, $keys; } } skip( 'END' ); skip( ';' );

my $output = ''; $output .= <<EOM; \toperator = ( protected var r1: $record_name; protected var r2: $record_name ) = Result : Boolean; \tbegin EOM $output .= <<EOM; \t\tResult := EOM $output .= compare_fields( "\t\t\t", $fields->{'-BASE-'} ); if ( $variant_name ) { $output .= " and\n\t\t\t(r1.$variant_name = r2.$variant_name)"; } $output .= ";\n"; if ( $variant_name ) { $output .= <<EOM; \t\tif Result then begin EOM $output .= "\t\t\t"; foreach my $keys ( @keys ) {

$output .= "if ".join( ' or ', map( "(r1.$variant_name = $_)", split( /,/, $keys )))." then begin\n\t\t\t\tResult :=\n"; $output .= compare_fields( "\t\t\t\t\t", $fields->{$keys} ).";\n"; $output .= "\t\t\tend else "; } $output .= "begin\n\t\t\t\tResult := True; // Assert( false ); ?\n\t\t\tend;\n"; $output .= <<EOM; \t\tend; EOM } $output .= <<EOM; \tend;

\toperator <> ( protected var r1: $record_name; protected var r2: $record_name ) = Result : Boolean; \tbegin \t\tResult := not (r1 = r2); \tend;

EOM $output =~ s!\bTrue\s*and\s*!!g; print $output; }

sub get_fields { my( $fields, $key ) = @_;

die if defined($fields->{$key}); $fields->{$key} = '';

while ( token_is( 'IDENT' ) ) { $fields->{$key} .= ',' if $fields->{$key}; $fields->{$key} .= $token; get_token(); while ( token_is( ',' ) ) { skip( ',' ); expect( 'IDENT' ); $fields->{$key} .= ',' if $fields->{$key}; $fields->{$key} .= $token; get_token(); } expect( ':' ); our $saved_source = $source; while ( !token_is( ')' ) && !token_is( ';' ) ) { not_eof( "skipped to EOF looking for end of type given $saved_source" ); if ( token_is( '(' ) ) { # ignore any procedural parameter defintiinos skip_past( ')' ); } else { get_token(); } } skip_optional_semicolon(); }

}

sub compare_fields { my ( $indent, $fields ) = @_;

my $result; if ( $fields ) { foreach my $field ( split( /,/, $fields ) ) { $result .= "${indent}(r1.$field = r2.$field) and\n"; } $result =~ s! and\n\Z!! or die; } else { $result = "${indent}True" } return $result; }

sub get_token { $source =~ s!\A\s*!!; if ( !$source ) { $token = ''; $token_kind = 'EOF'; } elsif ( $source =~ s!^(\w+)!! ) { $token = $1; if ( $token =~ m!^(record|case|of|end)$!i ) { $token =~ tr!a-z!A-Z!; $token_kind = $token; } else { $token_kind = 'IDENT'; } } elsif ( $source =~ s!^(.)!! ) { $token = $1; $token_kind = $token; } }

sub token_is { my ( $kind ) = @_;

return $token_kind eq $kind; }

sub expect { my ( $kind ) = @_; die "Expect $kind, got $token:$token_kind, leaving $source" unless token_is( $kind ); }

sub skip { my ( $kind ) = @_; expect( $kind ); get_token(); }

sub skip_optional_semicolon { if ( token_is( ';' ) ) { get_token(); } }

sub skip_past { my ( $kind ) = @_;

our $saved_source = $source; while ( !token_is( $kind ) ) { not_eof( "skipped to EOF looking for $kind given $saved_source" ); get_token(); } skip( $kind ); }

sub not_eof { my ( $message ) = @_; if ( token_is( 'EOF' ) ) { die $message; } }