Permalink
Browse files

Split a bit the thing

  • Loading branch information...
Skarsnik committed Jan 2, 2016
1 parent 48baabe commit 2fb0016cb1a95ac3d0eb83d6b3f5ea27bcc5ef85
Showing with 279 additions and 187 deletions.
  1. +115 −0 DumbGenerator.pm6
  2. +101 −0 GPClass.pm6
  3. +24 −0 OOGenerator.pm6
  4. +1 −1 README.md
  5. +14 −0 examples/fakeoo.h
  6. +4 −0 examples/fakeoo.ini
  7. +20 −186 gptrixie.p6
View
@@ -0,0 +1,115 @@
+use GPClass;
+
+module DumbGenerator {
+
+my %types;
+my %fields;
+my %struct;
+my @cfunctions;
+my @cenums;
+my %cunions;
+
+sub dg-init(%t, %f, %s, @cf, @ce, %u) is export {
+ %types = %t;
+ %fields = %f;
+ %struct = %s;
+ @cfunctions = @cf;
+ @cenums = @ce;
+ %cunions = %u;
+}
+
+my %ctype-to-p6 = (
+ 'char' => 'int8',
+ 'bool' => 'bool',
+ '_bool' => 'bool',
+ 'int' => 'int32',
+ 'float' => 'num32',
+ 'double' => 'num64',
+ 'long' => 'long',
+ 'unsigned int' => 'uint32'
+).hash;
+
+
+
+sub resolve-type($t) is export {
+ if $t ~~ PointerType {
+ return 'Str' if $t.ref-type ~~ FundamentalType && $t.ref-type.name eq 'char' ||
+ $t.ref-type ~~ QualifiedType && $t.ref-type.ref-type.name eq 'char';
+ return 'Pointer' if $t.ref-type ~~ FundamentalType && $t.ref-type.name eq 'void' ||
+ $t.ref-type ~~ QualifiedType && $t.ref-type.ref-type.name eq 'void';
+ return 'Pointer[' ~ resolve-type($t.ref-type) ~ ']';
+ }
+ if $t ~~ FundamentalType {
+ return %ctype-to-p6{$t.name};
+ }
+ if $t ~~ EnumType {
+ return 'int32';
+ }
+ if $t ~~ StructType {
+ return $t.name;
+ }
+ if $t ~~ QualifiedType {
+ return resolve-type($t.ref-type);
+ }
+ if $t ~~ TypeDefType {
+ return 'size_t' if $t.name eq 'size_t';
+ return resolve-type($t.ref-type);
+ }
+ if $t ~~ UnionType {
+ return %cunions{$t.id}.gen-name;
+ }
+ return 'NYI';
+}
+
+sub dg-generate-functions is export {
+ my %toret;
+ for @cfunctions -> $f {
+ my @tmp;
+ for $f.arguments -> $a {
+ @tmp.push(resolve-type($a.type) ~ ' ' ~ $a.name);
+ }
+ my $returns = $f.returns ~~ FundamentalType && $f.returns.name eq 'void' ?? '' !!
+ "returns " ~ resolve-type($f.returns);
+ my $p6gen = "sub {$f.name} is native(LIB) $returns (" ~ @tmp.join(', ') ~ ') { * }';
+ %toret{$f.name} = $p6gen;
+ }
+ return %toret;
+}
+
+sub dg-generate-enums(@enum) is export {
+ for @enum -> $e {
+ say 'enum ' ~ $e.name ~ ' is export = (';
+ my @tmp;
+ for @($e.values) -> $v {
+ @tmp.push(" " ~ $v.name ~ " => " ~ $v.init);
+ }
+ say @tmp.join(",\n");
+ say ");";
+ }
+}
+
+sub dg-generate-structs is export {
+ my %toret;
+ my $p6gen;
+ for %cunions.kv -> $k, $cu {
+ $p6gen = "class {$cu.gen-name} is repr('CUnion') is export \{\n";
+ for $cu.members -> $m {
+ my $has = ($m.type ~~ StructType) ?? 'HAS' !! 'has';
+ $p6gen ~= "\t$has " ~ resolve-type($m.type) ~ "\t" ~ $m.name ~ ";\n";
+ }
+ $p6gen ~= "}";
+ %toret{$cu.gen-name} = $p6gen;
+ }
+ for %struct.kv -> $k, $s {
+ $p6gen = "class {$s.name} is repr('CStruct') is export \{\n";
+ for $s.fields -> $field {
+ my $has = ($field.type ~~ StructType | UnionType) ?? 'HAS' !! 'has';
+ $p6gen ~= "\t$has " ~ resolve-type($field.type) ~ "\t" ~ $field.name ~ ";\n";
+ }
+ $p6gen ~= "}";
+ %toret{$s.name} = $p6gen;
+ }
+ return %toret;
+}
+
+}
View
@@ -0,0 +1,101 @@
+module GPClass {
+role Type is export {
+ has $.id is rw;
+}
+
+class DirectType does Type is export {
+ has $.name is rw;
+ method Str {
+ $!name;
+ }
+}
+
+class IndirectType does Type is export {
+ has $.ref-id is rw;
+ has Type $.ref-type is rw;
+}
+
+class PointerType is IndirectType is export {
+ method Str {
+ return $.ref-type.Str ~ '*';
+ }
+}
+
+class StructType is DirectType is export {
+}
+
+class FundamentalType is DirectType is export {
+}
+
+class QualifiedType is IndirectType is export {
+ method Str {
+ return 'const ' ~ $.ref-type.Str;
+ }
+}
+
+class TypeDefType is IndirectType is export {
+ has $.name is rw;
+ method Str {
+ return "Typedef($!name)->" ~ $.ref-type.Str;
+ }
+}
+
+class UnionType is DirectType is export {
+ method Str {
+ 'Union'
+ }
+}
+
+class FunctionType is DirectType is export {
+ method Str {
+ 'PtrFunc';
+ }
+}
+
+class EnumType is DirectType is export {
+}
+
+class Field is rw is export {
+ has $.name;
+ has $.type-id;
+ has Type $.type;
+}
+
+class Struct is rw is export {
+ has $.name;
+ has $.id;
+ has Field @.fields;
+}
+
+class EnumValue is rw is export {
+ has $.name;
+ has $.init,
+}
+
+class CEnum is rw is export {
+ has $.name;
+ has $.id;
+ has EnumValue @.values;
+}
+
+class FunctionArgument is rw is export {
+ has $.name;
+ has Type $.type;
+}
+
+class Function is rw is export {
+ has $.id;
+ has $.name;
+ has Type $.returns;
+ has FunctionArgument @.arguments;
+}
+
+class CUnion is rw is export {
+ has $.id;
+ has $.field;
+ has $.struct;
+ has @.members;
+ has $.gen-name;
+}
+
+}
View
@@ -0,0 +1,24 @@
+use DumbGenerator;
+use GPClass;
+use Config::Simple
+
+module OOGenerator {
+ my $config;
+ sub ooc-config($conff) {
+ $config = Config::Simple.read($conff, :f('ini'));
+ }
+ sub ooc-generate {
+ my %funcs = dg-generate-functions();
+ my %struct = dg-generate-structs();
+ say %struct{$config<OOC><ctypename>};
+
+ say "class P6FakeObject \{";
+ say "has Pointer[{$config<OOC><ctypename>}] "~ ' $!internal-pointer;';
+
+ for %funcs.kv -> $n, $f {
+ if $n ~~ /$config<OOC><methodpattern>/ {
+
+ }
+ }
+ }
+}
View
@@ -7,6 +7,6 @@ of have sure the gccxml executable is gccxml
use it like this :
-perl gptrixie.p6 --enums --structs --functions path/myheader.h
+perl6 -I . gptrixie.p6 --enums --structs --functions path/myheader.h
Try to not copy the header if it use other one.
View
@@ -0,0 +1,14 @@
+typedef struct {
+ int x;
+ int y;
+} FakeObject;
+
+
+FakeObject *fakeobject_new();
+
+void fakeobject_init(FakeObject *obj);
+void fakeobject_print(FakeObject *obj);
+void fakeobject_dostuff_to_x(FakeObject *obj, int val);
+void fakeobject_add(FakeObject *obj1, FakeObject *obj2);
+
+
View
@@ -0,0 +1,4 @@
+[OOC]
+ctypename = FakeObject
+perltypename = FakeObject
+methodpattern = fakeobject_
Oops, something went wrong.

0 comments on commit 2fb0016

Please sign in to comment.