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
