Switch HLL::Compiler, NQP::Compiler and Regex::P6Regex::Compiler to use class_6m. In the process, create .pm files for a couple of them (we keep the PIR around too, to combine the various produced outputs). Needs re-configure.

jnthn · jnthn · commit c00a30cf5f43 · 2011-01-09T23:54:24.000+01:00
diff --git a/build/Makefile.in b/build/Makefile.in
@@ -71,6 +71,7 @@ P6REGEX_SOURCES = \
   src/Regex/P6Regex.pir \
   src/Regex/P6Regex/Grammar.pm \
   src/Regex/P6Regex/Actions.pm \
+  src/Regex/P6Regex/Compiler.pm \
 
 HLLGRAMMAR_SOURCES = \
   src/HLL/Grammar.pm \
@@ -80,6 +81,7 @@ HLLGRAMMAR_SOURCES = \
 NQP_SOURCES = \
   src/NQP/Grammar.pm \
   src/NQP/Actions.pm \
+  src/NQP/Compiler.pm \
   src/NQP/Compiler.pir \
 
 SETTING_SOURCES = \
@@ -113,6 +115,7 @@ HLLCOMPILER_PIR = gen/hllcompiler.pir
 P6REGEX_PBC     = P6Regex.pbc
 P6REGEX_G       = gen/p6regex-grammar.pir
 P6REGEX_A       = gen/p6regex-actions.pir
+P6REGEX_C       = gen/p6regex-compiler.pir
 
 P6GRAMMAR_PBC   = P6Grammar.pbc
 P6GRAMMAR_G     = gen/p6grammar-grammar.pir
@@ -122,6 +125,7 @@ NQP_PBC         = nqp.pbc
 NQP_HOW         = gen/nqp-how.pir
 NQP_G           = gen/nqp-grammar.pir
 NQP_A           = gen/nqp-actions.pir
+NQP_C           = gen/nqp-compiler.pir
 NQP_EXE         = nqp$(EXE)
 
 STAGE0_PBCS     = $(STAGE0)/$(HLL_PBC) $(STAGE0)/$(P6REGEX_PBC) $(STAGE0)/$(NQP_PBC) $(STAGE0)/$(REGEX_PBC)
@@ -247,6 +251,9 @@ $(STAGE1)/$(P6REGEX_PBC): $(STAGE0_PBCS) $(P6REGEX_SOURCES)
 	$(PARROT) --library=$(STAGE0) $(STAGE0)/$(NQP_PBC) \
 	    --target=pir --output=$(STAGE1)/$(P6REGEX_A) \
 	    src/Regex/P6Regex/Actions.pm
+	$(PARROT) --library=$(STAGE0) $(STAGE0)/$(NQP_PBC) \
+	    --target=pir --output=$(STAGE1)/$(P6REGEX_C) \
+	    src/Regex/P6Regex/Compiler.pm
 	$(PARROT) --include=$(STAGE1) -o $(STAGE1)/$(P6REGEX_PBC) \
 	    src/Regex/P6Regex.pir
 
@@ -264,6 +271,9 @@ $(STAGE1)/$(NQP_PBC): $(STAGE0_PBCS) $(NQP_SOURCES) $(HOW_COMBINED)
 	$(PARROT) --library=$(STAGE0) $(STAGE0)/$(NQP_PBC) \
 	    --target=pir --output=$(STAGE1)/$(NQP_A) \
 	    src/NQP/Actions.pm
+	$(PARROT) --library=$(STAGE0) $(STAGE0)/$(NQP_PBC) \
+	    --target=pir --output=$(STAGE1)/$(NQP_C) \
+	    src/NQP/Compiler.pm
 	$(PARROT) --include=$(STAGE1) -o $(STAGE1)/$(NQP_PBC) \
 	    src/NQP/Compiler.pir
 
@@ -291,6 +301,9 @@ $(STAGE2)/$(P6REGEX_PBC): $(STAGE1_PBCS) $(P6REGEX_SOURCES)
 	$(PARROT) --library=$(STAGE1) $(STAGE1)/$(NQP_PBC) \
 	    --target=pir --output=$(STAGE2)/$(P6REGEX_A) \
 	    src/Regex/P6Regex/Actions.pm
+	$(PARROT) --library=$(STAGE1) $(STAGE1)/$(NQP_PBC) \
+	    --target=pir --output=$(STAGE2)/$(P6REGEX_C) \
+	    src/Regex/P6Regex/Compiler.pm
 	$(PARROT) --include=$(STAGE2) -o $(STAGE2)/$(P6REGEX_PBC) \
 	    src/Regex/P6Regex.pir
 
@@ -305,6 +318,9 @@ $(STAGE2)/$(NQP_PBC): $(STAGE1_PBCS) $(NQP_SOURCES) $(HOW_COMBINED)
 	$(PARROT) --library=$(STAGE1) $(STAGE1)/$(NQP_PBC) \
 	    --target=pir --output=$(STAGE2)/$(NQP_A) \
 	    src/NQP/Actions.pm
+	$(PARROT) --library=$(STAGE1) $(STAGE1)/$(NQP_PBC) \
+	    --target=pir --output=$(STAGE2)/$(NQP_C) \
+	    src/NQP/Compiler.pm
 	$(PARROT) --include=$(STAGE2) -o $(STAGE2)/$(NQP_PBC) \
 	    src/NQP/Compiler.pir
 
diff --git a/src/HLL/Compiler.pm b/src/HLL/Compiler.pm
@@ -6,7 +6,7 @@ INIT {
 # as various additional things that initially appeared in the nqp-rx HLL::Compiler.
 # Conversion of it all the NQP is a work in progress; for now, many methods are
 # simply NQP wrappers around inline PIR.
-class HLL::Compiler {
+class_6m HLL::Compiler {
     has @!stages;
     has $!parsegrammar;
     has $!parseactions;
@@ -19,6 +19,13 @@ class HLL::Compiler {
     has $!compiler_progname;
     has $!language;
 
+    # XXX HACK!!! Need a Mu. :-)
+    method new() {
+        my $obj := pir::repr_instance_of__PP(self);
+        $obj.BUILD();
+        $obj
+    }
+
     method BUILD() {
         # Default stages.
         @!stages     := pir::split(' ', 'parse past post pir evalpmc');
@@ -266,6 +273,13 @@ class HLL::Compiler {
         }
         $!compiler_progname;
     }
+    
+    method commandline_options(@value?) {
+        if +@value {
+            @!cmdoptions := @value;
+        }
+        @!cmdoptions;
+    }    
 
     method command_line(@args, *%adverbs) {
         Q:PIR {
@@ -530,6 +544,55 @@ class HLL::Compiler {
         };
     }
 
+    method parse($source, *%adverbs) {
+        Q:PIR {
+            .local pmc source, options, self
+            source = find_lex '$source'
+            options = find_lex '%adverbs'
+            self = find_lex 'self'
+
+            .local string tcode
+            tcode = options['transcode']
+            unless tcode goto transcode_done
+            .local pmc tcode_it
+            $P0 = split ' ', tcode
+            tcode_it = iter $P0
+          tcode_loop:
+            unless tcode_it goto transcode_done
+            tcode = shift tcode_it
+            push_eh tcode_fail
+            $I0 = find_encoding tcode
+            $S0 = source
+            $S0 = trans_encoding $S0, $I0
+            assign source, $S0
+            pop_eh
+            goto transcode_done
+          tcode_fail:
+            pop_eh
+            goto tcode_loop
+          transcode_done:
+
+            .local pmc parsegrammar, parseactions, match
+            parsegrammar = self.'parsegrammar'()
+
+            null parseactions
+            $S0 = options['target']
+            if $S0 == 'parse' goto have_parseactions
+            parseactions = self.'parseactions'()
+          have_parseactions:
+
+            .local int rxtrace
+            rxtrace = options['parsetrace']
+            match = parsegrammar.'parse'(source, 'p'=>0, 'actions'=>parseactions, 'rxtrace'=>rxtrace)
+            unless match goto err_parsefail
+            .return (match)
+
+          err_parsefail:
+            self.'panic'('Unable to parse source')
+            .return (match)
+        };
+    }
+
     method past($source, *%adverbs) {
         Q:PIR {
             .local pmc source, adverbs, self
@@ -673,11 +736,112 @@ class HLL::Compiler {
           done:
         };
     }
+
+    method parse_name($name) {
+        Q:PIR {
+            .local string name
+            $P0 = find_lex '$name'
+            name = $P0
+
+            # split name on ::
+            .local pmc ns
+            ns = split '::', name
+
+            # move any leading sigil to the last item
+            .local string sigil
+            $S0 = ns[0]
+            sigil = substr $S0, 0, 1
+            $I0 = index '$@%&', sigil
+            if $I0 < 0 goto sigil_done
+            $S0 = replace $S0, 0, 1, ''
+            ns[0] = $S0
+            $S0 = ns[-1]
+            $S0 = concat sigil, $S0
+            ns[-1] = $S0
+          sigil_done:
+
+            # remove any empty items from the list
+            .local pmc ns_it
+            ns_it = iter ns
+            ns = new ['ResizablePMCArray']
+          ns_loop:
+            unless ns_it goto ns_done
+            $S0 = shift ns_it
+            unless $S0 > '' goto ns_loop
+            push ns, $S0
+            goto ns_loop
+          ns_done:
+
+            # return the result
+            .return (ns)
+        };
+    }
+
+    method lineof($target, $pos, :$cache) {
+        Q:PIR {
+            .local pmc target, linepos
+            .local int pos, cache
+            target = find_lex '$target'
+            $P0 = find_lex '$pos'
+            pos = $P0
+            $P0 = find_lex '$cache'
+            cache = $P0
+
+            .include 'cclass.pasm'
+
+            # If we've previously cached C<linepos> for target, we use it.
+            unless cache goto linepos_build
+            linepos = getprop '!linepos', target
+            unless null linepos goto linepos_done
+
+            # calculate a new linepos array.
+          linepos_build:
+            linepos = new ['ResizableIntegerArray']
+            unless cache goto linepos_build_1
+            setprop target, '!linepos', linepos
+          linepos_build_1:
+            .local string s
+            .local int jpos, eos
+            s = target
+            eos = length s
+            jpos = 0
+            # Search for all of the newline markers in C<target>.  When we
+            # find one, mark the ending offset of the line in C<linepos>.
+          linepos_loop:
+            jpos = find_cclass .CCLASS_NEWLINE, s, jpos, eos
+            unless jpos < eos goto linepos_done
+            $I0 = ord s, jpos
+            inc jpos
+            push linepos, jpos
+            # Treat \r\n as a single logical newline.
+            if $I0 != 13 goto linepos_loop
+            $I0 = ord s, jpos
+            if $I0 != 10 goto linepos_loop
+            inc jpos
+            goto linepos_loop
+          linepos_done:
+
+            # We have C<linepos>, so now we search the array for the largest
+            # element that is not greater than C<pos>.  The index of that
+            # element is the line number to be returned.
+            # (Potential optimization: use a binary search.)
+            .local int line, count
+            count = elements linepos
+            line = 0
+          line_loop:
+            if line >= count goto line_done
+            $I0 = linepos[line]
+            if $I0 > pos goto line_done
+            inc line
+            goto line_loop
+          line_done:
+            .return (line)
+        };
+    }
 }
 
 # Set up compiler for "Parrot" language.
-INIT {
-    my $pl := HLL::Compiler.new();
-    $pl.BUILD();
-    $pl.language('parrot');
-}
+#INIT {
+#    my $pl := HLL::Compiler.new();
+#    $pl.language('parrot');
+#}
diff --git a/src/NQP/Compiler.pir b/src/NQP/Compiler.pir
@@ -22,22 +22,21 @@ NQP::Compiler - NQP compiler
 
 .include 'gen/nqp-grammar.pir'
 .include 'gen/nqp-actions.pir'
+.include 'gen/nqp-compiler.pir'
 .include 'src/cheats/nqp-builtins.pir'
 
 .namespace ['NQP';'Compiler']
 
 .sub '' :anon :load :init
-    .local pmc p6meta, nqpproto, nqpcomp
-    p6meta = get_hll_global 'P6metaclass'
-    nqpproto = p6meta.'new_class'('NQP::Compiler', 'parent'=>'HLL::Compiler')
+    .local pmc nqpproto, nqpcomp
+    nqpproto = get_hll_global ['NQP'], 'Compiler'
     nqpcomp = nqpproto.'new'()
-    nqpcomp.'BUILD'() # XXX
     nqpcomp.'language'('NQP-rx')
     $P0 = get_hll_global ['NQP'], 'Grammar'
     nqpcomp.'parsegrammar'($P0)
     $P0 = get_hll_global ['NQP'], 'Actions'
     nqpcomp.'parseactions'($P0)
-    $P0 = getattribute nqpcomp, '@!cmdoptions'
+    $P0 = nqpcomp.'commandline_options'()
     push $P0, 'parsetrace'
 .end
 
diff --git a/src/NQP/Compiler.pm b/src/NQP/Compiler.pm
@@ -0,0 +1,2 @@
+class_6m NQP::Compiler is HLL::Compiler {
+}
diff --git a/src/Regex/P6Regex.pir b/src/Regex/P6Regex.pir
@@ -15,15 +15,14 @@ Regex::P6Regex - Parser/compiler for Perl 6 regexes
 
 .include 'gen/p6regex-grammar.pir'
 .include 'gen/p6regex-actions.pir'
+.include 'gen/p6regex-compiler.pir'
 
 .namespace ['Regex';'P6Regex';'Compiler']
 
 .sub '' :anon :load :init
-    .local pmc p6meta, p6regexproto, p6regex
-    p6meta = get_hll_global 'P6metaclass'
-    p6regexproto = p6meta.'new_class'('Regex::P6Regex::Compiler', 'parent'=>'HLL::Compiler')
+    .local pmc p6regexproto, p6regex
+    p6regexproto = get_hll_global ['Regex'; 'P6Regex'], 'Compiler'
     p6regex = p6regexproto.'new'()
-    p6regex.'BUILD'()
     p6regex.'language'('Regex::P6Regex')
     $P0 = get_hll_global ['Regex';'P6Regex'], 'Grammar'
     p6regex.'parsegrammar'($P0)
diff --git a/src/Regex/P6Regex/Compiler.pm b/src/Regex/P6Regex/Compiler.pm
@@ -0,0 +1,2 @@
+class_6m Regex::P6Regex::Compiler is HLL::Compiler {
+}
diff --git a/src/cheats/hll-compiler.pir b/src/cheats/hll-compiler.pir

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+class_6m NQP::Compiler is HLL::Compiler {`
	`2`	`+}`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	`+class_6m Regex::P6Regex::Compiler is HLL::Compiler {`
	`2`	`+}`