[svn:parrot] r44669 - in branches/ops_pct/compilers/opsc: src/Ops src/Ops/Compiler t

[bacek at svn.parrot.org]

Author: bacek
Date: Fri Mar  5 23:50:36 2010
New Revision: 44669
URL: https://trac.parrot.org/parrot/changeset/44669

Log:
Start c header emitting

Modified:
   branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
   branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm
   branches/ops_pct/compilers/opsc/t/06-emitter.t

Modified: branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Fri Mar  5 23:50:06 2010	(r44668)
+++ branches/ops_pct/compilers/opsc/src/Ops/Compiler/Actions.pm	Fri Mar  5 23:50:36 2010	(r44669)
@@ -52,7 +52,7 @@
 method op($/) {
 
     # Handling flags.
-    my %flags := pir::new__Ps('Hash');
+    my %flags := pir::new__Ps('OrderedHash');
     for $<op_flag> {
         %flags{~$_<identifier>} := 1;
     }

Modified: branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm
==============================================================================
--- branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm	Fri Mar  5 23:50:06 2010	(r44668)
+++ branches/ops_pct/compilers/opsc/src/Ops/Emitter.pm	Fri Mar  5 23:50:36 2010	(r44669)
@@ -8,7 +8,7 @@
 
 =end
 
-method new(:$ops_file!, :$trans!, :$script!, :$file, :%flags) {
+method new(:$ops_file!, :$trans!, :$script!, :$file, :%flags!) {
     self<ops_file>  := $ops_file;
     self<trans>     := $trans;
     self<script>    := $script;
@@ -23,8 +23,8 @@
     my $base_ops_h    := $base_ops_stub ~ '.h';
 
 
-    self<include> := %flags<dir> ~ "parrot/oplib/$base_ops_h";
-    self<header>  := "include/{self<include>}";
+    self<include> := "parrot/oplib/$base_ops_h";
+    self<header>  := (~%flags<dir>) ~ "include/" ~ self<include>;
 
 
     self;
@@ -38,8 +38,64 @@
 
 
 method print_c_header_file() {
+    my $fh := pir::open__PSs(self<header>, 'w') || die("Can't open filehandle");
+    self.emit_c_header_file($fh);
+    $fh.close();
+    return self<header>;
+}
+
+method emit_c_header_file($fh) {
+
+    self._emit_guard_prefix($fh);
+
+    self._emit_guard_suffix($fh);
+
+    self._emit_coda($fh);
+}
+
+# given a headerfile name like "include/parrot/oplib/core_ops.h", this
+# returns a string like "PARROT_OPLIB_CORE_OPS_H_GUARD"
+method _generate_guard_macro_name() {
+    my $fn   := self<header>;
+    $fn := subst($fn, /.h$/, '');
+    #my @path = File::Spec->splitdir($fn);
+    my @path := split('/', $fn);
+    @path.shift if @path[0]~'/' eq self<flags><dir>;
+    @path.shift if @path[0] eq 'include';
+    @path.shift if @path[0] eq 'parrot';
+    uc( join( '_', 'parrot', |@path, 'h', 'guard' ) );
+}
 
+
+method _emit_guard_prefix($fh) {
+    my $guardname := self._generate_guard_macro_name();
+    $fh.print(qq/
+#ifndef $guardname
+#define $guardname
+
+/);
+}
+
+method _emit_guard_suffix($fh) {
+    my $guardname := self._generate_guard_macro_name();
+    $fh.print(qq|
+
+#endif /* $guardname */
+|);
 }
 
 
+method _emit_coda($fh) {
+    $fh.print(q|
+
+/*
+ * Local variables:
+ *   c-file-style: "parrot"
+ *   buffer-read-only: t
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
+|);
+}
+
 # vim: expandtab shiftwidth=4 ft=perl6:

Modified: branches/ops_pct/compilers/opsc/t/06-emitter.t
==============================================================================
--- branches/ops_pct/compilers/opsc/t/06-emitter.t	Fri Mar  5 23:50:06 2010	(r44668)
+++ branches/ops_pct/compilers/opsc/t/06-emitter.t	Fri Mar  5 23:50:36 2010	(r44669)
@@ -3,7 +3,7 @@
 pir::load_bytecode("compilers/opsc/opsc.pbc");
 pir::load_bytecode("nqp-settings.pbc");
 
-plan(3);
+plan(5);
 
 my $trans := Ops::Trans::C.new();
 
@@ -26,4 +26,15 @@
 ok( $emitter<header> ~~ /^tmp/, 'header file in tmp');
 say('# ' ~ $emitter<header>);
 
+#my $header := $emitter.print_c_header_file();
+my $fh := pir::new__Ps('StringHandle');
+$fh.open('header.h', 'w');
+$emitter.emit_c_header_file($fh);
+
+$fh.close();
+my $header := $fh.readall();
+
+ok($header ~~ /define \s PARROT_OPLIB_CORE_OPS_H_GUARD/, 'Guard generated');
+ok($header ~~ /endif/, 'Close guard generated');
+
 # vim: expandtab shiftwidth=4 ft=perl6: