develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r34626 - in branches/pct_hll: languages/lolcode languages/perl6 languages/perl6/src/classes runtime/parrot/library

From:
tene
Date:
December 30, 2008 00:20
Subject:
[svn:parrot] r34626 - in branches/pct_hll: languages/lolcode languages/perl6 languages/perl6/src/classes runtime/parrot/library
Message ID:
20081230082049.09129CB9FA@x12.develooper.com
Author: tene
Date: Tue Dec 30 00:20:47 2008
New Revision: 34626

Modified:
   branches/pct_hll/languages/lolcode/lolcode.pir
   branches/pct_hll/languages/perl6/perl6.pir
   branches/pct_hll/languages/perl6/src/classes/Bool.pir
   branches/pct_hll/languages/perl6/src/classes/Capture.pir
   branches/pct_hll/languages/perl6/src/classes/Complex.pir
   branches/pct_hll/languages/perl6/src/classes/Failure.pir
   branches/pct_hll/languages/perl6/src/classes/Grammar.pir
   branches/pct_hll/languages/perl6/src/classes/Int.pir
   branches/pct_hll/languages/perl6/src/classes/Mapping.pir
   branches/pct_hll/languages/perl6/src/classes/Match.pir
   branches/pct_hll/languages/perl6/src/classes/Module.pir
   branches/pct_hll/languages/perl6/src/classes/Num.pir
   branches/pct_hll/languages/perl6/src/classes/Protoobject.pir
   branches/pct_hll/languages/perl6/src/classes/Str.pir
   branches/pct_hll/runtime/parrot/library/P6object.pir

Log:
Start of support for HLL in PCT.  Doesn't work.

Modified: branches/pct_hll/languages/lolcode/lolcode.pir
==============================================================================
--- branches/pct_hll/languages/lolcode/lolcode.pir	(original)
+++ branches/pct_hll/languages/lolcode/lolcode.pir	Tue Dec 30 00:20:47 2008
@@ -21,12 +21,19 @@
 
 =cut
 
+.HLL 'lolcode'
+
 .namespace [ 'lolcode';'Compiler' ]
 
 .loadlib 'lolcode_group'
 
 .sub 'onload' :anon :load :init
     load_bytecode 'PCT.pbc'
+    .local pmc parrotns, lolns, exports
+    parrotns = get_root_namespace ['parrot']
+    lolns = get_hll_namespace
+    exports = split ' ', 'PAST PCT'
+    parrotns.'export_to'(lolns, exports)
 
     $P0 = new 'ResizablePMCArray'
     set_hll_global ['lolcode';'Grammar';'Actions'], '@?BLOCK', $P0

Modified: branches/pct_hll/languages/perl6/perl6.pir
==============================================================================
--- branches/pct_hll/languages/perl6/perl6.pir	(original)
+++ branches/pct_hll/languages/perl6/perl6.pir	Tue Dec 30 00:20:47 2008
@@ -20,6 +20,8 @@
 
 =cut
 
+.HLL 'perl6'
+
 .loadlib 'perl6_group'
 .loadlib 'perl6_ops'
 .include 'src/gen_builtins.pir'

Modified: branches/pct_hll/languages/perl6/src/classes/Bool.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Bool.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Bool.pir	Tue Dec 30 00:20:47 2008
@@ -20,7 +20,7 @@
 .sub 'onload' :anon :init :load
     .local pmc p6meta, boolproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    boolproto = p6meta.'new_class'('Bool', 'parent'=>'Boolean Any')
+    boolproto = p6meta.'new_class'('Bool', 'parent'=>'parrot;Boolean Any')
     boolproto.'!IMMUTABLE'()
     p6meta.'register'('Boolean', 'parent'=>boolproto, 'protoobject'=>boolproto)
 

Modified: branches/pct_hll/languages/perl6/src/classes/Capture.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Capture.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Capture.pir	Tue Dec 30 00:20:47 2008
@@ -15,7 +15,7 @@
 .sub 'onload' :anon :init :load
     .local pmc p6meta, captureproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    captureproto = p6meta.'new_class'('Perl6Capture', 'parent'=>'Capture Any', 'name'=>'Capture')
+    captureproto = p6meta.'new_class'('Perl6Capture', 'parent'=>'parrot;Capture Any', 'name'=>'Capture')
     captureproto.'!IMMUTABLE'()
 .end
 

Modified: branches/pct_hll/languages/perl6/src/classes/Complex.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Complex.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Complex.pir	Tue Dec 30 00:20:47 2008
@@ -22,7 +22,7 @@
 .sub 'onload' :anon :init :load
     .local pmc p6meta, complexproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    complexproto = p6meta.'new_class'('Perl6Complex', 'parent'=>'Complex Any', 'name'=>'Complex')
+    complexproto = p6meta.'new_class'('Perl6Complex', 'parent'=>'parrot;Complex Any', 'name'=>'Complex')
     complexproto.'!IMMUTABLE'()
     p6meta.'register'('Complex', 'parent'=>complexproto, 'protoobject'=>complexproto)
 

Modified: branches/pct_hll/languages/perl6/src/classes/Failure.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Failure.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Failure.pir	Tue Dec 30 00:20:47 2008
@@ -6,7 +6,7 @@
 .sub '' :anon :init :load
     .local pmc p6meta, failureproto, exceptionproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    failureproto = p6meta.'new_class'('Failure', 'parent'=>'Undef Any', 'attr'=>'$!exception')
+    failureproto = p6meta.'new_class'('Failure', 'parent'=>'parrot;Undef Any', 'attr'=>'$!exception')
     p6meta.'register'('Undef', 'parent'=>failureproto, 'protoobject'=>failureproto)
 
     $P0 = box 1

Modified: branches/pct_hll/languages/perl6/src/classes/Grammar.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Grammar.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Grammar.pir	Tue Dec 30 00:20:47 2008
@@ -25,7 +25,7 @@
     load_bytecode "PGE.pbc"
     .local pmc p6meta
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    p6meta.'new_class'('Grammar', 'parent'=>'PGE::Grammar')
+    p6meta.'new_class'('Grammar', 'parent'=>'parrot;PGE::Grammar')
 .end
 
 =item PROTOOVERRIDES()

Modified: branches/pct_hll/languages/perl6/src/classes/Int.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Int.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Int.pir	Tue Dec 30 00:20:47 2008
@@ -17,7 +17,7 @@
 .sub 'onload' :anon :init :load
     .local pmc p6meta, intproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    intproto = p6meta.'new_class'('Int', 'parent'=>'Integer Any')
+    intproto = p6meta.'new_class'('Int', 'parent'=>'parrot;Integer Any')
     p6meta.'register'('Integer', 'parent'=>intproto, 'protoobject'=>intproto)
     p6meta.'register'('BigInt', 'parent'=>intproto, 'protoobject'=>intproto)
 

Modified: branches/pct_hll/languages/perl6/src/classes/Mapping.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Mapping.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Mapping.pir	Tue Dec 30 00:20:47 2008
@@ -13,7 +13,7 @@
 .sub 'onload' :anon :load :init
     .local pmc p6meta, mappingproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    mappingproto = p6meta.'new_class'('Mapping', 'parent'=>'Hash Any')
+    mappingproto = p6meta.'new_class'('Mapping', 'parent'=>'parrot;Hash Any')
     $P0 = get_hll_global 'Associative'
     p6meta.'add_role'($P0, 'to'=>mappingproto)
     p6meta.'register'('Hash', 'parent'=>mappingproto, 'protoobject'=>mappingproto)

Modified: branches/pct_hll/languages/perl6/src/classes/Match.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Match.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Match.pir	Tue Dec 30 00:20:47 2008
@@ -11,7 +11,7 @@
 .sub '' :anon :load :init
     .local pmc p6meta, matchproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    matchproto = p6meta.'new_class'('Match', 'parent'=>'PGE::Match Any')
+    matchproto = p6meta.'new_class'('Match', 'parent'=>'parrot;PGE::Match Any')
     $P0 = get_hll_global 'Positional'
     p6meta.'add_role'($P0, 'to'=>matchproto)
     $P0 = get_hll_global 'Associative'

Modified: branches/pct_hll/languages/perl6/src/classes/Module.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Module.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Module.pir	Tue Dec 30 00:20:47 2008
@@ -15,7 +15,7 @@
 .sub 'onload' :anon :load :init
     .local pmc p6meta, moduleproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    moduleproto = p6meta.'new_class'('Module', 'parent'=>'NameSpace Any')
+    moduleproto = p6meta.'new_class'('Module', 'parent'=>'parrot;NameSpace Any')
     p6meta.'register'('NameSpace', 'parent'=>moduleproto, 'protoobject'=>moduleproto)
 .end
 

Modified: branches/pct_hll/languages/perl6/src/classes/Num.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Num.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Num.pir	Tue Dec 30 00:20:47 2008
@@ -17,7 +17,7 @@
 .sub 'onload' :anon :init :load
     .local pmc p6meta, numproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    numproto = p6meta.'new_class'('Num', 'parent'=>'Float Any')
+    numproto = p6meta.'new_class'('Num', 'parent'=>'parrot;Float Any')
     numproto.'!IMMUTABLE'()
     p6meta.'register'('Float', 'parent'=>numproto, 'protoobject'=>numproto)
 

Modified: branches/pct_hll/languages/perl6/src/classes/Protoobject.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Protoobject.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Protoobject.pir	Tue Dec 30 00:20:47 2008
@@ -14,6 +14,8 @@
 
 =cut
 
+.HLL 'parrot'
+
 .namespace ['P6protoobject']
 .sub 'defined' :method
     $P0 = get_hll_global ['Bool'], 'False'
@@ -38,7 +40,6 @@
 
 =cut
 
-.namespace ['P6protoobject']
 .sub 'WHENCE' :method
     .local pmc whence
     whence = getprop '%!WHENCE', self
@@ -60,7 +61,6 @@
 
 =cut
 
-.namespace ['P6protoobject']
 .sub 'postcircumfix:{ }' :method
     .param pmc WHENCE :slurpy :named
     .local pmc protoclass, proto
@@ -112,6 +112,7 @@
 
 =cut
 
+.HLL 'perl6'
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: branches/pct_hll/languages/perl6/src/classes/Str.pir
==============================================================================
--- branches/pct_hll/languages/perl6/src/classes/Str.pir	(original)
+++ branches/pct_hll/languages/perl6/src/classes/Str.pir	Tue Dec 30 00:20:47 2008
@@ -22,7 +22,7 @@
 .sub 'onload' :anon :init :load
     .local pmc p6meta, strproto
     p6meta = get_hll_global ['Perl6Object'], '$!P6META'
-    strproto = p6meta.'new_class'('Str', 'parent'=>'Perl6Str Any')
+    strproto = p6meta.'new_class'('Str', 'parent'=>'parrot;Perl6Str Any')
     strproto.'!IMMUTABLE'()
     p6meta.'register'('Perl6Str', 'parent'=>strproto, 'protoobject'=>strproto)
     p6meta.'register'('String', 'parent'=>strproto, 'protoobject'=>strproto)

Modified: branches/pct_hll/runtime/parrot/library/P6object.pir
==============================================================================
--- branches/pct_hll/runtime/parrot/library/P6object.pir	(original)
+++ branches/pct_hll/runtime/parrot/library/P6object.pir	Tue Dec 30 00:20:47 2008
@@ -287,6 +287,8 @@
 
 =cut
 
+.include 'library/dumper.pir'
+
 .sub 'register' :method
     .param pmc parrotclass
     .param pmc options         :slurpy :named
@@ -300,7 +302,7 @@
     ## get the hll, either from options or the caller's namespace
     .local pmc hll
     hll = options['hll']
-    $I0 = defined $P0
+    $I0 = defined hll
     if $I0, have_hll
     $P0 = getinterp
     $P0 = $P0['namespace';1]
@@ -326,13 +328,27 @@
     $S0 = parentclass
     parentclass = split ' ', $S0
   parent_array:
-    .local pmc iter
+    .local pmc iter, item
     iter = new 'Iterator', parentclass
   parent_loop:
     unless iter goto parent_done
-    $P0 = shift iter
-    unless $P0 goto parent_loop
-    self.'add_parent'($P0, 'to'=>parrotclass)
+    item = shift iter
+    $S0 = item
+    $P0 = split ';', $S0
+    $I0 = elements $P0
+    eq $I0, 1, no_parent_hll
+    $S0 = shift $P0
+    goto have_parent_hll
+  no_parent_hll:
+    $S0 = hll
+  have_parent_hll:
+    $P0 = shift $P0
+    $S1 = $P0
+    $P0 = split '::', $S1
+    unshift $P0, $S0
+    $S0 = pop $P0
+    item = get_root_global $P0, $S0
+    self.'add_parent'(item, 'to'=>parrotclass)
     goto parent_loop
   parent_done:
     self.'add_parent'('P6object', 'to'=>parrotclass)
@@ -469,20 +485,11 @@
     goto have_parrotclass
   parrotclass_string:
     $S0 = name
-    .local pmc class_ns, lookup
+    .local pmc class_ns, ns
     class_ns = split '::', $S0
     unshift class_ns, hll
-    lookup = get_root_namespace class_ns
-    $I0 = defined lookup
-    unless $I0, parrotclass_no_namespace
-    parrotclass = newclass lookup
-    goto have_parrotclass
-  parrotclass_no_namespace:
-    # The namespace doesn't exist, so we need to create it
-    .local pmc ns
-    ns = new 'NameSpace'
-    set_root_global class_ns, '', ns
-    ns = get_root_namespace class_ns
+    $P0 = get_root_namespace
+    ns = $P0.'make_namespace'(class_ns)
     parrotclass = newclass ns
   have_parrotclass:
 
@@ -515,6 +522,9 @@
 
 .sub 'get_parrotclass' :method
     .param pmc x
+    .param pmc hll :named('hll') :optional
+    .param int has_hll :opt_flag
+    if null x goto done
     .local pmc parrotclass
     parrotclass = x
     $S0 = typeof x
@@ -522,6 +532,8 @@
     if $S0 == 'PMCProxy' goto done
     $I0 = isa x, 'String'
     if $I0 goto x_string
+    $I0 = isa x, 'NameSpace'
+    if $I0 goto x_ns
     $I0 = isa x, 'P6object'
     if $I0 goto x_p6object
     $P0 = typeof x
@@ -537,6 +549,12 @@
     unless null parrotclass goto done
     $S0 = x
     $P0 = split '::', $S0
+    unless has_hll goto no_hll
+    unshift $P0, hll
+    x = get_root_namespace $P0
+    unless null x goto x_ns
+    $S0 = shift $P0
+  no_hll:
     x = get_hll_namespace $P0
   x_ns:
     if null x goto done



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About