Some work on the header version of vulkan binding.
[panamaz] / src / notzed.nativez / lib / api.pm
1
2 # TODO: define more & consistent stage processing hooks, currently implicit require init() and stage.postprocess
3 # TODO: code:<inline> etc should probably instead be code:<type> where <type> is one of the template fields - methods, init, etc.
4 # TODO: calls should probably use dynamic invocation - downcall is not bound to address
5
6 package api;
7
8 use strict;
9
10 use File::Path qw(make_path);
11 use File::Basename;
12 use Data::Dumper;
13 use List::Util qw(first);
14 use Carp 'verbose';
15
16 use config;
17
18 my %renameTable = (
19         'studly-caps' => sub { my $s = shift; $s =~ s/(?:^|_)(.)/\U$1/g; return $s; },
20         'camel-case' => sub { my $s = shift; $s =~ s/(?:_)(.)/\U$1/g; return $s; },
21         'upper-leadin' => sub { my $s = shift; $s =~ s/^([^_]+)/\U$1/; return $s; },
22         'identity' => sub {     return $_[0]; },
23         'call' => sub {
24                 my $s = shift;
25
26                 if ($s =~ m/\(/) {
27                         $s =~ s/u32:|u64:/p/g;
28                         $s =~ s/\$\{([^\}]+)\}/$1/g;
29                         $s =~ s/[\(\)]/_/g;
30                         $s =~ s/^/Call/;
31                 }
32                 $s;
33         }
34 );
35
36 my %defaultTable = (
37         'struct:<default>' => {
38                 name => '<default>',
39                 items => [],
40                 options => [ 'default=none', 'access=rw', 'field:rename=studly-caps' ],
41                 regex => qr/^struct:<default>$/,
42                 type => 'struct'
43         },
44         'union:<default>' => {
45                 name => '<default>',
46                 items => [],
47                 options => [ 'default=all', 'access=rw', 'field:rename=studly-caps' ],
48                 regex => qr/^union:<default>$/,
49                 type => 'union'
50         },
51         'call:<default>' => {
52                 name => '<default>',
53                 items => [],
54                 options => [ 'call:rename=call', 'access=r' ],
55                 regex => qr/^call:<default>$/,
56                 type => 'call'
57         },
58         'func:<default>' => {
59                 name => '<default>',
60                 items => [],
61                 options => [],
62                 regex => qr/^func:<default>$/,
63                 type => 'func',
64                 'func:template' => 'code:method=invoke'
65         },
66         'enum:<default>' => {
67                 name => '<default>',
68                 items => [],
69                 options => [],
70                 regex => qr/^enum:<default>$/,
71                 type => 'enum'
72         },
73 );
74
75 sub new {
76         my $class = shift;
77         my $file = shift;
78         my $vars = shift;
79         my $self = {
80                 vars => $vars,
81                 index => {},
82                 data => {},
83                 types => [],
84         };
85
86         my $conf = new config($vars, $file);
87         $self->{api} = $conf->{objects};
88         foreach my $obj (@{$self->{api}}) {
89                 $self->{index}->{"$obj->{type}:$obj->{name}"} = $obj;
90         }
91         foreach my $k (keys %defaultTable) {
92                 if (!defined($self->{index}->{$k})) {
93                         $self->{index}->{$k} = $defaultTable{$k};
94                         push @{$self->{api}}, $defaultTable{$k};
95                 }
96         }
97
98         while ($#_ >= 0) {
99                 my $name = shift;
100                 my $info = loadAPIFile($name);
101
102                 $self->{data} = { %{$self->{data}}, %{$info} };
103         }
104
105         # FIXME: fix the list names in export.cc and export-defines instead
106         # set all the member list names to be consistent
107         foreach my $s (values %{$self->{data}}) {
108                 foreach my $n ('fields', 'arguments', 'values') {
109                         if ($s->{$n}) {
110                                 $s->{items} = $s->{$n};
111                                 delete $s->{$n};
112                         }
113                 }
114         }
115
116         bless $self, $class;
117
118         # handle requires and init modules
119         foreach my $p (@{$conf->{pragmas}}) {
120                 if ($p->[0] eq '%require') {
121                         require $p->[1];
122                         my $n = $p->[1];
123                         $n =~ s/.pm$/::init(\$self)/;
124                         print "$n\n";
125                         eval $n || die "module init failed: $! $@";
126                 }
127         }
128
129         # create type indices
130         {
131                 my $index = {};
132                 map { $index->{$_->{type}}->{$_->{name}} = $_ } values %{$self->{data}};
133                 $self->{databytype} = $index;
134         }
135
136         analyseAPI($self);
137         preprocess($self);
138
139         # add phantom 'api' entries for anything else required
140         foreach my $s (findDependencies($self)) {
141                 my $n = "$s->{type}:$s->{name}";
142                 my $def = $self->{index}->{"$s->{type}:<default>"};
143
144                 die "no default for implicit dependency $n" if (!$def);
145
146                 my $obj = {
147                         %$def,
148                         match => "$s->{type}:$s->{name}",
149                         name => $s->{name},
150                         regex => qr/^$n$/,
151                 };
152                 $obj->{rename} = $obj->{"$obj->{type}:rename"} ? $obj->{"$obj->{type}:rename"}->($obj->{name}) : $obj->{name};
153
154                 print " implicit $n\n";
155                 push @{$self->{api}}, $obj;
156                 $self->{index}->{$n} = $obj;
157         }
158
159         postprocess($self);
160
161         foreach my $p (@{$conf->{pragmas}}) {
162                 if ($p->[0] eq '%stage.postprocess') {
163                         eval "$p->[1](\$self)" || die "$p->[0] $p->[1] failed: $! $@";
164                 }
165         }
166
167         # form the types
168         # TODO: could match the regexes to every possible type in the api and create a direct index
169         my $copyIndex = {};
170         foreach my $obj (grep { $_->{type} eq 'type' && $_->{name} =~ m@<.*>@ } @{$self->{api}}) {
171                 $copyIndex->{$obj->{name}} = $obj;
172         }
173
174         foreach my $obj (grep { $_->{type} eq 'type' && $_->{name} =~ m@^/.*/$@ } @{$self->{api}}) {
175                 push @{$self->{types}}, initType($self, $copyIndex, $obj);
176         }
177
178         # handle external references - rename and supress output
179         # Not sure of the best place to put this
180         foreach my $obj (grep { $_->{type} eq 'extern' } @{$self->{api}}) {
181                 foreach my $inc (@{$obj->{items}}) {
182                         my @list = findMatches($self, $inc, $obj);
183
184                         foreach my $s (@list) {
185                                 $s->{rename} = $obj->{name}.'.'.$inc->{"$s->{type}:rename"}->($s->{name}, $s);
186                                 $s->{output} = 0;
187                         }
188                 }
189         }
190
191         return $self;
192 }
193
194 # class.name to class/name.java
195 sub classToPath {
196         my $api = shift;
197         my $name = shift;
198
199         $name = $api->{vars}->{package}.'.'.$name;
200         $name =~ s@\.@/@g;
201         $name = $api->{vars}->{output}.'/'.$name.'.java';
202         $name;
203 }
204
205 sub closeOutput {
206         my $api = shift;
207         my $name = shift;
208         my $f = shift;
209         my $path = $api->classToPath($name);
210
211         close($f) || die;
212         rename($path.'~', $path) || die ("rename failed: $!");
213 }
214
215 sub openOutput {
216         my $api = shift;
217         my $name = shift;
218         my $path = $api->classToPath($name);
219         my $dir = dirname($path);
220
221         make_path($dir) if (!-d $dir);
222
223         open(my $f, ">", $path.'~') || die ("Cannot open '$path' for writing");
224         #print "writing '$path'\n";
225         $f;
226 }
227
228 sub renameFunction {
229         my $api = shift;
230         my $name = shift;
231         $renameTable{$name};
232 }
233
234 sub initType {
235         my $api = shift;
236         my $index = shift;
237         my $obj = shift;
238         my $type = {};
239
240         $type->{options} = [ @{$obj->{options}} ];
241         $type->{file} = $obj->{file};
242
243         # FIXME: per-item options, set etc?
244         foreach my $inc (grep { defined $_->{literal} } @{$obj->{items}}) {
245                 $type->{items}->{$inc->{match}} = $inc->{literal};
246         }
247
248         my $v = optionValue('select', undef, $obj);
249         $type->{select} = $v if defined($v);
250
251         #print "init $obj->{name}\n";
252         foreach my $c (split /,/,optionValue('copy', undef, $obj)) {
253                 my $copy = $index->{$c};
254
255                 if ($copy) {
256                         #print " copy $c\n";
257                         my $proto = initType($api, $index, $copy);
258
259                         foreach my $k (keys %{$proto->{items}}) {
260                                 $type->{items}->{$k} = $proto->{items}->{$k} if !defined($type->{items}->{$k});
261                         }
262
263                         push @{$type->{options}}, @{$proto->{options}};
264                 } else {
265                         die ("type copy target $c not found");
266                 }
267         }
268
269         $type->{regex} = qr/$1/ if $obj->{name} =~ m@/(.*)/@;
270
271         return $type;
272 }
273
274 # returns { type=>$type, match=>$match)
275 #  match is named groups from regex (%+)
276 sub findType {
277         my $api = shift;
278         my $m = shift;
279         my $deref = $m->{deref};
280         my @list;
281
282         foreach my $type (@{$api->{types}}) {
283                 my $select = !defined($type->{select}) || defined($m->{select}->{$type->{select}});
284
285                 if ($select && ($deref =~ m/$type->{regex}/)) {
286                         my %match = %+;
287
288                         return { deref=>$deref, type=>$type, match=>\%match };
289                 }
290         }
291         die ("cannot find matching type '$deref' for member $m->{name}");
292         undef;
293 }
294
295 sub findTemplateName {
296         my $api = shift;
297         my $name = shift;
298
299         if ($name =~ m/^(.+)=(.+)$/) {
300                 my $template = findItem($api->{index}->{$1}, $2);
301                 return $template if defined $template;
302         }
303         die "can't find template '$name'\n";
304 }
305
306 sub queryTemplate {
307         my $api = shift;
308         my $obj = shift;
309         my $s = shift;
310         my $sname = $s->{"$s->{type}:template"};
311         my $def = $api->{index}->{"$s->{type}:<default>"};
312         my $name = $sname ? $sname : api::optionValue('template', $s->{size} == 0 ? 'code:class=handle' : 'code:class=struct', $obj, $def);
313
314         return $name;
315 }
316
317 sub findTemplate {
318         my $api = shift;
319         my $obj = shift;
320         my $s = shift;
321         my $sname = $s->{"$s->{type}:template"};
322         my $def = $api->{index}->{"$s->{type}:<default>"};
323         my $name = $sname ? $sname : api::optionValue('template', $s->{size} == 0 ? 'code:class=handle' : 'code:class=struct', $obj, $def);
324
325         print "template: $s->{name} -> $name\n" if ($api->{vars}->{verbose} > 1);
326
327         return findTemplateName($api, $name);
328 }
329
330 # find value of first option of the given name
331 # TBD: moved to config.pm
332 sub optionValue {
333         my $name = shift;
334         my $or = shift;
335
336         #my $match = sub { $_ =~ m/^\Q$name\E=(.*)$/on ? $1 : undef };
337
338         #print "optionValue $name\n";
339         foreach my $obj (@_) {
340                 foreach my $opt (@{$obj->{options}}) {
341                         #print "? $name $opt = ".($opt =~m/^\Q$name\E=(.*)$/)."\n";
342                         #print " = $opt\n" if ($opt =~m/^\Q$name\E=(.*)$/);
343                         return $1 if ($opt =~m/^\Q$name\E=(.*)$/);
344                         #my $x =  $match->($opt);
345                         #return $x if defined($x);
346                 }
347         }
348         $or;
349 }
350
351 # look for all matching options of the given name
352 # multiple objects are searched, the first one with
353 #  the given parameter overrides the rest.
354 # name, object, object *
355 sub optionValues {
356         my $name = shift;
357         my $rx = qr/$name/;
358         my @list;
359
360         foreach my $obj (@_) {
361                 foreach my $opt (@{$obj->{options}}) {
362                         push @list, $1 if ($opt =~m/^$rx=(.*)$/);
363                 }
364                 last if ($#list >= 0);
365         }
366         @list;
367 }
368
369 # same as above but doesn't short-circuit
370 sub optionValuesAll {
371         my $name = shift;
372         my $rx = qr/$name/;
373         my @list;
374
375         foreach my $obj (@_) {
376                 foreach my $opt (@{$obj->{options}}) {
377                         push @list, $1 if ($opt =~m/^$rx=(.*)$/);
378                 }
379         }
380         @list;
381 }
382
383 # find first occurance of a flag
384 # TBD: moved to config.pm
385 sub optionFlag {
386         my $name = shift;
387
388         foreach my $obj (@_) {
389                 foreach my $opt (@{$obj->{options}}) {
390                         return 1 if ($opt eq $name);
391                 }
392         }
393         undef;
394 }
395
396 sub findItem {
397         my $s = shift;
398         my $name = shift;
399
400         foreach my $i (@{$s->{items}}) {
401                 return $i if $i->{match} eq $name;
402         }
403         undef;
404 }
405
406 sub findAllItems {
407         my $api = shift;
408         my $obj = shift;
409         my $s = shift;
410         my %visited = ();
411         my @fields = ();
412
413         #print Dumper($obj);
414
415         my @all = @{$s->{items}};
416         my %index;
417
418         foreach my $m (@all) {
419                 $index{$m->{name}} = $m;
420         }
421
422         foreach my $inc (@{$obj->{items}}) {
423                 my $d = $index{$inc->{match}};
424
425                 if ($d) {
426                         next if $visited{$d->{type}.':'.$d->{name}}++;
427                         push @fields, [ $inc, $d ];
428                 } else {
429                         foreach my $d (grep { $_->{name} =~ m/$inc->{regex}/ } @all) {
430                                 next if $visited{$d->{type}.':'.$d->{name}}++;
431                                 push @fields, [ $inc, $d ];
432                         }
433                 }
434         }
435
436         if (optionValue('default', undef, $obj, $api->{index}->{'struct:<default>'}) eq 'all') {
437                 #print "* add all items\n";
438                 foreach my $d (@all) {
439                         next if $visited{$d->{type}.':'.$d->{name}}++;
440                         push @fields, [ $obj, $d ];
441                 }
442         }
443
444         return @fields;
445 }
446
447 sub findField {
448         my $s = shift;
449         my $name = shift;
450
451         foreach my $i (@{$s->{items}}) {
452                 return $i if $i->{name} eq $name;
453         }
454         undef;
455 }
456
457 # ######################################################################
458
459 sub addDependencies {
460         my $api = shift;
461         my $obj = shift;
462         my $s = shift;
463         my $add = shift;
464
465         #print "add deps for '$s->{name}'\n";
466         if ($s->{type} =~ m/^(struct|union)$/n) {
467                 # include embedded structures always
468                 foreach my $d (grep { $_->{type} =~ m/^(struct|union):/ && $_->{deref} =~ m/\[\d+\$\{|^\$\{/ } @{$s->{items}}) {
469                         #print "  embedded $d->{name} $d->{deref}\n";
470                         $add->($d->{type});
471                 }
472
473                 # include selected fields optionally
474                 if ($obj) {
475                         foreach my $i (findAllItems($api, $obj, $s)) {
476                                 my ($inc, $d) = @{$i};
477                                 #print "  selected $d->{name} $d->{type} $d->{deref}\n";
478                                 $add->($d->{type}) if ($d->{type} =~ m/^(struct|union|func|call|enum):/);
479                                 # HACK: enum types are integers but ctype includes the actual type
480                                 $add->("enum:$1") if ($d->{ctype} =~ m/^enum (.+)/);
481                         }
482                 }
483         } elsif ($s->{type} =~ m/^(call|func)/n) {
484                 # for calls/func need all fields
485                 foreach my $d (grep { $_->{type} =~ m/^(struct|union|func|call|enum):/ } @{$s->{items}}, $s->{result}) {
486                         #print "  argument $d->{name} $d->{type} $d->{deref}\n";
487                         $add->($d->{type});
488                 }
489         }
490 }
491
492 # use either {match} or {regex} or {matcher} to get all matches for a data type
493 sub findMatches {
494         my $api = shift;
495         my $inc = shift;
496         my $ctx = shift;
497         my $type = $inc->{type};
498         my $data = $api->{databytype}->{$type};
499
500         if ($inc->{matcher}) {
501                 #grep { $inc->{matcher}->($_, $ctx) } grep { $_->{type} eq $inc->{type} } values %$data;
502                 grep { $inc->{matcher}->($_, $ctx) } values %$data;
503         } else {
504                 my $s = $api->{data}->{$inc->{match}};
505
506                 if (defined($s)) {
507                         $s;
508                 } else {
509                         #map { $data->{$_} } grep { $_ =~ m/$inc->{regex}/ } keys %$data;
510                         #map { $data->{$_} } grep { "$type:$_" =~ m/$inc->{regex}/ } keys %$data;
511                         grep { "$_->{type}:$_->{name}" =~ m/$inc->{regex}/ } values %$data;
512                         #grep { "$_->{type}:$_->{name}" =~ m/$inc->{regex}/ } values %{$api->{data}};
513                 }
514         }
515 }
516
517 # find all extra types used by the api requested
518 sub findDependencies {
519         my $api = shift;
520         my %data = %{$api->{data}};
521         my %seen;
522         my %deps;
523         my $setdeps = sub { my $d = shift; $deps{$d} = 1; };
524
525         print "Root types\n";
526         foreach my $obj (@{$api->{api}}) {
527                 if ($obj->{type} eq 'library') {
528                         foreach my $inc (@{$obj->{items}}) {
529                                 next if ($inc->{type} eq 'library');
530
531                                 print "? $inc->{match}\n";
532                                 foreach my $s (findMatches($api, $inc, $obj)) {
533                                         my $n = "$s->{type}:$s->{name}";
534
535                                         print "+ $n\n";
536
537                                         $seen{$n}++;
538                                         $s->{output} = 1;
539                                         addDependencies($api, $obj, $s, $setdeps);
540                                 }
541                         }
542                 } elsif ($obj->{type} =~ m/^(struct|union|call|func|enum|define)$/) {
543                         #foreach my $n (grep { $_ =~ m/$obj->{regex}/ } keys %data) {
544
545                         print "? $obj->{name}\n";
546
547
548                         foreach my $s (findMatches($api, $obj, $obj)) {
549                                 my $n = "$s->{type}:$s->{name}";
550
551                                 print "+ $n\n";
552
553                                 $seen{$n}++;
554                                 $s->{output} = 1;
555                                 addDependencies($api, $obj, $s, $setdeps);
556                         }
557                 }
558         }
559
560         # at this point 'seen' contains everything explicitly requested
561         # and deps is anything else they need but not referenced directly
562         # recursively grab anything else
563
564         my @list = ();
565         my @stack = sort keys %deps;
566         my $pushstack = sub { my $d = shift; push @stack, $d; };
567         while ($#stack >= 0) {
568                 my $n = shift @stack;
569                 my $s;
570
571                 next if $seen{$n}++;
572
573                 $s = $data{$n};
574
575                 if ($s) {
576                         print "Add referent: $n\n";
577                         $s->{output} = 1;
578                         addDependencies($api, $api->{index}->{"$s->{type}:<default>"}, $s, $pushstack);
579                 } elsif ($n =~ m/^(.*):(.*)$/) {
580                         print "Add anonymous: $n\n";
581                         # type not know, add anonymous
582                         $s = {
583                                 name => $2,
584                                 type => $1,
585                                 size => 0,
586                                 items => [],
587                                 output => 1,
588                         };
589                         $api->{data}->{$n} = $s;
590                 }
591
592                 # maybe it should have some skeleton metadata?
593                 # depends on where it's used i suppose
594                 push @list, $s;
595         }
596
597         print "Added ".($#list+1)." dependencies\n";
598         return @list;
599 }
600
601 # ######################################################################
602
603 sub loadAPIFile {
604         my $file = shift;
605         my $info;
606
607         unless ($info = do $file) {
608                 die "couldn't parse $file: $@"  if $@;
609                 die "couldn't import $file: $!" unless defined $info;
610                 die "couldn't run $file"                unless $info;
611         }
612
613         return $info;
614 }
615
616 sub parseRename {
617         my $api = shift;
618         my $how = shift;
619         my $rename = $renameTable{'identity'};
620
621         foreach my $n (split /,/,$how) {
622                 my $old = $rename;
623                 my $new = $renameTable{$n};
624
625                 if ($n =~ m@^s/(.*)/(.*)/$@) {
626                         my $rx = qr/$1/;
627                         my $rp = $2;
628                         $rename = sub { my $s=shift; $s = $old->($s); $s =~ s/$rx/$rp/; return $s;};
629                 } elsif ($n =~ m@^func:(.*)$@) {
630                         $rename = eval "sub { $1(\@_) }";
631                         if (!defined($rename)) {
632                                 die "Unable to parse rename function '$1'";
633                         }
634                 } elsif ($new) {
635                         $rename = sub { my $s=shift; $s = $old->($s); return $new->($s); };
636                 } else {
637                         my $x = $n;
638                         $rename = sub { return $x; };
639                 }
640         }
641         $rename;
642 }
643
644 # pre-process {data}
645 sub preprocess {
646         my $api = shift;
647
648         # Find any anonymous types and add them in
649         my %anonymous = ();
650         foreach my $s (values %{$api->{data}}) {
651
652                 foreach my $m (grep { $_->{type} =~ m/struct:|union:/} @{$s->{items}}) {
653                         $anonymous{$m->{type}} = 1 if !defined($api->{data}->{$m->{type}});
654                 }
655
656                 # add 'result' name
657                 $s->{result}->{name} = 'result$' if $s->{type} =~ m/func|call/;
658
659                 # add a canonical deref for all types
660                 if ($s->{type} =~ m/func|call|struct|union/) {
661                         foreach my $m (grep { !defined($_->{deref}) } @{$s->{items}}, ($s->{type} =~ m/func|call/) ? $s->{result} : ()) {
662                                 if ($m->{type} =~ m/^(union|struct):(.*)/) {
663                                         $m->{deref} = "\${$2}";
664                                 } elsif ($m->{ctype} eq 'bitfield') {
665                                         $m->{deref} = "bitfield";
666                                 } else {
667                                         $m->{deref} = $m->{type};
668                                 }
669                         }
670                 }
671
672                 # all 'defines' are output by default
673                 $s->{output} = 1 if $s->{type} eq 'define';
674         }
675
676         foreach my $k (sort keys %anonymous) {
677                 print " anon $k\n";
678                 if ($k =~ m/^(.*):(.*)$/) {
679                         $api->{data}->{$k} = {
680                                 name => $2,
681                                 type => $1,
682                                 size => 0,
683                                 items => [],
684                         };
685                 }
686         }
687 }
688
689 # preprocess {api}
690 sub analyseAPI {
691         my $api = shift;
692
693         # Note that type:name regexes always start at the beginning
694
695         foreach my $obj (@{$api->{api}}) {
696                 $obj->{match} = "$obj->{type}:$obj->{name}";
697
698                 if ($obj->{name} =~ m@^/(.*)/$@) {
699                         $obj->{regex} = qr/^$obj->{type}:$1/;
700                 } elsif ($obj->{name} =~ m@^<invoke=(.*)>$@) {
701                         $obj->{matcher} = eval "sub { $1(\@_) }";
702                         die "unable to parse match function $obj->{name} $! $@" if !defined($obj->{matcher});
703                 } else {
704                         $obj->{regex} = qr/^$obj->{type}:$obj->{name}$/;
705                 }
706
707                 foreach my $opt (@{$obj->{options}}) {
708                         if ($opt =~ m/^(.+:rename)=(.*)$/) {
709                                 $obj->{$1} = parseRename($api, $2);
710                         } elsif ($opt =~ m/^rename=(.*)$/) {
711                                 $obj->{"$obj->{type}:rename"} = parseRename($api, $1);
712                         }
713                 }
714
715                 my $defmode = ($obj->{type} eq 'library' ? 'func' : 'field');
716                 foreach my $inc (@{$obj->{items}}) {
717                         my $match = $inc->{match};
718                         my $mode = $defmode;
719
720                         if ($inc->{match} =~ m/^(.*?):(.*)$/) {
721                                 $match = $2;
722                                 $mode = $1;
723                         }
724
725                         $inc->{type} = $mode;
726                         if ($match =~ m@^/(.*)/$@) {
727                                 $inc->{regex} = $mode ne 'field' ? qr/$mode:$1/ : qr/$1/;
728                         } elsif ($match =~ m@^<invoke>$@) {
729                                 $inc->{matcher} = eval "sub { $inc->{literal} }";
730                                 die "unable to parse match function $inc->{literal} $! $@" if !defined($inc->{matcher});
731                         } elsif ($match =~ m@^<invoke=(.*)>$@) {
732                                 $inc->{matcher} = eval "sub { $1(\@_) }";
733                                 die "unable to parse match function $inc->{match} $! $@" if !defined($inc->{matcher});
734                         } else {
735                                 $inc->{regex} = $mode ne 'field' ? qr/^$mode:$match$/ : qr/^$match$/;
736                         }
737
738                         foreach my $opt (@{$inc->{options}}) {
739                                 if ($opt =~ m/^rename=(.*)$/) {
740                                         #print "option $opt ".Dumper($inc);
741                                         $inc->{"$mode:rename"} = parseRename($api, $1);
742                                 }
743                         }
744
745                         $inc->{"$mode:rename"} = $obj->{"$mode:rename"} if (!(defined($inc->{"$mode:rename"})) && defined($obj->{"$mode:rename"}));
746                 }
747         }
748 }
749
750 #
751 # 'lib/struct/func' level    'lib.inc' level            'func/struct.inc' level  setting
752 #  array:name1                array:name1                array                    char* is array, void* is a Segment
753 #  array-size:name1=name2     array-size:name1=name2     array-size=name2         implied array size from name2
754 #  implied:name1=expr         implied:name1=expr         implied=expr             value of name1 is calculated from other arguments
755 #  instance:name1             instance:name1             instance                 parameter/return is instance, implies non-static function
756
757 #  scope:name1=scope[,close]  scope:name1=scope[,close]  scope=scope[,close]      parameter/return is a new instance with given scope
758 #  success:name1=values       success:name1=values       success=values           which parameter and values indicate integer success
759 #                                                                                 pointer types are considered in/out and implied
760 #  success:name1=!null        success:name1=!null        success=!null            which parameter and values indicate non-null success
761 #  return:name1               return:name1               return                   return this output argument instead of the return code
762
763 #  access:name1=rwi           access:name1=rwi           access=rwi               set access type, read, write, indexed
764 #  access=rwi                 access=rwi                 access=rwi                - can also be set as default
765
766 #  onsuccess=blah             onsuccess=blah             onsuccess=blah
767
768 # 'name' is parameter name, or parameter index, or result$ for return value
769 # scope is instance for instance-scope, explicit for explicit scope, global for global scope.  default is global.
770
771 # err, maybe this format makes more sense:
772 #   name1:success=values   name1:success=values  success=values
773 #   name1:instance         name1:instance        instance
774
775 my @itemFlags = (
776         'array',
777         'segment',
778         'instance',
779         'return',
780         'raw',
781         'raw-in',
782 );
783
784 my @itemOptions = (
785         'array-size',
786         'scope',
787         'success',
788         'implied',
789         'tonative',
790 );
791
792 my @itemAnyOptions = (
793         'access',
794 );
795
796 # process struct->field
797 #  api, obj (struct, func), inc (field entry), s (struct), m (struct field)
798 # Note: keep in sync with processFunc
799 sub processField {
800         my $api = shift;
801         my $obj = shift;
802         my $inc = shift;
803         my $s = shift;
804         my $m = shift;
805         my $def = $api->{index}->{"$s->{type}:<default>"};
806
807         #print "process $s->{type}:$s->{name}.$m->{name}\n";
808         print "  $m->{name}\n" if ($api->{vars}->{verbose} > 1);
809
810         foreach my $flag (@itemFlags) {
811                 my $value = optionFlag("$flag", $inc);
812                 $value = optionFlag("$flag:$m->{name}", $obj, $def) if !defined($value);
813                 $m->{$flag} = $value if (defined($value));
814                 $m->{select}->{$flag} = 1 if (defined($value));
815         }
816         foreach my $option (@itemOptions) {
817                 my $value = optionValue("$option", undef, $inc);
818                 $value = optionValue("$option:$m->{name}", undef, $obj, $def) if !defined($value);
819                 $m->{$option} = $value if (defined($value));
820                 $m->{select}->{$option} = 1 if (defined($value));
821         }
822         foreach my $option (@itemAnyOptions) {
823                 my $value = optionValue("$option", undef, $inc);
824                 $value = optionValue("$option:$m->{name}", undef, $obj, $def) if !defined($value);
825                 $value = optionValue("$option", undef, $obj, $def) if !defined($value);
826                 $m->{$option} = $value if (defined($value));
827         }
828
829         $m->{output} = 1;
830         $m->{rename} = (first { defined $_ } $inc->{'field:rename'}, $obj->{'field:rename'}, $def->{'field:rename'}, $renameTable{identity})->($m->{name}, $m, $s);
831 }
832
833 # process func or call main type
834 sub processTypeFunc {
835         my $api = shift;
836         my $seen = shift;
837         my $obj = shift;
838         my $def = $api->{index}->{"$obj->{type}:<default>"};
839
840         foreach my $s (@_) {
841                 my $v;
842
843                 if ($seen->{"$s->{type}:$s->{name}"}++) { print "warning: seen $s->{type}:$s->{name}\n"; next; }
844
845                 print " $s->{name}\n" if ($api->{vars}->{verbose} > 1);
846
847                 foreach my $m ($s->{result}, @{$s->{items}}) {
848                         my $inc = findItem($obj, $m->{name});
849
850                         processField($api, $obj, $inc, $s, $m);
851                 }
852
853                 $s->{rename} = (first { defined $_ } $obj->{"$s->{type}:rename"}, $renameTable{identity})->($s->{name}, $s);
854                 $s->{access} = optionValue('access', '', $obj, $def);
855                 $v = optionValue('onsuccess', undef, $obj, $def);
856                 $s->{onsuccess} = $v if defined $v;
857
858                 postProcessType($s);
859         }
860 }
861
862 # process library->func
863 # process struct->func
864 #  api, obj (library, struct), inc (func entry), s ($data->{func:name})
865 # Note: keep in sync with processField
866 sub processFunc {
867         my $api = shift;
868         my $obj = shift;
869         my $inc = shift;
870         my $s = shift;
871         my @params = (defined($s->{result}) ? $s->{result} : (), @{$s->{items}});
872         my $index = -1;
873         my $lindex = -2 - $#params;
874         my $def = $api->{index}->{"$s->{type}:<default>"};
875         my $v;
876
877         print "process $s->{type}:$s->{name}\n" if ($api->{vars}->{verbose} > 1);
878
879         foreach my $m (defined($s->{result}) ? $s->{result} : (), @{$s->{items}}) {
880                 #print "[$index] [$lindex] $m->{name}\n";
881
882                 foreach my $flag (@itemFlags) {
883                         my $value = optionFlag("$flag:$m->{name}", $inc, $obj, $def);
884                         $value = optionFlag("$flag:$index", $inc, $obj, $def) if !defined($value);
885                         $value = optionFlag("$flag:$lindex", $inc, $obj, $def) if !defined($value);
886                         $m->{$flag} = $value if (defined($value));
887                         $m->{select}->{$flag} = 1 if (defined($value));
888                 }
889                 foreach my $option (@itemOptions) {
890                         my $value = optionValue("$option:$m->{name}", undef, $inc, $obj, $def);
891                         $value = optionValue("$option:$index", undef, $inc, $obj, $def) if !defined($value);
892                         $value = optionValue("$option:$lindex", undef, $inc, $obj, $def) if !defined($value);
893                         $m->{$option} = $value if (defined($value));
894                         $m->{select}->{$option} = 1 if (defined($value));
895                 }
896                 foreach my $option (@itemAnyOptions) {
897                         my $value = optionValue("$option:$m->{name}", undef, $inc, $obj, $def);
898                         $value = optionValue("$option:$index", undef, $inc, $obj, $def) if !defined($value);
899                         $value = optionValue("$option:$lindex", undef, $inc, $obj, $def) if !defined($value);
900                         $value = optionValue("$option", undef, $inc, $obj, $def) if !defined($value);
901                         $m->{$option} = $value if (defined($value));
902                 }
903                 $m->{output} = 1;
904                 $index++;
905                 $lindex++;
906         }
907
908         $s->{rename} = (first { defined $_ } $inc->{"$s->{type}:rename"}, $obj->{"$s->{type}:rename"}, $renameTable{identity})->($s->{name}, $s);
909         $s->{access} = optionValue('access', '', $inc, $obj, $def);
910         $v = optionValue('onsuccess', undef, $inc, $obj, $def);
911         $s->{onsuccess} = $v if defined ($v);
912
913         postProcessType($s);
914 }
915
916 # finally link up array sizes and work out what is output or not
917 # TODO: struct field array-size should be output but not included in constructors?
918 sub postProcessType {
919         my $s = shift;
920         my $static = 1;
921
922         foreach my $m (defined($s->{result}) ? $s->{result} : (), @{$s->{items}}) {
923                 $static = 0 if ($m->{instance});
924
925                 # FIXME: collect multiple scopes here
926                 $s->{scope} = 'explicit' if ($m->{scope} =~ m/^explicit$|^explicit,(.*)$/);
927                 $s->{scope} = 'global' if ($m->{scope} eq 'global');
928                 $s->{scope} = 'object' if ($m->{scope} eq 'object');
929
930                 if ($m->{'array-size'}) {
931                         my $size = findField($s, $m->{'array-size'});
932
933                         print Dumper($s) if (!defined($size));
934                         die "can't find array-size=$m->{'array-size'}" if !defined($size);
935
936                         $size->{output} = 0 if ($s->{type} =~ m/func|call/);
937                         $size->{'array-size-source'} = $m;
938                         $m->{'array-size'} = $size;
939                 }
940
941                 # no java arg for instance parameter
942                 $m->{output} = 0 if ($m->{instance});
943                 # don't generate java args for values calculated
944                 $m->{output} = 0 if (defined($m->{implied}));
945                 # don't generate java args for return statuss unless they're also the constructed value
946                 $m->{output} = 0 if (defined($m->{success}) && !$m->{scope});
947                 # don't generate java args for output arguments
948                 $m->{output} = 0 if ($m->{scope} && $m->{name} ne 'result$');
949
950                 # link success/return fields to struct/func
951                 $s->{success} = $m if defined($m->{success});
952                 $s->{return} = $m if ($m->{return});
953         }
954
955         $s->{static} = $static;
956
957         # TODO: default scope?  or from struct:<default> etc?
958 }
959
960 # transfer info from {api} to {data}
961 sub processFields {
962         my $api = shift;
963         my $seen = shift;
964         my $obj = shift;
965         my $inc = shift;
966         my $s = shift;
967
968         foreach my $m (@_) {
969                 next if $seen->{$m->{name}}++;
970
971                 processField($api, $obj, $inc, $s, $m);
972         }
973 }
974
975 # process a struct/union
976 # these have fields as well as potentially other included types
977 sub processType {
978         my $api = shift;
979         my $seen = shift;
980         my $obj = shift;
981         my $def = $api->{index}->{"$obj->{type}:<default>"};
982
983         foreach my $s (@_) {
984                 my $memberseen = {};
985
986                 next if ($seen->{"$s->{type}:$s->{name}"}++);
987
988                 print "process type $obj->{match} $s->{type}:$s->{name}\n" if ($api->{vars}->{verbose} > 1);
989
990                 # process the struct/union fields first
991                 foreach my $inc (grep { $_->{type} eq 'field' } @{$obj->{items}}) {
992                         my @list = grep { $_->{name} =~ m/$inc->{regex}/ } @{$s->{items}};
993
994                         processFields($api, $memberseen, $obj, $inc, $s, @list);
995                 }
996
997                 if (optionValue('default', undef, $obj, $def) eq 'all') {
998                         print " + adding all fields\n" if ($api->{vars}->{verbose} > 1);
999                         processFields($api, $memberseen, $obj, undef, $s, @{$s->{items}});
1000                 }
1001
1002                 $s->{rename} = (first { defined $_ } $obj->{"$s->{type}:rename"}, $def->{"$s->{type}:rename"}, $renameTable{identity})->($s->{name}, $s);
1003
1004                 # finish off
1005                 postProcessType($s);
1006
1007                 # handle other types included/mark them no-output
1008                 #$seen->{"$s->{type}:$s->{name}"} = 0;
1009                 processLibrary($api, $seen, $obj, $s);
1010         }
1011
1012 }
1013
1014 sub processLibrary {
1015         my $api = shift;
1016         my $seen = shift;
1017         my $lib = shift;
1018         my $ctx = shift;
1019         my $data = $api->{data};
1020
1021         #return if ($seen->{"$ctx->{type}:$ctx->{name}"}++);
1022
1023         print "process library $ctx->{type}:$ctx->{name}\n" if ($api->{vars}->{verbose} > 0);
1024         #print 'lib='.Dumper($lib);
1025         #print Dumper($api->{api}); die;
1026         #print 'lib.options='.Dumper($lib->{options});
1027
1028         # TODO: embedded types
1029
1030         foreach my $inc (@{$lib->{items}}) {
1031                 print " $inc->{match}\n" if ($api->{vars}->{verbose} > 1);
1032
1033                 if ($inc->{type} =~ m/func|call/on) {
1034                         my @list = findMatches($api, $inc, $ctx);
1035
1036                         #print 'inc='.Dumper($inc);
1037                         #print "match $inc->{regex} .options=".Dumper($inc->{options});
1038
1039                         foreach my $s (@list) {
1040                                 if ($seen->{"$s->{type}:$s->{name}"}++) { print "warning: seen $s->{type}:$s->{name}\n"; next; }
1041
1042                                 #print " $s->{name}\n";
1043                                 processFunc($api, $lib, $inc, $s);
1044
1045                                 #print 'func='.Dumper($s);
1046                         }
1047                 } elsif ($inc->{type} eq 'library') {
1048                         foreach my $l (grep { "$_->{type}:$_->{name}" =~ m/$inc->{regex}/ } @{$api->{api}}) {
1049                                 print " -> $l->{name}\n";
1050                                 # included libraries are never output directly
1051                                 $l->{output} = 0;
1052                                 processLibrary($api, $seen, $l, $ctx);
1053                         }
1054                 } elsif ($inc->{type} =~ m/define|enum/on) {
1055                         # suppress direct output of anything included
1056                         foreach my $c (findMatches($api, $inc, $ctx)) {
1057                                 $c->{output} = 0;
1058                         }
1059                 }
1060         }
1061 }
1062
1063 sub postprocess {
1064         my $api = shift;
1065         my $seen = {};
1066         my %data = %{$api->{data}};
1067
1068         # apply requested options to specific objects (not defaults)
1069         foreach my $obj (grep {$_->{type} =~ m/^(func|call|struct|union)$/} @{$api->{api}}) {
1070                 my @list = findMatches($api, $obj, $obj);
1071
1072                 if ($obj->{type} =~ m/func|call/) {
1073                         processTypeFunc($api, $seen, $obj, @list);
1074                 } else {
1075                         processType($api, $seen, $obj, @list);
1076                 }
1077         }
1078
1079         # handle libraries
1080         foreach my $lib (grep {$_->{type} eq 'library'} @{$api->{api}}) {
1081                 next if defined($lib->{output});
1082                 $lib->{output} = 1;
1083                 processLibrary($api, $seen, $lib, $lib);
1084         }
1085
1086         # apply options for default object types
1087         foreach my $obj (grep {$_->{name} eq '<default>'} @{$api->{api}}) {
1088                 my @list;
1089
1090                 @list = grep { !defined($seen->{"$_->{type}:$_->{name}"}) && $_->{type} eq $obj->{type} } values %data;
1091
1092                 print "apply $obj->{type}:$obj->{name} to ".($#list + 1)." objects\n" if ($#list >= 0);
1093
1094                 if ($obj->{type} =~ m/func|call/) {
1095                         processTypeFunc($api, $seen, $obj, @list);
1096                 } else {
1097                         processType($api, $seen, $obj, @list);
1098                 }
1099         }
1100 }
1101
1102 1;