/[suikacvs]/messaging/manakai/lib/Message/Util/PerlCode.dis
Suika

Contents of /messaging/manakai/lib/Message/Util/PerlCode.dis

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.23 - (hide annotations) (download)
Wed May 11 14:07:41 2005 UTC (20 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.22: +5 -7 lines
LSInput for bootstrap added; lib/Message/DOM/DOMLS.dis is now dac-compilable

1 wakaba 1.1 Module:
2     @QName:
3     Util:PerlCode
4     @FullName:
5     @@lang: en
6     @@@:
7     Perl Code Constructor
8     @Namespace:
9     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#
10    
11     @Description:
12     @@lang:en
13     @@@:
14     This module provides an object-oriented interface to construct
15     Perl code.
16    
17     @Author:
18     @@FullName: Wakaba
19     @@Mail: w@suika.fam.cx
20     @License:
21     @@@:
22     license:Perl+MPL
23     @@Original:
24     @@@FullName:
25     manakai <CODE::lib/manakai/genlib.pl>
26     @@@Year:2004
27     @@@Author:
28     @@@@FullName:Wakaba
29     @@@@Mail:w@suika.fam.cx
30     @Date:
31     @@@:
32 wakaba 1.23 $Date: 2005/05/08 14:18:02 $
33 wakaba 1.1 @@ContentType:
34     dis:Date.RCS
35    
36     @Require:
37     @@Module:
38     @@@Name: ManakaiNode
39     @@@WithFor:
40     ManakaiDOM:Perl
41     @@Module:
42     @@@Name: DOMMetaImpl
43 wakaba 1.5 @@@QName:
44     MDOM:DOMMetaImpl
45 wakaba 1.1 @@@WithFor:
46     ManakaiDOM:ManakaiDOMLatest
47 wakaba 1.23 @@ImplNote:
48     @@@lang:en
49     @@@@:
50     <Module::MDOM:DOMBoot> or its equivalent is also required.
51 wakaba 1.1
52     @DefaultFor:
53     ManakaiDOM:Perl
54    
55     Namespace:
56     @DIS:
57     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#
58     @dis:
59     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
60     @dis2pm:
61     http://suika.fam.cx/~wakaba/archive/2004/11/8/dis2pm#
62     @DISlib:
63     http://suika.fam.cx/~wakaba/archive/2004/dis/
64     @DOMCore:
65     http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#
66     @DOMLS:
67     http://suika.fam.cx/~wakaba/archive/2004/dom/ls#
68     @DOMMain:
69     http://suika.fam.cx/~wakaba/archive/2004/dom/main#
70 wakaba 1.20 @dx:
71     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#
72 wakaba 1.1 @infoset:
73     http://www.w3.org/2001/04/infoset#
74     @lang:
75     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#
76     @license:
77     http://suika.fam.cx/~wakaba/archive/2004/8/18/license#
78     @ManakaiDOM:
79     http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#
80     @Markup:
81     http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup#
82 wakaba 1.5 @MDOM:
83     http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.
84 wakaba 1.1 @MDOMX:
85     http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#
86     @owl:
87     http://www.w3.org/2002/07/owl#
88     @pc:
89     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/PerlCode#
90     @Perl:
91     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#Perl--
92     @rdf:
93     http://www.w3.org/1999/02/22-rdf-syntax-ns#
94     @rdfs:
95     http://www.w3.org/2000/01/rdf-schema#
96     @swcfg21:
97     http://suika.fam.cx/~wakaba/archive/2005/swcfg21#
98     @TreeCore:\
99     @Util:
100     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/
101    
102     ## -- Features
103    
104     ElementTypeBinding:
105     @Name: FeatureDef
106     @ElementType:
107     dis:ResourceDef
108     @ShadowContent:
109     @@rdf:type:
110     DOMMain:DOMFeature
111     @@AliasFor:
112     @@@@:
113     ::ManakaiDOM:all
114     @@@For:
115     !=ManakaiDOM:all
116    
117     ElementTypeBinding:
118     @Name: FeatureVerDef
119     @ElementType:
120     dis:ResourceDef
121     @ShadowContent:
122     @@rdf:type:
123     DOMMain:DOMFeature
124    
125     ElementTypeBinding:
126     @Name: featureQName
127     @ElementType:
128     dis:AppName
129     @ShadowContent:
130     @@ContentType:
131     dis:TypeQName
132    
133     FeatureDef:
134     @QName: CoreFeature
135     @featureQName:
136     Util:PerlCode
137     @FeatureVerDef:
138     @@QName: CoreFeature10
139     @@Version: 1.0
140     @@ISA: CoreFeature
141     @@FullName:
142     @@@lang:en
143     @@@@:
144     Perl Code Constructor, version 1.0
145     @@Description:
146     @@@lang:en
147     @@@@:
148     Perl Code Constructor, version 1.0.
149    
150     ## -- Classes
151    
152     ClsDef:
153     @ClsQName: ManakaiPerlCodeFragment
154     @ClsISA:
155     ManakaiDOM:ManakaiDOMNodeReference::ManakaiDOM:Perl
156 wakaba 1.20 @ClsISA:
157     dx:ManakaiDefaultExceptionHandler::ManakaiDOM:Perl
158 wakaba 1.1 @enDesc:
159     A class on which another Perl code classes are constructed based.
160    
161     @Attr:
162     @@Name: parentNode
163     @@enDesc:
164     The parent construction of this object.
165     @@Get:
166     @@@Type: ManakaiPerlCodeFragment
167 wakaba 1.5 @@@nullCase:
168     @@@@enDesc:
169     This object has no parent.
170 wakaba 1.1 @@@PerlDef:
171     $r = $self->{<Q::TreeCore:node>}->{<Q::pc:parent>};
172 wakaba 1.6 $r = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($r) if $r;
173    
174     @Attr:
175     @@Name: fileNode
176     @@enDesc:
177     The root <QUOTE::file> node of the tree to which this node belongs.
178     @@Type: ManakaiPerlCodeFragment
179     @@Get:
180     @@@enDesc:
181     The <QUOTE::file> node of the tree.
182     @@@nullCase:
183     @@@@enDesc:
184     This node does not belong to any file tree.
185     @@@PerlDef:
186     $r = $self->{<Q::TreeCore:node>}->{<Q::pc:parent>};
187     {
188     if ($r->{<Q::pc:parent>}) {
189     $r = $r->{<Q::pc:parent>};
190     redo;
191     }
192     };
193     if ($r) {
194     if ($r->{<Q::pc:nodeType>} eq 'file') {
195     __DEEP{
196     $r = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($r);
197     }__;
198     } else {
199     $r = null;
200     }
201     } elsif ($self->{<Q::TreeCore:node>}->{<Q::pc:nodeType>} eq 'file') {
202     $r = $self;
203     }
204    
205     @IntMethod:
206     @@Name: getNodeReference
207     @@ManakaiDOM:isStatic:1
208     @@enDesc:
209     Gets a node reference for a node object.
210     @@Param:
211     @@@Name: object
212     @@@Type:
213     ManakaiDOM:ManakaiDOMNodeReference::ManakaiDOM:Perl
214     @@@enDesc:
215     A node object.
216     @@Return:
217     @@@Type:
218     ManakaiDOM:ManakaiDOMNodeReference::ManakaiDOM:Perl
219     @@@PerlDef:
220     my $nt = $object->{<Q::pc:nodeType>};
221     my $pack;
222 wakaba 1.9 __CODE{pc:nodeTypeToPackageName::
223     $nodeType => $nt, $packageName => $pack, $object => $object}__;
224 wakaba 1.6 __CODE{ManakaiNode:getNewReference::
225     $object => $object, $ref => $r, $class => $pack}__;
226    
227     @Method:
228     @@Name: replaceVariable
229     @@enDesc:
230     Replaces a variable.
231     \
232     {NOTE:: For objects of type <Class::ManakaiPerlFile>,
233 wakaba 1.11 <Class::ManakaiPerlPackageScope>,
234     <Class::ManakaiPerlSub> and
235     <Class::ManakaiPerlVariable>, the result is undefined.
236 wakaba 1.6 \
237     }
238     @@Param:
239     @@@Name: originalVariable
240     @@@Type:
241     lang:Perl::ManakaiDOM:all
242     @@@enDesc:
243     Original variable specification, including prefix.
244     \
245     {NOTE:: Qualified name variable and hash key is not supported.
246     \
247     }
248     @@Param:
249     @@@Name: newValue
250 wakaba 1.11 @@@Type:
251     DOMMain:any::ManakaiDOM:all
252 wakaba 1.6 @@@enDesc:
253     New value to replace.
254 wakaba 1.11 @@@InCase:
255     @@@@Type:ManakaiPerlCodeFragment
256     @@@@enDesc:
257     New Perl code fragment to replace by.
258     @@@InCase:
259     @@@@Type:
260     lang:Perl::ManakaiDOM:all
261     @@@@enDesc:
262     Inline Perl code fragment string to replace by.
263 wakaba 1.6 @@Return:
264     @@@PerlDef:
265     my $node = $self->{<Q::TreeCore:node>};
266     if ($node->{<Q::pc:nodeType>} eq 'unparsed' or
267     $node->{<Q::pc:nodeType>} eq 'inunparsed') {
268 wakaba 1.11 my $newVariable = ref $newValue ? $newValue->stringify : ''.$newValue;
269 wakaba 1.14 $node->{<Q::pc:code>} =~ s/\Q$originalVariable\E\b/$newVariable/g;
270 wakaba 1.6 } elsif ($node->{<Q::pc:childNodes>}) {
271     __DEEP{
272 wakaba 1.11 for my $cnoi (0..$#{$node->{<Q::pc:childNodes>}}) {
273     my $cno = $node->{<Q::pc:childNodes>}->[$cnoi];
274     if ($cno->{<Q::pc:nodeType>} eq 'variable') {
275     if (substr ($originalVariable, 0, 1)
276     eq $cno->{<Q::pc:variableType>} and
277     not $cno->{<Q::pc:packageName>} and
278     substr ($originalVariable, 1)
279     eq $cno->{<Q::pc:localName>} and
280     not $cno->{<Q::pc:hashKey>}) {
281     if (ref $newValue) {
282     CORE::delete $cno->{<Q::pc:parent>};
283     $cno-><M::ManakaiDOM:ManakaiDOMNodeObject
284     ::ManakaiDOM:Perl.orphanate>;
285     my $newnode = $newValue->{<Q::TreeCore:node>};
286     $node-><M::ManakaiDOM:ManakaiDOMNodeObject
287     ::ManakaiDOM:Perl.importTree> ($newnode);
288     $newnode->{<Q::pc:parent>} = $node;
289     $node->{<Q::pc:childNodes>}->[$cnoi] = $newnode;
290     } else {
291     my $cn;
292     __CODE{ManakaiNode:getWeakReference::
293     $object => $cno, $ref => $cn,
294     $class => {<ClassName::ManakaiPerlCodeFragment>},
295     }__;
296     $cn-><M::ManakaiPerlInlineContainer.appendCode>
297     ($newValue);
298     }
299     }
300     } else { ## Non-variable child
301     my $cn;
302     __CODE{ManakaiNode:getWeakReference::
303     $object => $cno, $ref => $cn,
304     $class => {<ClassName::ManakaiPerlCodeFragment>},
305     }__;
306     $cn-><M::ManakaiPerlCodeFragment.replaceVariable>
307     ($originalVariable => $newValue);
308     }
309 wakaba 1.6 }
310     }__;
311     }
312 wakaba 1.13
313     @Method:
314     @@Name: addUsePerlModuleName
315     @@enDesc:
316     Adds a Perl module into the list of Perl modules
317     <Perl::use>d by this code fragment.
318     @@Param:
319     @@@Name: moduleName
320     @@@Type:
321     Perl:package-name::ManakaiDOM:all
322     @@@enDesc:
323     The name of the module package that should be <Perl::use>d.
324     @@Return:
325     @@@PerlDef:
326     $self->{<Q::TreeCore:node>}->{<Q::pc:useModuleName>}
327     ->{$moduleName} = true;
328    
329     @Method:
330 wakaba 1.22 @@Name: addUseCharClassName
331     @@enDesc:
332     Adds a Perl module into the list of Perl character classes
333     <Perl::use>d by this code fragment.
334     @@Param:
335     @@@Name: moduleName
336     @@@Type:
337     Perl:package-name::ManakaiDOM:all
338     @@@enDesc:
339     The name of the module package that should be <Perl::use>d.
340     @@Param:
341     @@@Name: charClassName
342     @@@Type:
343     lang:Perl::ManakaiDOM:all
344     @@@enDesc:
345     The name of the character class.
346     @@Return:
347     @@@PerlDef:
348     $self->{<Q::TreeCore:node>}->{<Q::pc:useCharClassName>}
349     ->{$moduleName}->{$charClassName} = true;
350    
351     @Method:
352 wakaba 1.19 @@Name: addRequirePerlModuleName
353     @@enDesc:
354     Adds a Perl module into the list of Perl modules
355     <Perl::require>d by this code fragment.
356     @@Param:
357     @@@Name: moduleName
358     @@@Type:
359     Perl:package-name::ManakaiDOM:all
360     @@@enDesc:
361     The name of the module package that should be <Perl::require>d.
362     @@Return:
363     @@@PerlDef:
364     $self->{<Q::TreeCore:node>}->{<Q::pc:requireModuleName>}
365     ->{$moduleName} = true;
366    
367     @Method:
368 wakaba 1.15 @@Name: getUsePerlModuleNameList
369     @@enDesc:
370     Returns a list of Perl modules names that is <Perl::use>d
371     by this code fragment, including all descendant nodes.
372     @@Return:
373     @@@Type:
374     Perl:ARRAY::ManakaiDOM:all
375     @@@enDesc:
376     A list of module names. Note that the list is <EM::dead>;
377     any modification to it does not affect to the code fragment
378     and vice versa.
379     @@@PerlDef:
380     my $list = {};
381     my @node = ($self->{<Q::TreeCore:node>});
382     while (my $node = shift @node) {
383 wakaba 1.19 next unless ref $node;
384 wakaba 1.15 for my $mname (keys %{$node->{<Q::pc:useModuleName>} || {}}) {
385     $list->{$mname} ||= $node->{<Q::pc:useModuleName>}->{$mname};
386     }
387     push @node, $node->{$_} for @{$node->{<Q::TreeCore:subnode0>}};
388     my @n;
389     for my $nn (map {$node->{$_}} @{$node->{<Q::TreeCore:subnode2>}}) {
390     push @n, (ref $nn eq 'ARRAY' ? @$nn : values %{$nn || {}});
391     }
392     for my $n ((map {$node->{$_}} @{$node->{<Q::TreeCore:subnode>}}), @n) {
393     push @node, (ref $n eq 'ARRAY' ? @$n : values %{$n || {}});
394     }
395     }
396     $r = [grep {$list->{$_}} keys %$list];
397    
398     @Method:
399 wakaba 1.22 @@Name: getUseCharClassNameList
400     @@enDesc:
401     Returns a list of Perl character class names that is <Perl::use>d
402     by this code fragment, including all descendant nodes.
403     @@Return:
404     @@@Type:
405     Perl:hash::ManakaiDOM:all
406     @@@enDesc:
407     A list of module names. Note that the list is <EM::dead>;
408     any modification to it does not affect to the code fragment
409     and vice versa.
410     @@@PerlDef:
411     my @node = ($self->{<Q::TreeCore:node>});
412     while (my $node = shift @node) {
413     next unless ref $node;
414     for my $mname (keys %{$node->{<Q::pc:useCharClassName>} || {}}) {
415     for my $cname (keys %{$node->{<Q::pc:useCharClassName>}
416     ->{$mname}}) {
417     $r->{$mname}->{$cname}
418     ||= $node->{<Q::pc:useCharClassName>}->{$mname}->{$cname};
419     }
420     }
421     push @node, $node->{$_} for @{$node->{<Q::TreeCore:subnode0>}};
422     my @n;
423     for my $nn (map {$node->{$_}} @{$node->{<Q::TreeCore:subnode2>}}) {
424     push @n, (ref $nn eq 'ARRAY' ? @$nn : values %{$nn || {}});
425     }
426     for my $n ((map {$node->{$_}} @{$node->{<Q::TreeCore:subnode>}}), @n) {
427     push @node, (ref $n eq 'ARRAY' ? @$n : values %{$n || {}});
428     }
429     }
430    
431     @Method:
432 wakaba 1.19 @@Name: getRequirePerlModuleNameList
433     @@enDesc:
434     Returns a list of Perl modules names that is <Perl::require>d
435     by this code fragment, including all descendant nodes.
436     @@Return:
437     @@@Type:
438     Perl:ARRAY::ManakaiDOM:all
439     @@@enDesc:
440     A list of module names. Note that the list is <EM::dead>;
441     any modification to it does not affect to the code fragment
442     and vice versa.
443     @@@PerlDef:
444     my $list = {};
445     my @node = ($self->{<Q::TreeCore:node>});
446     while (my $node = shift @node) {
447     next unless ref $node;
448     for my $mname (keys %{$node->{<Q::pc:requireModuleName>} || {}}) {
449     $list->{$mname} ||= $node->{<Q::pc:requireModuleName>}->{$mname};
450     }
451     push @node, $node->{$_} for @{$node->{<Q::TreeCore:subnode0>}};
452     my @n;
453     for my $nn (map {$node->{$_}} @{$node->{<Q::TreeCore:subnode2>}}) {
454     push @n, (ref $nn eq 'ARRAY' ? @$nn : values %{$nn || {}});
455     }
456     for my $n ((map {$node->{$_}} @{$node->{<Q::TreeCore:subnode>}}), @n) {
457     push @node, (ref $n eq 'ARRAY' ? @$n : values %{$n || {}});
458     }
459     }
460     $r = [grep {$list->{$_}} keys %$list];
461    
462     @Method:
463 wakaba 1.13 @@Name: disAddRequireURI
464     @@enDesc:
465     Adds a <QUOTE::dis> resource into the list of <Perl::require>d
466     resources of this code fragment.
467     @@Param:
468     @@@Name: uriArg
469     @@@Type:
470     DISLang:String::ManakaiDOM:all
471     @@@enDesc:
472     The URI reference of the resource to add.
473     @@Return:
474     @@@PerlDef:
475     $self->{<Q::TreeCore:node>}->{<Q::pc:requireResourceURI>}
476     ->{$uriArg} = true;
477 wakaba 1.15
478     @Method:
479     @@Name: disGetRequireURIList
480     @@enDesc:
481     Returns a list of <QUOTE::dis> resource URI references that is
482     <Perl::require>d by this code fragment, including all descendant nodes.
483     @@Return:
484     @@@Type:
485     Perl:ARRAY::ManakaiDOM:all
486     @@@enDesc:
487     A list of resource URI references. Note that the list is <EM::dead>;
488     any modification to it does not affect to the code fragment
489     and vice versa.
490     @@@PerlDef:
491     my $list = {};
492     my @node = ($self->{<Q::TreeCore:node>});
493     while (my $node = shift @node) {
494 wakaba 1.19 next unless ref $node;
495 wakaba 1.15 for my $mname (keys %{$node->{<Q::pc:requireResourceURI>} || {}}) {
496     $list->{$mname} ||= $node->{<Q::pc:requireResourceURI>}->{$mname};
497     }
498     push @node, $node->{$_} for @{$node->{<Q::TreeCore:subnode0>}};
499     my @n;
500     for my $nn (map {$node->{$_}} @{$node->{<Q::TreeCore:subnode2>}}) {
501     push @n, (ref $nn eq 'ARRAY' ? @$nn : values %{$nn || {}});
502     }
503     for my $n ((map {$node->{$_}} @{$node->{<Q::TreeCore:subnode>}}), @n) {
504     push @node, (ref $n eq 'ARRAY' ? @$n : values %{$n || {}});
505     }
506     }
507     $r = [grep {$list->{$_}} keys %$list];
508 wakaba 1.1 ##PerlCodeFragment
509    
510 wakaba 1.13 PropDef:
511     @QName: useModuleName
512     @enDesc:
513     The list of modules.
514    
515     PropDef:
516 wakaba 1.22 @QName: useCharClassName
517     @enDesc:
518     The list of modules.
519    
520     PropDef:
521 wakaba 1.13 @QName: requireResourceURI
522     @enDesc:
523     The list of resources.
524    
525 wakaba 1.9 ResourceDef:
526     @QName: nodeTypeToPackageName
527     @rdf:type:
528     dis2pm:BlockCode
529     @enDesc:
530     Gets Perl class package name from a node type string.
531     @PerlDef:
532     if ($nodeType eq 'unparsed') {
533     $packageName = <ClassName::ManakaiPerlUnparsedCode>;
534     } elsif ($nodeType eq 'bare') {
535     $packageName = <ClassName::ManakaiPerlBare>;
536     } elsif ($nodeType eq 'atom') {
537     $packageName = <ClassName::ManakaiPerlAtom>;
538     } elsif ($nodeType eq 'variable') {
539     $packageName = <ClassName::ManakaiPerlVariable>;
540     } elsif ($nodeType eq 'inunparsed') {
541     $packageName = <ClassName::ManakaiPerlInlineUnparsedCode>;
542     } elsif ($nodeType eq 'incontainer') {
543     $packageName = <ClassName::ManakaiPerlInlineContainer>;
544     } elsif ($nodeType eq 'statement') {
545     $packageName = <ClassName::ManakaiPerlStatement>;
546 wakaba 1.11 } elsif ($nodeType eq 'assign') {
547     $packageName = <ClassName::ManakaiPerlAssignment>;
548 wakaba 1.9 } elsif ($nodeType eq 'string') {
549     $packageName = <ClassName::ManakaiPerlStringLiteral>;
550     } elsif ($nodeType eq 'blockcontainer') {
551     $packageName = <ClassName::ManakaiPerlBlockContainer>;
552     } elsif ($nodeType eq 'block') {
553     $packageName = <ClassName::ManakaiPerlBlock>;
554 wakaba 1.12 } elsif ($nodeType eq 'if') {
555     $packageName = <ClassName::ManakaiPerlIf>;
556 wakaba 1.9 } elsif ($nodeType eq 'sub') {
557     $packageName = <ClassName::ManakaiPerlSub>;
558     } elsif ($nodeType eq 'package') {
559     $packageName = <ClassName::ManakaiPerlPackageScope>;
560     } elsif ($nodeType eq 'file') {
561     $packageName = <ClassName::ManakaiPerlFile>;
562     } else {
563     __ASSERT{DISPerl:invariant::
564     msg => {qq[Node type: "$nodeType" ].
565     qq[(ref: "@{[ref $object]}")]},
566     }__;
567     }
568    
569    
570 wakaba 1.6 PropDef:
571     @QName: nodeType
572     @enDesc:
573     Node type.
574    
575 wakaba 1.1 ClsDef:
576     @ClsQName: ManakaiPerlFile
577 wakaba 1.16 @ClsISA: ManakaiPerlStatementContainer
578 wakaba 1.1 @enDesc:
579     Perl source code files.
580    
581     @IntMethod:
582     @@Name:newObject
583     @@ManakaiDOM:isStatic:1
584     @@Description:
585     @@@lang:en
586     @@@@:
587     Creates a new instance object for <Class::ManakaiPerlFile>.
588     @@Return:
589     @@@Type:
590     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
591     @@@Description:
592     @@@@lang:en
593     @@@@@:
594     The newly created node object.
595     @@@PerlDef:
596     @@@@@:
597     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
598     ::ManakaiDOM:Perl.new>;
599     push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
600     $node->{<Q::pc:childNodes>} = [];
601     $node->{<Q::pc:sourceFile>} = '';
602     $node->{<Q::pc:sourceModule>} = '';
603     $node->{<Q::pc:sourceFor>} = '';
604     $node->{<Q::pc:currentPackage>} = 'main';
605     $node->{<Q::pc:currentChunk>} = 0;
606 wakaba 1.6 $node->{<Q::pc:nodeType>} = 'file';
607 wakaba 1.1 @@@@ImplNote:
608     @@@@@lang:en
609     @@@@@@:
610     Properties: <Q::pc:sourceFile>,
611     <Q::pc:sourceModule>, <Q::pc:sourceFor>, <Q::childNodes>,
612 wakaba 1.6 <Q::pc:currentPackage>, <Q::pc:currentChunk>,
613 wakaba 1.22 <Q::pc:nodeType>, <Q::pc:useModuleName>,
614     <Q::pc:useCharClassName>,
615 wakaba 1.15 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
616 wakaba 1.1
617     @Method:
618     @@Name: appendNewPackage
619     @@enDesc:
620     Appends a new package scope block.
621     @@Param:
622     @@@Name: packageName
623     @@@Type:
624     Perl:package-name::ManakaiDOM:all
625     @@@enDesc:
626     The fully-qualified name of the package to create.
627     @@Return:
628     @@@Type: ManakaiPerlPackageScope
629     @@@enDesc:
630     The newly created package scope object.
631     @@@PerlDef:
632     $r = <ClassM::ManakaiPerlPackageScope.newObject>;
633     $r->{<Q::pc:packageName>} = $packageName;
634     $self->{<Q::TreeCore:node>}
635     -><M::ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
636     .importTree> ($r);
637     push @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}}, $r;
638     $r->{<Q::pc:parent>} = $self->{<Q::TreeCore:node>};
639 wakaba 1.6 __CODE{ManakaiNode:getNewReference::
640     $object => $r, $ref => $r,
641     $class => {<ClassName::ManakaiPerlPackageScope>}}__;
642 wakaba 1.1
643     @Method:
644 wakaba 1.13 @@Name: appendPackage
645     @@enDesc:
646     Appends a Perl package scope object.
647     @@Param:
648     @@@Name: codeArg
649     @@@Type: ManakaiPerlPackageScope
650     @@@enDesc:
651     The package to append.
652     @@Return:
653     @@@RaiseException:
654     @@@@@:IN_USE_NODE_ERR
655     @@@@enDesc:
656     An attempt is made to set a subroutine that is
657     already used elsewhere.
658     @@@PerlDef:
659     my $packobj = $codeArg->{<Q::TreeCore:node>};
660     if ($packobj->{<Q::pc:parent>}) {
661     __EXCEPTION{IN_USE_NODE_ERR::
662     pc:childNode => {$codeArg},
663     MDOMX:param-name => 'codeArg',
664     }__;
665     }
666     $self->{<Q::TreeCore:node>}
667     -><M::ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
668     .importTree> ($packobj);
669     push @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}}, $packobj;
670     $packobj->{<Q::pc:parent>} = $self->{<Q::TreeCore:node>};
671    
672     @Method:
673 wakaba 1.1 @@Name: getFirstPackage
674     @@enDesc:
675     Gets the first package scope block of a name.
676     @@Param:
677     @@@Name: packageName
678     @@@@Type:
679     Perl:package-name::ManakaiDOM:all
680     @@@@enDesc:
681     The fully-qualified name of the package to get.
682     @@NamedParam:
683     @@@Name: makeNewPackage
684     @@@Type:
685 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
686 wakaba 1.1 @@@enDesc:
687     Whether a new package scope object should be created if
688     no package of <P::packageName> found.
689     @@@TrueCase:
690     @@@@enDesc:
691     Makes a new object if not found.
692     @@@FalseCase:
693     @@@@enDesc:
694     Don't make a new object.
695     @@Return:
696     @@@Type: ManakaiPerlPackageScope
697     @@@enDesc:
698     The first package scope object whose name is equal to
699     <P::packageName>.
700     @@@nullCase:
701     @@@@enDesc:
702     There is no <P::packageName> package object and
703     the <P::makeNewPackage> parameter is set to <DOM::false>.
704     @@@PerlDef:
705     for my $cn (@{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}}) {
706 wakaba 1.16 if ($cn->{<Q::pc:nodeType>} eq 'package' and
707     $cn->{<Q::pc:packageName>} eq $packageName) {
708 wakaba 1.1 $r = $cn;
709     last;
710     }
711     }
712     if ($r) {
713 wakaba 1.6 __CODE{ManakaiNode:getNewReference::
714     $object => $r, $ref => $r,
715     $class => {<ClassName::ManakaiPerlPackageScope>}}__;
716 wakaba 1.1 } elsif ($makeNewPackage) {
717     __DEEP{
718     $r = $self-><M::ManakaiPerlFile.appendNewPackage> ($packageName);
719     }__;
720     }
721    
722     @Method:
723     @@Name: getLastPackage
724     @@enDesc:
725     Gets the last package scope block of a name.
726     @@Param:
727     @@@Name: packageName
728     @@@@Type:
729     Perl:package-name::ManakaiDOM:all
730     @@@@enDesc:
731     The fully-qualified name of the package to get.
732     @@NamedParam:
733     @@@Name: makeNewPackage
734     @@@Type:
735 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
736 wakaba 1.1 @@@enDesc:
737     Whether a new package scope object should be created if
738     no package of <P::packageName> found.
739     @@@TrueCase:
740     @@@@enDesc:
741     Makes a new object if not found.
742     @@@FalseCase:
743     @@@@enDesc:
744     Don't make a new object.
745     @@Return:
746     @@@Type: ManakaiPerlPackageScope
747     @@@enDesc:
748     The last package scope object whose name is equal to
749     <P::packageName>.
750     @@@nullCase:
751     @@@@enDesc:
752     There is no <P::packageName> package object and
753     the <P::makeNewPackage> parameter is set to <DOM::false>.
754     @@@PerlDef:
755     for my $cn (reverse @{$self->{<Q::TreeCore:node>}
756     ->{<Q::pc:childNodes>}}) {
757 wakaba 1.16 if ($cn->{<Q::pc:nodeType>} eq 'package' and
758     $cn->{<Q::pc:packageName>} eq $packageName) {
759 wakaba 1.1 $r = $cn;
760     last;
761     }
762     }
763     if ($r) {
764 wakaba 1.6 __CODE{ManakaiNode:getNewReference::
765     $object => $r, $ref => $r,
766     $class => {<ClassName::ManakaiPerlPackageScope>}}__;
767 wakaba 1.1 } elsif ($makeNewPackage) {
768     __DEEP{
769     $r = $self-><M::ManakaiPerlFile.appendNewPackage> ($packageName);
770     }__;
771     }
772    
773     @Attr:
774     @@Name: sourceFile
775     @@enDesc:
776     The file name of the source file from which this
777     Perl code is primary generated.
778     @@Get:
779     @@@Type:
780 wakaba 1.12 DISLang:String::ManakaiDOM:all
781 wakaba 1.1 @@@disDef:
782     @@@@GetProp: sourceFile
783     @@Set:
784     @@@Type:
785 wakaba 1.12 DISLang:String::ManakaiDOM:all
786 wakaba 1.1 @@@disDef:
787     @@@@SetProp: sourceFile
788    
789     @Attr:
790     @@Name: sourceModule
791     @@enDesc:
792     The name URI reference of the source module that this package defines.
793     @@Get:
794     @@@Type:
795 wakaba 1.12 DISLang:String::ManakaiDOM:all
796 wakaba 1.1 @@@disDef:
797     @@@@GetProp: sourceModule
798     @@Set:
799     @@@Type:
800 wakaba 1.12 DISLang:String::ManakaiDOM:all
801 wakaba 1.1 @@@disDef:
802     @@@@SetProp: sourceModule
803    
804     @Attr:
805     @@Name: sourceFor
806     @@enDesc:
807     The URI reference of the source module <QUOTE::for> for which this
808     package is.
809     @@Get:
810     @@@Type:
811 wakaba 1.12 DISLang:String::ManakaiDOM:all
812 wakaba 1.1 @@@disDef:
813     @@@@GetProp: sourceFor
814     @@Set:
815     @@@Type:
816 wakaba 1.12 DISLang:String::ManakaiDOM:all
817 wakaba 1.1 @@@disDef:
818     @@@@SetProp: sourceFor
819    
820     @ToStringMethod:
821     @@Return:
822     @@@Type:
823 wakaba 1.12 DISLang:String::ManakaiDOM:all
824 wakaba 1.1 @@@enDesc:
825     The Perl code generated.
826     @@@PerlDef:
827     __DEEP{
828     my $node = $self->{<Q::TreeCore:node>};
829     ## -- Header
830     $r = qq<#!/usr/bin/perl \n>;
831     $r .= <ClassM::ManakaiPerlCodeImplementation.perlComment>
832     (q<This file is automatically generated>);
833     $r .= <ClassM::ManakaiPerlCodeImplementation.perlComment>
834     (q< at >.<ClassM::ManakaiPerlCodeImplementation
835     .rfc3339DateTime> (time).q<,>);
836     $r .= <ClassM::ManakaiPerlCodeImplementation.perlComment>
837     (q< from file ">.$node->{<Q::sourceFile>}.q<",>);
838     $r .= <ClassM::ManakaiPerlCodeImplementation.perlComment>
839     (q[ module <].$node->{<Q::sourceModule>}.q[>,]);
840     $r .= <ClassM::ManakaiPerlCodeImplementation.perlComment>
841     (q[ for <].$node->{<Q::sourceFor>}.q[>.]);
842     $r .= <ClassM::ManakaiPerlCodeImplementation.perlComment>
843     (q<Don't edit by hand!>);
844     $r .= qq<use strict;\n>;
845     $self-><AS::ManakaiPerlFile.currentPackage> ('main');
846 wakaba 1.6 $self-><AS::ManakaiPerlFile.currentChunkNumber> (0);
847 wakaba 1.1
848 wakaba 1.15 ## -- Requires
849 wakaba 1.19 my $req = $self-><M::ManakaiPerlCodeFragment
850     .getRequirePerlModuleNameList>;
851     for my $pack (@$req) {
852 wakaba 1.15 $r .= qq<require $pack;\n>;
853     }
854    
855 wakaba 1.16 ## -- Packages and global objects
856 wakaba 1.1 my $pack = {};
857 wakaba 1.16 for my $cno (@{$node->{<Q::pc:childNodes>}}) {
858     my $cn = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($cno);
859     $r .= $cn->stringify;
860     if ($cno->{<Q::pc:nodeType>} eq 'package') {
861     for my $ipack (keys %{$cno->{<Q::dis:Implement>}}) {
862     $pack->{$ipack} ||= true; # not defined
863     }
864     $pack->{$cno->{<Q::pc:packageName>}} = []; # defined
865 wakaba 1.1 }
866     }
867    
868     ## -- Enables interface packages
869 wakaba 1.3 my @packs = map {'$' . $_ . '::'}
870     grep {not ref $pack->{$_} and $pack->{$_}}
871     keys %$pack;
872     $r .= q<for (>. join (', ', @packs) . qq<){}\n> if @packs;
873 wakaba 1.1
874     ## -- Footer
875     $r .= <ClassM::ManakaiPerlCodeImplementation.perlComment>
876 wakaba 1.2 (q[License: <].$node->{<Q::dis:License>}.qq[>\n]);
877 wakaba 1.1 $r .= qq<1;\n>;
878     }__;
879    
880     @Attr:
881     @@Name: currentPackage
882     @@enDesc:
883     The current Perl package (used in stringify method).
884     @@Type:
885     Perl:package-name::ManakaiDOM:all
886     @@Get:
887     @@@disDef:
888     @@@@GetProp: currentPackage
889     @@Set:
890     @@@disDef:
891     @@@@SetProp: currentPackage
892    
893     @Attr:
894 wakaba 1.6 @@Name: currentChunkNumber
895 wakaba 1.1 @@enDesc:
896 wakaba 1.6 The current code chunk number (used in stringify method).
897 wakaba 1.1 @@Type:
898     DOMMain:unsigned-long::ManakaiDOM:all
899     @@Get:
900     @@@disDef:
901     @@@@GetProp: currentChunk
902     @@Set:
903     @@@disDef:
904     @@@@SetProp: currentChunk
905 wakaba 1.6
906     @Method:
907     @@Name: getNextChunkNumber
908     @@enDesc:
909     Increments the current chunk number of this file
910     and returns it.
911     @@Return:
912     @@@Type:
913     DOMMain:unsigned-long::ManakaiDOM:all
914     @@@enDesc:
915     The next chunk number.
916     @@@PerlDef:
917     $r = ++$self->{<Q::TreeCore:node>}->{<Q::pc:currentChunk>};
918 wakaba 1.2
919     @Attr:
920     @@Name: licenseURI
921     @@enDesc:
922     The license term URI reference for this code.
923     @@Type:
924     DISLang:String::ManakaiDOM:all
925     @@Get:
926     @@@disDef:
927     @@@@GetProp:
928     dis:License
929     @@Set:
930     @@@disDef:
931     @@@@SetProp:
932     dis:License
933 wakaba 1.1 ##PerlFile
934    
935     PropDef:
936 wakaba 1.18 @QName: export
937     @enDesc:
938     The list of exported members.
939    
940     PropDef:
941 wakaba 1.15 @QName: requireModuleName
942     @enDesc:
943     The list of <Perl::require>d Perl module names
944    
945     PropDef:
946 wakaba 1.1 @QName: sourceModule
947     @enDesc:
948     The soruce module name URI reference.
949    
950     PropDef:
951     @QName: sourceFor
952     @enDesc:
953     The source module <QUOTE::for> URI reference.
954    
955     PropDef:
956     @QName: currentPackage
957     @enDesc:
958     The current Perl package name (used for stringify).
959    
960     PropDef:
961     @QName: currentChunk
962     @enDesc:
963     The current code chunk (used for stringify).
964    
965     ClsDef:
966     @ClsQName: ManakaiPerlPackageScope
967 wakaba 1.16 @ClsISA: ManakaiPerlStatementContainer
968    
969     @enDesc:
970     A Perl lexical lines for which a <Perl::package> declaration
971     in effect.
972 wakaba 1.1
973     @Attr:
974     @@Name: packageName
975     @@Type:
976 wakaba 1.12 Perl:package-name::ManakaiDOM:all
977 wakaba 1.1 @@enDesc:
978     The fully-qualified package name.
979     @@Get:
980     @@@disDef:
981     @@@@GetProp: packageName
982    
983     @IntMethod:
984     @@Name:newObject
985     @@ManakaiDOM:isStatic:1
986     @@Description:
987     @@@lang:en
988     @@@@:
989     Creates a new instance object for <Class::ManakaiPerlPackageScope>.
990     @@Return:
991     @@@Type:
992     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
993     @@@Description:
994     @@@@lang:en
995     @@@@@:
996     The newly created node object.
997     @@@PerlDef:
998     @@@@@:
999     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
1000     ::ManakaiDOM:Perl.new>;
1001 wakaba 1.15 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:sub>,
1002 wakaba 1.16 <Q::dis2pm:operator>,
1003     <Q::pc:childNodes>;
1004 wakaba 1.1 push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
1005     $node->{<Q::pc:sub>} = {};
1006 wakaba 1.14 $node->{<Q::dis2pm:operator>} = {};
1007 wakaba 1.1 $node->{<Q::dis:ISA>} = [];
1008     $node->{<Q::dis:Implement>} = {};
1009 wakaba 1.6 $node->{<Q::pc:nodeType>} = 'package';
1010 wakaba 1.16 $node->{<Q::pc:childNodes>} = [];
1011 wakaba 1.6 @@@@ImplNote:
1012     @@@@@lang:en
1013     @@@@@@:
1014 wakaba 1.14 Properties: <Q::pc:sub>, <Q::dis2pm:operator>,
1015 wakaba 1.6 <Q::dis:ISA>, <Q::dis:Implement>,
1016 wakaba 1.22 <Q::pc:nodeType>, <Q::pc:useModuleName>,
1017     <Q::pc:useCharClassName>,
1018 wakaba 1.18 <Q::pc:requireResourceURI>, <Q::pc:childNodes>,
1019 wakaba 1.19 <Q::pc:export>, <Q::pc:requireModuleName>.
1020 wakaba 1.1
1021     @Method:
1022     @@Name: getSub
1023     @@enDesc:
1024     Gets a subroutine.
1025     @@Param:
1026     @@@Name: subName
1027     @@@Type:
1028     DISPerl:SubName::ManakaiDOM:all
1029     @@@enDesc:
1030     The name of subroutine to get.
1031     @@NamedParam:
1032     @@@Name: makeNewNode
1033     @@@Type:
1034 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
1035 wakaba 1.1 @@@enDesc:
1036     Whether a new subroutine object should be created,
1037     if it is not exist, or not.
1038     @@Return:
1039     @@@Type: ManakaiPerlSub
1040     @@@enDesc:
1041     The subroutine object.
1042 wakaba 1.4 @@@nullCase:
1043     @@@@enDesc:
1044     Either the specified subroutine is not found and
1045     the <P::makeNewNode> parameter is set to <DOM::false> or
1046     the subroutine is defined as an alias.
1047 wakaba 1.1 @@@PerlDef:
1048     if ($self->{<Q::TreeCore:node>}->{<Q::pc:sub>}->{$subName}) {
1049 wakaba 1.4 $r = ref $self->{<Q::TreeCore:node>}->{<Q::pc:sub>}->{$subName}
1050     ? $self->{<Q::TreeCore:node>}->{<Q::pc:sub>}->{$subName} : null;
1051 wakaba 1.1 } elsif ($makeNewNode) {
1052     $r = $self->{<Q::TreeCore:node>}->{<Q::pc:sub>}->{$subName}
1053     = <ClassM::ManakaiPerlSub.newObject>;
1054     $self->{<Q::TreeCore:node>}
1055     -><M::ManakaiDOM:ManakaiDOMNodeObject
1056     ::ManakaiDOM:Perl.importTree> ($r);
1057     $r->{<Q::pc:parent>} = $self->{<Q::TreeCore:node>};
1058     $r->{<Q::pc:localName>} = $subName;
1059     }
1060 wakaba 1.6 if ($r) {
1061     __CODE{ManakaiNode:getNewReference::
1062     $object => $r, $ref => $r,
1063     $class => {<ClassName::ManakaiPerlSub>}}__;
1064     }
1065 wakaba 1.1
1066 wakaba 1.4 @Method:
1067 wakaba 1.5 @@Name: setSub
1068     @@enDesc:
1069     Sets a subrotine.
1070     @@Param:
1071     @@@Name: subName
1072     @@@Type:
1073     DISLang:String::ManakaiDOM:all
1074     @@@enDesc:
1075     The name of the subroutine.
1076     \
1077     {NOTE:: The <P::subName> value must be equal to the
1078     <A::ManakaiPerlSub.localName> of the <P::subArg>.
1079     @@Param:
1080     @@@Name: subArg
1081     @@@Type: ManakaiPerlSub
1082     @@@enDesc:
1083     The subroutine object.
1084     @@Return:
1085     @@@RaiseException:
1086     @@@@@:IN_USE_NODE_ERR
1087     @@@@enDesc:
1088     An attempt is made to set a subroutine that is
1089     already used elsewhere.
1090     @@@PerlDef:
1091     my $ops = $self->{<Q::TreeCore:node>}->{<Q::pc:sub>};
1092     if (ref $ops->{$subName}) {
1093     CORE::delete $ops->{<Q::pc:parent>};
1094     $ops->{$subName}
1095     -><M::ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl.orphanate>;
1096     }
1097     if ($subArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
1098     __EXCEPTION{IN_USE_NODE_ERR::
1099     pc:childNode => {$subArg},
1100     }__;
1101     }
1102     $self->{<Q::TreeCore:node>}-><M::MNodeObject.importTree>
1103     ($subArg->{<Q::TreeCore:node>});
1104     $ops->{$subName} = $subArg->{<Q::TreeCore:node>};
1105     $subArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}
1106     = $self->{<Q::TreeCore:node>};
1107    
1108     @Method:
1109 wakaba 1.4 @@Name: getSubAliasName
1110     @@enDesc:
1111     Gets the real name of a subroutine.
1112     @@Param:
1113     @@@Name: subName
1114     @@@Type:
1115     DISLang:String::ManakaiDOM:all
1116     @@@enDesc:
1117     The name of the alias subroutine.
1118     @@Return:
1119     @@@Type:
1120     DISLang:String::ManakaiDOM:all
1121     @@@enDesc:
1122     The real name.
1123     @@@nullCase:
1124     @@@@enDesc:
1125     The specified name is used.
1126     @@@InCase:
1127     @@@@Value:\#CODE
1128     @@@@enDesc:
1129     The specified name is not an alias.
1130     @@@PerlDef:
1131     if ($self->{<Q::TreeCore:node>}->{<Q::sub>}->{$subName}) {
1132     $r = ref $self->{<Q::TreeCore:node>}
1133     ->{<Q::sub>}->{$subName}
1134     ? q<#CODE> : $self->{<Q::TreeCore:node>}
1135     ->{<Q::sub>}->{$subName};
1136     }
1137    
1138     @Method:
1139     @@Name: setSubAliasName
1140     @@enDesc:
1141     Sets a subroutine name as an alias of another subroutine.
1142     @@Param:
1143     @@@Name: aliasName
1144     @@@Type:
1145     DISLang:String::ManakaiDOM:all
1146     @@@enDesc:
1147     The alias name.
1148     @@Param:
1149     @@@Name: realName
1150     @@@Type:
1151     DISLang:String::ManakaiDOM:all
1152     @@@enDesc:
1153     The real name.
1154     @@Return:
1155     @@@UnknownOperatorException:
1156     @@@PerlDef:
1157     my $ops = $self->{<Q::TreeCore:node>}->{<Q::sub>};
1158     if (ref $ops->{$aliasName}) {
1159     CORE::delete $ops->{<Q::pc:parent>};
1160     $ops->{$aliasName}
1161     -><M::ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl.orphanate>;
1162     }
1163     $ops->{$aliasName} = $realName;
1164    
1165     @Method:
1166     @@Name: getOverloadSub
1167     @@enDesc:
1168     Gets an overloading subroutine.
1169     @@Param:
1170     @@@Name: opName
1171     @@@Type:
1172     DISLang:String::ManakaiDOM:all
1173     @@@enDesc:
1174     The name of the overloaded operator.
1175     @@NamedParam:
1176     @@@Name: makeNewNode
1177     @@@Type:
1178 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
1179 wakaba 1.4 @@@enDesc:
1180     Whether a new subroutine object should be created,
1181     if it is not exist, or not.
1182     @@Return:
1183     @@@Type: ManakaiPerlSub
1184     @@@enDesc:
1185     The subroutine object.
1186     @@@nullCase:
1187     @@@@enDesc:
1188     Either the specified subroutine is not found and
1189     the <P::makeNewNode> parameter is set to <DOM::false> or
1190     the specified operator is overloaded by specifying method name.
1191     @@@UnknownOperatorException:
1192     @@@PerlDef:
1193     unless (<Code::operatorNameList>->{$opName}) {
1194     __EXCEPTION{UNSUPPORTED_OPERATOR_ERR::
1195     pc:operator => {$opName},
1196     }__;
1197     }
1198     if ($self->{<Q::TreeCore:node>}->{<Q::dis2pm:operator>}->{$opName}) {
1199     $r = ref $self->{<Q::TreeCore:node>}
1200     ->{<Q::dis2pm:operator>}->{$opName}
1201     ? $self->{<Q::TreeCore:node>}
1202     ->{<Q::dis2pm:operator>}->{$opName} : null;
1203     } elsif ($makeNewNode) {
1204     $r = $self->{<Q::TreeCore:node>}->{<Q::dis2pm:operator>}->{$opName}
1205     = <ClassM::ManakaiPerlSub.newObject>;
1206     $self->{<Q::TreeCore:node>}
1207     -><M::ManakaiDOM:ManakaiDOMNodeObject
1208     ::ManakaiDOM:Perl.importTree> ($r);
1209     $r->{<Q::pc:parent>} = $self->{<Q::TreeCore:node>};
1210     }
1211 wakaba 1.6 if ($r) {
1212     __CODE{ManakaiNode:getNewReference::
1213     $object => $r, $ref => $r,
1214     $class => {<ClassName::ManakaiPerlSub>}}__;
1215     }
1216 wakaba 1.4
1217     @Method:
1218 wakaba 1.5 @@Name: setOverloadSub
1219     @@enDesc:
1220     Sets an overloading subrotine.
1221     @@Param:
1222     @@@Name: opName
1223     @@@Type:
1224     DISLang:String::ManakaiDOM:all
1225     @@@enDesc:
1226     The name of the opeartor to overload.
1227     @@Param:
1228     @@@Name: subArg
1229     @@@Type: ManakaiPerlSub
1230     @@@enDesc:
1231     The subroutine object.
1232     @@Return:
1233     @@@UnknownOperatorException:
1234     @@@RaiseException:
1235     @@@@@:IN_USE_NODE_ERR
1236     @@@@enDesc:
1237     An attempt is made to set a subroutine that is
1238     already used elsewhere.
1239     @@@PerlDef:
1240     unless (<Code::operatorNameList>->{$opName}) {
1241     __EXCEPTION{UNSUPPORTED_OPERATOR_ERR::
1242     pc:operator => {$opName},
1243     }__;
1244     }
1245     my $ops = $self->{<Q::TreeCore:node>}->{<Q::dis2pm:operator>};
1246     if (ref $ops->{$opName}) {
1247     CORE::delete $ops->{<Q::pc:parent>};
1248     $ops->{$opName}
1249     -><M::ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl.orphanate>;
1250     }
1251     if ($subArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
1252     __EXCEPTION{IN_USE_NODE_ERR::
1253     pc:parentNode => {$self},
1254     pc:childNode => {$subArg},
1255     }__;
1256     }
1257     $self->{<Q::TreeCore:node>}-><M::MNodeObject.importTree>
1258     ($subArg->{<Q::TreeCore:node>});
1259     $ops->{$opName} = $subArg->{<Q::TreeCore:node>};
1260     $subArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}
1261     = $self->{<Q::TreeCore:node>};
1262    
1263    
1264     @Method:
1265 wakaba 1.4 @@Name: getOverloadMethodName
1266     @@enDesc:
1267     Gets an overloading method name.
1268     @@Param:
1269     @@@Name: opName
1270     @@@Type:
1271     DISLang:String::ManakaiDOM:all
1272     @@@enDesc:
1273     The name of the overloaded operator.
1274     @@Return:
1275     @@@Type:
1276     DISLang:String::ManakaiDOM:all
1277     @@@enDesc:
1278     The method name.
1279     @@@nullCase:
1280     @@@@enDesc:
1281     The specified operator is not overloaded.
1282     @@@InCase:
1283     @@@@Value:\#CODE
1284     @@@@enDesc:
1285     The operator is overloaded by an anonymous subroutine.
1286     @@@PerlDef:
1287     if ($self->{<Q::TreeCore:node>}->{<Q::dis2pm:operator>}->{$opName}) {
1288     $r = ref $self->{<Q::TreeCore:node>}
1289     ->{<Q::dis2pm:operator>}->{$opName}
1290     ? q<#CODE> : $self->{<Q::TreeCore:node>}
1291     ->{<Q::dis2pm:operator>}->{$opName};
1292     }
1293    
1294     @Method:
1295     @@Name: setOverloadMethodName
1296     @@enDesc:
1297     Sets an overloading method name.
1298     @@Param:
1299     @@@Name: opName
1300     @@@Type:
1301     DISLang:String::ManakaiDOM:all
1302     @@@enDesc:
1303     The name of the overloaded operator.
1304     @@Param:
1305     @@@Name: methodName
1306     @@@Type:
1307     DISLang:String::ManakaiDOM:all
1308     @@@enDesc:
1309     The name of the method by which overloads an operator.
1310     \
1311     {NOTE:: The method may or may not belong to this package.
1312     \
1313     }
1314     @@Return:
1315     @@@UnknownOperatorException:
1316     @@@PerlDef:
1317     unless (<Code::operatorNameList>->{$opName}) {
1318     __EXCEPTION{UNSUPPORTED_OPERATOR_ERR::
1319     pc:operator => {$opName},
1320     }__;
1321     }
1322     my $ops = $self->{<Q::TreeCore:node>}->{<Q::dis2pm:operator>};
1323     if (ref $ops->{$opName}) {
1324     CORE::delete $ops->{<Q::pc:parent>};
1325     $ops->{$opName}
1326     -><M::ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl.orphanate>;
1327     }
1328     $ops->{$opName} = $methodName;
1329    
1330 wakaba 1.1 @Method:
1331 wakaba 1.13 @@Name: addISAPackage
1332 wakaba 1.1 @@enDesc:
1333     Adds a class package that this class inherits.
1334     @@Param:
1335     @@@Name: packageName
1336     @@@Type:
1337     Perl:package-name::ManakaiDOM:all
1338     @@@enDesc:
1339     The name of package to add.
1340     @@Return:
1341     @@@PerlDef:
1342     push @{$self->{<Q::TreeCore:node>}->{<Q::dis:ISA>}}, $packageName;
1343    
1344     @Method:
1345     @@Name: addImplementPackage
1346     @@enDesc:
1347     Adds a interface package that this class implements.
1348     @@Param:
1349     @@@Name: packageName
1350     @@@Type:
1351     Perl:package-name::ManakaiDOM:all
1352     @@@enDesc:
1353     The name of package to add.
1354     @@Return:
1355     @@@PerlDef:
1356     $self->{<Q::TreeCore:node>}->{<Q::dis:Implement>}->{$packageName} = true;
1357    
1358     @ToStringMethod:
1359     @@Return:
1360     @@@Type:
1361 wakaba 1.12 DISLang:String::ManakaiDOM:all
1362 wakaba 1.1 @@@enDesc:
1363     Perl code.
1364     @@@PerlDef:
1365     my $file = $self-><AG::ManakaiPerlCodeFragment.parentNode>;
1366     my $node = $self->{<Q::TreeCore:node>};
1367 wakaba 1.15
1368     ## Package name
1369 wakaba 1.1 my $pn = $node->{<Q::pc:packageName>};
1370     $r .= q<package > . $pn . ";\n";
1371 wakaba 1.15
1372     ## Package version
1373 wakaba 1.1 __DEEP{
1374     $file-><AS::ManakaiPerlFile.currentPackage> ($pn);
1375     $r .= 'our $VERSION = '.
1376     <ClassM::ManakaiPerlCodeImplementation.versionDateTime> (time).
1377     ";\n";
1378     }__;
1379 wakaba 1.15
1380     ## Inheritance
1381 wakaba 1.1 my @isa = (@{$node->{<Q::dis:ISA>}},
1382     sort keys %{$node->{<Q::dis:Implement>}});
1383     if (@isa) {
1384     $r .= 'push our @ISA, ' .
1385     <ClassM::ManakaiPerlCodeImplementation.perlList> (\@isa) .
1386     ";\n";
1387     }
1388 wakaba 1.15
1389     ## Uses
1390     my $use = $self-><M::ManakaiPerlCodeFragment.getUsePerlModuleNameList>;
1391     for my $pack (@$use) {
1392     $r .= 'use ' . $pack . ";\n";
1393     }
1394    
1395 wakaba 1.22 my $cls = $self-><M::ManakaiPerlCodeFragment.getUseCharClassNameList>;
1396     for my $pack (keys %$cls) {
1397     $r .= 'use ' . $pack . ' ' .
1398     <ClassM::ManakaiPerlCodeImplementation.perlList>
1399     ([grep {$cls->{$pack}->{$_}} keys %{$cls->{$pack}}]) . ";\n";
1400     }
1401    
1402 wakaba 1.16 ## Package-scope objects
1403     for my $cno (@{$node->{<Q::pc:childNodes>}}) {
1404     my $cn = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($cno);
1405     $r .= $cn->stringify;
1406     }
1407    
1408 wakaba 1.15 ## Subroutines
1409 wakaba 1.4 for my $cnk (keys %{$node->{<Q::pc:sub>}}) {
1410     my $cno = $node->{<Q::pc:sub>}->{$cnk};
1411     if (ref $cno) {
1412 wakaba 1.6 my $cn;
1413     __CODE{ManakaiNode:getWeakReference::
1414     $object => $cno, $ref => $cn,
1415     $class => {<ClassName::ManakaiPerlSub>}}__;
1416 wakaba 1.4 $r .= $cn->stringify;
1417     } else {
1418 wakaba 1.19 $r .= qq<*$cnk = \\&$cno;\n>;
1419 wakaba 1.4 }
1420     }
1421 wakaba 1.15
1422     ## Operators
1423 wakaba 1.4 my $op = '';
1424     for my $cnk (keys %{$node->{<Q::dis2pm:operator>}}) {
1425     my $cno = $node->{<Q::dis2pm:operator>}->{$cnk};
1426     if (ref $cno) {
1427 wakaba 1.6 my $cn;
1428     __CODE{ManakaiNode:getWeakReference::
1429     $object => $cno, $ref => $cn,
1430     $class => {<ClassName::ManakaiPerlSub>}}__;
1431 wakaba 1.4 $op .= <ClassM::ManakaiPerlCodeImplementation.perlLiteral> ($cnk)
1432     . ' => ' . $cn->stringify . ', ';
1433     } elsif (defined $cno) {
1434     $op .= <ClassM::ManakaiPerlCodeImplementation.perlList>
1435     ([$cnk => $cno]) . ', ';
1436     }
1437     }
1438 wakaba 1.14 $r .= 'use overload bool => sub () {1}, ' .
1439     $op . qq[fallback => 1;\n] if $op;
1440 wakaba 1.18
1441    
1442     ## -- Exports
1443     if (keys %{$node->{<Q::pc:export>} || {}}) {
1444     $r .= q[our %EXPORT_TAG = (] .
1445     <ClassM::ManakaiPerlCodeImplementation.perlList>
1446     ([map {$_ => [keys %{$node->{<Q::pc:export>}->{$_}}]}
1447     grep {$_} keys %{$node->{<Q::pc:export>}}]) . qq[);\n];
1448     $r .= q[our @EXPORT_OK = (] .
1449     <ClassM::ManakaiPerlCodeImplementation.perlList>
1450     ([map {keys %{$node->{<Q::pc:export>}->{$_}}}
1451     keys %{$node->{<Q::pc:export>}}]) . qq[);\n];
1452     $r .= q[use Exporter; push our @ISA, 'Exporter';] . qq[\n];
1453     }
1454    
1455     @Method:
1456     @@Name: addExport
1457     @@enDesc:
1458     Adds a name to the list of exported items (<Perl::@EXPORT_OK).
1459     @@Param:
1460     @@@Name: exportTag
1461     @@@Type:
1462     lang:Perl::ManakaiDOM:all
1463     @@@enDesc:
1464     The name of the tag (without <CHAR::COLON> prefix).
1465     The <P::exportName> is added both to <Perl::@EXPORT_OK>
1466     and <Perl::$EXPORT_OK{<P::exportTag>}>.
1467     @@@nullCase:
1468     @@@@enDesc:
1469     The <P::exportName> is added only to the <Perl::@EXPORT_OK>.
1470     @@Param:
1471     @@@Name: exportName
1472     @@@Type:
1473     lang:Perl::ManakaiDOM:all
1474     @@@enDesc:
1475     The name to be exported.
1476     @@Return:
1477     @@@PerlDef:
1478     $self->{<Q::TreeCore:node>}->{<Q::pc:export>}
1479     ->{defined $exportTag ? $exportTag : ''}->{$exportName} = true;
1480 wakaba 1.1 ##PerlPackageScope
1481    
1482 wakaba 1.4 PropDef:
1483     @QName:
1484     dis2pm:operator
1485     @enDesc:
1486     Overloaded operators.
1487    
1488     ElementTypeBinding:
1489     @Name: UnknownOperatorException
1490     @ElementType:
1491     ManakaiDOM:raises
1492     @ShadowContent:
1493     @@@:UNSUPPORTED_OPERATOR_ERR
1494     @@enDesc:
1495     An attempt is made to overload an unknown operator.
1496    
1497     XParamDef:
1498     @QName:
1499     pc:operator
1500     @enDesc:
1501     An operator to overload.
1502    
1503     ResourceDef:
1504     @QName: operatorNameList
1505     @enDesc:
1506     The list of valid operators for <PerlModule::operator> pragma.
1507     @rdf:type:
1508     dis2pm:InlineCode
1509     @PerlDef:
1510     {qw[
1511     + 1 - 1 * 1 / 1 % 1 ** 1 << 1 >> 1 x 1 . 1
1512     += 1 -= 1 *= 1 /= 1 %= 1 **= 1 <<= 1 >>= 1 x= 1 .= 1
1513     < 1 <= 1 > 1 >= 1 == 1 != 1 <=> 1
1514     lt 1 le 1 gt 1 ge 1 eq 1 ne 1 cmp 1
1515     & 1 | 1 ^ 1 neg 1 ! 1 ~ 1
1516     ++ 1 -- 1 = 1
1517     atan2 1 cos 1 sin 1 exp 1 abs 1 log 1 sqrt 1
1518     bool 1 "" 1 0+ 1 ${} 1 @{} 1 %{} 1 &{} 1 *{} 1 <> 1
1519     nomethod 1
1520     ]}
1521    
1522 wakaba 1.1 ClsDef:
1523 wakaba 1.6 @ClsQName: ManakaiPerlStatementContainer
1524     @ClsISA: ManakaiPerlAnyContainer
1525 wakaba 1.1 @enDesc:
1526 wakaba 1.6 A base class for node types that contains zero or more
1527     statements and/or blocks.
1528 wakaba 1.1
1529     @Attr:
1530 wakaba 1.10 @@Name: sourceFile
1531     @@enDesc:
1532     The source file name of this fragment.
1533     @@Type:
1534 wakaba 1.12 DISLang:String::ManakaiDOM:all
1535 wakaba 1.10 @@Get:
1536     @@@enDesc:
1537     Any string identifying the source.
1538     @@@nullCase:
1539     @@@@enDesc: No source file name is set.
1540     @@@disDef:
1541     @@@@GetProp: sourceFile
1542     @@Set:
1543     @@@nullCase:
1544     @@@@enDesc: No (or unknown) source file.
1545     @@@disDef:
1546     @@@@SetProp: sourceFile
1547    
1548     @Attr:
1549     @@Name: sourceLine
1550     @@enDesc:
1551     Source file line number of the first line of this fragment.
1552     @@Type:
1553 wakaba 1.12 DOMMain:unsigned-long::ManakaiDOM:all
1554 wakaba 1.10 @@Get:
1555     @@@disDef:
1556     @@@@GetProp: sourceLine
1557     @@Set:
1558     @@@disDef:
1559     @@@@SetProp: sourceLine
1560    
1561     @Attr:
1562 wakaba 1.1 @@Name: currentSourceFile
1563     @@enDesc:
1564     The current source file name that is referred when
1565     a code fragment is added.
1566     @@Type:
1567 wakaba 1.12 DISLang:String::ManakaiDOM:all
1568 wakaba 1.1 @@Get:
1569     @@@nullCase:
1570     @@@@enDesc: No source file name is set.
1571     @@@disDef:
1572 wakaba 1.10 @@@@GetProp:currentSourceFile
1573 wakaba 1.1 @@Set:
1574     @@@nullCase:
1575     @@@@enDesc: No (or unknown) source file.
1576     @@@disDef:
1577 wakaba 1.10 @@@@SetProp:currentSourceFile
1578 wakaba 1.1
1579     @Attr:
1580     @@Name: currentSourceLine
1581     @@enDesc:
1582     The current line number in source file that is referred when
1583     a code fragment is added.
1584     @@Type:
1585 wakaba 1.6 DOMMain:unsigned-long::ManakaiDOM:all
1586 wakaba 1.1 @@Get:
1587     @@@disDef:
1588 wakaba 1.10 @@@@GetProp:currentSourceLine
1589 wakaba 1.1 @@Set:
1590     @@@disDef:
1591 wakaba 1.10 @@@@SetProp:currentSourceLine
1592 wakaba 1.1
1593     @Method:
1594 wakaba 1.5 @@Name: appendCodeFragment
1595     @@enDesc:
1596     Appends a <Class::ManakaiPerlCodeFragment> object.
1597     @@Param:
1598     @@@Name: codeArg
1599     @@@Type: ManakaiPerlCodeFragment
1600     @@@enDesc:
1601     A code fragment object.
1602     @@Return:
1603     @@@RaiseException:
1604     @@@@@:BAD_CHILD_ERR
1605     @@@@enDesc:
1606     An attempt is made to append a child
1607     that is not a <Class::ManakaiPerlUnparsedCode>.
1608     @@@RaiseException:
1609     @@@@@:IN_USE_NODE_ERR
1610     @@@@enDesc:
1611     An attempt is made to append a node that is
1612     already used elsewhere.
1613     @@@PerlDef:
1614 wakaba 1.6 if ({
1615     unparsed => 1, if => 1, statement => 1, block => 1,
1616 wakaba 1.9 blockcontainer => true,
1617 wakaba 1.6 inunparsed => 1, variable => 1, bare => 1, atom => 1,
1618     incontainer => 1, string => 1, assign => 1,
1619     }->{$codeArg->{<Q::TreeCore:node>}->{<Q::pc:nodeType>}}) {
1620 wakaba 1.5 if ($codeArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
1621     __EXCEPTION{IN_USE_NODE_ERR::
1622     pc:childNode => {$codeArg},
1623     }__;
1624     }
1625     $self->{<Q::TreeCore:node>}-><M::MNodeObject.importTree>
1626     ($codeArg->{<Q::TreeCore:node>});
1627     push @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}},
1628     $codeArg->{<Q::TreeCore:node>};
1629     $codeArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}
1630     = $self->{<Q::TreeCore:node>};
1631     } else {
1632     __EXCEPTION{BAD_CHILD_ERR::
1633     pc:parentNode => {$self},
1634     pc:childNode => {$codeArg},
1635     }__;
1636     }
1637    
1638     @Method:
1639 wakaba 1.1 @@Name: appendCode
1640     @@enDesc:
1641     Appends an unparsed Perl code fragment.
1642     @@Param:
1643     @@@Name: codeArg
1644     @@@Type:
1645     lang:Perl::ManakaiDOM:all
1646     @@@enDesc:
1647     An unparsed Perl code fragment.
1648     @@Return:
1649     @@@Type: ManakaiPerlUnparsedCode
1650     @@@enDesc:
1651     The newly created Perl code object.
1652     @@@PerlDef:
1653     $r = <ClassM::ManakaiPerlUnparsedCode.newObject>;
1654     my $node = $self->{<Q::TreeCore:node>};
1655 wakaba 1.10 $r->{<Q::sourceFile>} = $node->{<Q::pc:currentSourceFile>};
1656     $r->{<Q::sourceLine>} = $node->{<Q::pc:currentSourceLine>};
1657 wakaba 1.1 $r->{<Q::code>} = $codeArg;
1658 wakaba 1.10 $node->{<Q::pc:currentSourceLine>} += ($codeArg =~ tr/\x0A/\x0A/);
1659 wakaba 1.6 $node-><M::ManakaiDOM:ManakaiDOMNodeObject
1660     ::ManakaiDOM:Perl.importTree> ($r);
1661     push @{$node->{<Q::pc:childNodes>}}, $r;
1662     $r->{<Q::pc:parent>} = $node;
1663     __CODE{ManakaiNode:getNewReference::
1664     $object => $r, $ref => $r,
1665     $class =>{<ClassName::ManakaiPerlUnparsedCode>},
1666     }__;
1667 wakaba 1.1
1668     @Method:
1669     @@Name: skipLines
1670     @@enDesc:
1671     Skips lines in a code.
1672     @@Param:
1673     @@@Name: codeArg
1674     @@@Type:
1675     lang:Perl::ManakaiDOM:all
1676     @@@enDesc:
1677     A code fragment, which is counted lines.
1678     @@Return:
1679     @@@PerlDef:
1680 wakaba 1.10 $self->{<Q::TreeCore:node>}->{<Q::pc:currentSourceLine>}
1681 wakaba 1.1 += ($codeArg =~ tr/\x0A/\x0A/);
1682 wakaba 1.4
1683 wakaba 1.6 @ImplNote:
1684     @@lang:en
1685     @@@:
1686     A <Class::ManakaiPerlStatementContainer> object must have
1687     a property:
1688     <Q::pc:childNodes>.
1689 wakaba 1.8
1690     @Attr:
1691     @@Name: label
1692     @@enDesc:
1693     Label for this block.
1694     @@Type:
1695     DISLang:String::ManakaiDOM:all
1696     @@Get:
1697     @@@nullCase:
1698     @@@@enDesc:
1699     No label.
1700     @@@disDef:
1701     @@@@GetProp:label
1702     @@Set:
1703     @@@nullCase:
1704     @@@@enDesc:
1705     No label.
1706     @@@disDef:
1707     @@@@SetProp:label
1708    
1709     @Method:
1710     @@Name: appendBlock
1711     @@enDesc:
1712     Appends a Perl block code.
1713     @@Return:
1714     @@@Type: ManakaiPerlBlock
1715     @@@enDesc:
1716     The newly created Perl code object.
1717     @@@PerlDef:
1718     $r = <ClassM::ManakaiPerlBlock.newObject>;
1719     my $node = $self->{<Q::TreeCore:node>};
1720     $node-><M::ManakaiDOM:ManakaiDOMNodeObject
1721     ::ManakaiDOM:Perl.importTree> ($r);
1722     push @{$node->{<Q::pc:childNodes>}}, $r;
1723     $r->{<Q::pc:parent>} = $node;
1724     if (defined wantarray) {
1725     __CODE{ManakaiNode:getNewReference::
1726     $object => $r, $ref => $r,
1727     $class =>{<ClassName::ManakaiPerlBlock>},
1728     }__;
1729     }
1730    
1731     @Method:
1732     @@Name: appendStatement
1733     @@enDesc:
1734     Appends a Perl statement.
1735     @@Param:
1736     @@@Name: codeArg
1737     @@@Type:
1738     lang:Perl::ManakaiDOM:all
1739     @@@enDesc:
1740     A Perl statement without terminating <Perl::;>.
1741     @@@nullCase:
1742     @@@@enDesc:
1743     No initial content.
1744     @@Return:
1745     @@@Type: ManakaiPerlStatement
1746     @@@enDesc:
1747     The newly created Perl code object.
1748     @@@PerlDef:
1749     $r = <ClassM::ManakaiPerlStatement.newObject>;
1750     my $node = $self->{<Q::TreeCore:node>};
1751     $node-><M::ManakaiDOM:ManakaiDOMNodeObject
1752     ::ManakaiDOM:Perl.importTree> ($r);
1753     push @{$node->{<Q::pc:childNodes>}}, $r;
1754     $r->{<Q::pc:parent>} = $node;
1755     if (defined wantarray or defined $codeArg) {
1756     __CODE{ManakaiNode:getNewReference::
1757     $object => $r, $ref => $r,
1758     $class =>{<ClassName::ManakaiPerlStatement>},
1759     }__;
1760     if (defined $codeArg) {
1761     __DEEP{
1762     $r-><M::ManakaiPerlAnyContainer.appendBare> ($codeArg);
1763     }__;
1764     }
1765     }
1766 wakaba 1.12
1767     @Method:
1768     @@Name: appendNewIf
1769     @@enDesc:
1770     Appends a newly created <Class::ManakaiPerlIf> object.
1771     @@Param:
1772     @@@Name: conditionArg
1773     @@@Type: ManakaiPerlCodeFragment
1774     @@@enDesc:
1775     Conditoon code fragment object.
1776     @@Param:
1777     @@@Name: trueArg
1778     @@@Type: ManakaiPerlCodeFragment
1779     @@@enDesc:
1780     A true code fragment object.
1781     @@@nullCase:
1782     @@@@enDesc: No true code.
1783     @@Param:
1784     @@@Name: falseArg
1785     @@@Type: ManakaiPerlCodeFragment
1786     @@@enDesc:
1787     A false code fragment object.
1788     @@@nullCase:
1789     @@@@enDesc: No false code.
1790     @@Return:
1791     @@@RaiseException:
1792     @@@@@:BAD_CHILD_ERR
1793     @@@@enDesc:
1794     An attempt is made to append a child
1795     that is not valid type.
1796     @@@RaiseException:
1797     @@@@@:IN_USE_NODE_ERR
1798     @@@@enDesc:
1799     An attempt is made to append a node that is
1800     already used elsewhere.
1801     @@@PerlDef:
1802     for my $arg ([conditionArg => $conditionArg]) {
1803     if ({
1804     atom => 1, bare => 1, incontainer => 1, assign => true,
1805     inunparsed => 1, variable => 1, string => true,
1806     }->{$arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:nodeType>}}) {
1807     if ($arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
1808     __EXCEPTION{IN_USE_NODE_ERR::
1809     pc:childNode => {$arg->[1]},
1810     MDOMX:param-name => {$arg->[0]},
1811     }__;
1812     }
1813     } else {
1814     __EXCEPTION{BAD_CHILD_ERR::
1815     pc:parentNode => {$self},
1816     pc:childNode => {$arg->[1]},
1817     MDOMX:param-name => {$arg->[0]},
1818     }__;
1819     }
1820     } # c
1821    
1822     for my $arg ([trueArg => $trueArg],
1823     [falseArg => $falseArg]) {
1824     next unless $arg->[1];
1825     if ({
1826     blockcontainer => true,
1827     }->{$arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:nodeType>}}) {
1828     if ($arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
1829     __EXCEPTION{IN_USE_NODE_ERR::
1830     pc:childNode => {$arg->[1]},
1831     MDOMX:param-name => {$arg->[0]},
1832     }__;
1833     }
1834     } else {
1835     __EXCEPTION{BAD_CHILD_ERR::
1836     pc:parentNode => {$self},
1837     pc:childNode => {$arg->[1]},
1838     MDOMX:param-name => {$arg->[0]},
1839     }__;
1840     }
1841     } # t/f
1842    
1843     my $assign = <ClassM::ManakaiPerlIf.newObject>;
1844     $assign->{<Q::pc:condition>} = $conditionArg->{<Q::TreeCore:node>};
1845     $assign->{<Q::pc:true>} = $trueArg->{<Q::TreeCore:node>} if $trueArg;
1846     $assign->{<Q::pc:false>} = $falseArg->{<Q::TreeCore:node>} if $falseArg;
1847     $conditionArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign;
1848     $trueArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign if $trueArg;
1849     $falseArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign if $falseArg;
1850     $self->{<Q::TreeCore:node>}-><M::MNodeObject.importTree> ($assign);
1851     $assign->{<Q::pc:parent>} = $self->{<Q::TreeCore:node>};
1852     push @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}}, $assign;
1853 wakaba 1.6 ##PerlStatementContainer
1854    
1855     ClsDef:
1856     @ClsQName: ManakaiPerlSub
1857     @ClsISA: ManakaiPerlStatementContainer
1858     @enDesc:
1859     Perl subroutines.
1860    
1861     @IntMethod:
1862     @@Name:newObject
1863     @@ManakaiDOM:isStatic:1
1864     @@Description:
1865     @@@lang:en
1866     @@@@:
1867     Creates a new instance object for <Class::ManakaiPerlSub>.
1868     @@Return:
1869     @@@Type:
1870     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
1871     @@@Description:
1872     @@@@lang:en
1873     @@@@@:
1874     The newly created node object.
1875     @@@PerlDef:
1876     @@@@@:
1877     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
1878     ::ManakaiDOM:Perl.new>;
1879     push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
1880     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
1881     $node->{<Q::pc:childNodes>} = [];
1882     $node->{<Q::pc:sourceLine>} = 0;
1883     $node->{<Q::pc:nodeType>} = 'sub';
1884     @@@@ImplNote:
1885     @@@@@lang:en
1886     @@@@@@:
1887 wakaba 1.22 Optional properties: <Q::pc:localName>, <Q::pc:useCharClassName>,
1888 wakaba 1.6 <Q::pc:sourceFile>, <Q::pc:sourceLine>,
1889 wakaba 1.14 <Q::pc:nodeType>, <Q::pc:useModuleName>,
1890 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
1891 wakaba 1.6
1892 wakaba 1.20 @IntCloneMethod:
1893     @@Return:
1894     @@@Type:
1895     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
1896     @@@PerlDef:
1897     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
1898     ::ManakaiDOM:Perl.new>;
1899     $node->{<Q::pc:nodeType>} = 'sub';
1900     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
1901     push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
1902     for my $prop (<Q::pc:sourceFile>, <Q::pc:sourceLine>) {
1903     $node->{$prop} = $nodeObject->{$prop};
1904     }
1905     $node->{<Q::pc:requireResourceURI>}
1906     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
1907     $node->{<Q::pc:useModuleName>}
1908     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
1909 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
1910     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
1911     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
1912 wakaba 1.20 $node->{<Q::pc:requireModuleName>}
1913     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
1914     $node->{<Q::pc:childNodes>} = [];
1915     for my $cno (@{$nodeObject->{<Q::pc:childNodes>}}) {
1916     my $pack;
1917     my $nt = $cno->{<Q::pc:nodeType>};
1918     __CODE{pc:nodeTypeToPackageName::
1919     $nodeType => $nt, $packageName => $pack, $object => $cno}__;
1920     ## NOTE: Method name written directly
1921     my $cno_clone = $pack->_make_clone_object ($cno);
1922     push @{$node->{<Q::pc:childNodes>}}, $cno_clone;
1923     $cno_clone->{<Q::pc:parent>} = $node;
1924     ## NOTE: Tree ID is not updated yet.
1925     }
1926    
1927 wakaba 1.6 @Attr:
1928     @@Name: localName
1929     @@enDesc:
1930     The name of this subroutine.
1931     @@Type:
1932 wakaba 1.12 DISPerl:SubName::ManakaiDOM:all
1933 wakaba 1.6 @@Get:
1934     @@@nullCase:
1935     @@@@enDesc:
1936     This subroutine has no name.
1937     @@@disDef:
1938     @@@@GetProp: localName
1939     @@Set:
1940     @@@enDesc:
1941     Sets the name of this subroutine.
1942     \
1943     {NOTE:: Setting this attribute does not change the
1944     name by which the subroutine is registerred to
1945     the parent object.
1946     \
1947     }
1948     @@@nullCase:
1949     @@@@enDesc:
1950     This subroutine has no name.
1951     @@@disDef:
1952     @@@@SetProp: localName
1953    
1954     @Attr:
1955     @@Name: prototype
1956     @@enDesc:
1957     The prototype of this subroutine.
1958     @@Type:
1959 wakaba 1.11 DISPerl:SubPrototype::ManakaiDOM:all
1960 wakaba 1.6 @@Get:
1961     @@@disDef:
1962     @@@@GetProp: prototype
1963     @@@nullCase:
1964     @@@@enDesc:
1965     No prototype is set.
1966     @@Set:
1967     @@@disDef:
1968     @@@@SetProp: prototype
1969     @@@nullCase:
1970     @@@@enDesc:
1971     No prototype declaration.
1972    
1973 wakaba 1.4 @ToStringMethod:
1974     @@Return:
1975     @@@Type:
1976 wakaba 1.11 DISLang:String::ManakaiDOM:all
1977 wakaba 1.4 @@@enDesc:
1978     Perl code.
1979     @@@PerlDef:
1980     my $node = $self->{<Q::TreeCore:node>};
1981     $r = q<sub>;
1982     $r .= ' ' . $node->{<Q::pc:localName>}
1983     if defined $node->{<Q::pc:localName>};
1984     $r .= ' (' . $node->{<Q::pc:prototype>} . ')'
1985     if defined $node->{<Q::pc:prototype>};
1986     $r .= " {\n";
1987 wakaba 1.6 for my $cno (@{$node->{<Q::pc:childNodes>}}) {
1988 wakaba 1.7 my $cn = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($cno);
1989 wakaba 1.6 $r .= $cn->stringify;
1990     }
1991 wakaba 1.4 $r .= "}\n";
1992 wakaba 1.14
1993     @NumValMethod:
1994     @@Return:
1995     @@@Type:
1996     DISIDL:AnyRealNumber::ManakaiDOM:all
1997     @@@PerlDef:
1998     my $cno = $self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}->[-1];
1999     if ($cno) {
2000     my $cn = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($cno);
2001     $r = 0 + $cn;
2002     }
2003    
2004 wakaba 1.1 ##PerlSub
2005    
2006 wakaba 1.5 XParamDef:
2007     @QName: parentNode
2008     @enDesc:
2009     Parent node.
2010    
2011     XParamDef:
2012     @QName: childNode
2013     @enDesc:
2014     Child node.
2015    
2016 wakaba 1.1 ClsDef:
2017     @ClsQName: ManakaiPerlUnparsedCode
2018     @ClsISA: ManakaiPerlCodeFragment
2019     @enDesc:
2020     Unparsed Perl code fragments.
2021    
2022     @IntMethod:
2023     @@Name:newObject
2024     @@ManakaiDOM:isStatic:1
2025     @@Description:
2026     @@@lang:en
2027     @@@@:
2028     Creates a new instance object for <Class::ManakaiPerlUnparsedCode>.
2029     @@Return:
2030     @@@Type:
2031     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2032     @@@Description:
2033     @@@@lang:en
2034     @@@@@:
2035     The newly created node object.
2036     @@@PerlDef:
2037     @@@@@:
2038     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2039     ::ManakaiDOM:Perl.new>;
2040     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2041     $node->{<Q::pc:code>} = '';
2042 wakaba 1.6 $node->{<Q::pc:nodeType>} = 'unparsed';
2043 wakaba 1.1 @@@@ImplNote:
2044     @@@@@lang:en
2045     @@@@@@:
2046 wakaba 1.9 Properties: <Q::pc:nodeType>, <Q::pc:code>,
2047 wakaba 1.14 <Q::pc:sourceFile>, <Q::pc:sourceLine>,
2048 wakaba 1.22 <Q::pc:useModuleName>, <Q::pc:useCharClassName>,
2049 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2050 wakaba 1.9
2051     @IntCloneMethod:
2052     @@Return:
2053     @@@Type:
2054     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2055     @@@PerlDef:
2056     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2057     ::ManakaiDOM:Perl.new>;
2058     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2059     for my $prop (<Q::pc:sourceFile>, <Q::pc:sourceLine>, <Q::pc:code>) {
2060     $node->{$prop} = $nodeObject->{$prop};
2061     }
2062     $node->{<Q::pc:nodeType>} = 'unparsed';
2063 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2064     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2065     $node->{<Q::pc:useModuleName>}
2066     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2067 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2068     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2069     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2070 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2071     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2072 wakaba 1.5
2073     @Attr:
2074     @@Name: code
2075     @@enDesc:
2076     Perl code.
2077     @@Type:
2078     lang:Perl::ManakaiDOM:all
2079     @@Get:
2080     @@@disDef:
2081     @@@@GetProp: code
2082     @@Set:
2083     @@@disDef:
2084     @@@@SetProp: code
2085    
2086     @Attr:
2087     @@Name: sourceFile
2088     @@enDesc:
2089     The source file name of this fragment.
2090     @@Type:
2091 wakaba 1.12 DISLang:String::ManakaiDOM:all
2092 wakaba 1.5 @@Get:
2093     @@@enDesc:
2094     Any string identifying the source.
2095     @@@nullCase:
2096     @@@@enDesc: No source file name is set.
2097     @@@disDef:
2098     @@@@GetProp: sourceFile
2099     @@Set:
2100     @@@nullCase:
2101     @@@@enDesc: No (or unknown) source file.
2102     @@@disDef:
2103     @@@@SetProp: sourceFile
2104    
2105     @Attr:
2106     @@Name: sourceLine
2107     @@enDesc:
2108     Source file line number of the first line of this fragment.
2109     @@Type:
2110 wakaba 1.12 DOMMain:unsigned-long::ManakaiDOM:all
2111 wakaba 1.5 @@Get:
2112     @@@disDef:
2113     @@@@GetProp: sourceLine
2114     @@Set:
2115     @@@disDef:
2116     @@@@SetProp: sourceLine
2117 wakaba 1.6
2118     @ToStringMethod:
2119     @@Return:
2120     @@@Type:
2121 wakaba 1.12 DISLang:String::ManakaiDOM:all
2122 wakaba 1.6 @@@enDesc:
2123     Perl code.
2124     @@@PerlDef:
2125     my $node = $self->{<Q::TreeCore:node>};
2126     __DEEP{
2127     my $file = $self-><AG::ManakaiPerlCodeFragment.fileNode>;
2128 wakaba 1.19 $r = sprintf (qq<\n#line %d "%s [u] (Chunk #%d)"\n>,
2129 wakaba 1.10 $node->{<Q::pc:sourceLine>} || 1,
2130     $node->{<Q::pc:sourceFile>} ||
2131     $file-><AG::ManakaiPerlFile.sourceFile>,
2132 wakaba 1.6 $file-><M::ManakaiPerlFile.getNextChunkNumber>)
2133     . $node->{<Q::pc:code>}
2134 wakaba 1.19 . sprintf (qq<\n#line 1 "%s [/u] (Chunk #%d)"\n>,
2135 wakaba 1.6 $file-><AG::ManakaiPerlFile.sourceFile>,
2136     $file-><M::ManakaiPerlFile.getNextChunkNumber>);
2137     }__;
2138 wakaba 1.1 ##PerlUnparsedCode
2139    
2140     ClsDef:
2141 wakaba 1.6 @ClsQName: ManakaiPerlInlineUnparsedCode
2142     @ClsISA: ManakaiPerlCodeFragment
2143     @enDesc:
2144     Unparsed Perl inline code fragments.
2145    
2146     @IntMethod:
2147     @@Name:newObject
2148     @@ManakaiDOM:isStatic:1
2149     @@Description:
2150     @@@lang:en
2151     @@@@:
2152     Creates a new instance object for
2153     <Class::ManakaiPerlInlineUnparsedCode>.
2154     @@Return:
2155     @@@Type:
2156     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2157     @@@Description:
2158     @@@@lang:en
2159     @@@@@:
2160     The newly created node object.
2161     @@@PerlDef:
2162     @@@@@:
2163     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2164     ::ManakaiDOM:Perl.new>;
2165     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2166     $node->{<Q::pc:code>} = '';
2167     $node->{<Q::pc:nodeType>} = 'inunparsed';
2168     @@@@ImplNote:
2169     @@@@@lang:en
2170     @@@@@@:
2171 wakaba 1.14 Properties: <Q::pc:nodeType>, <Q::pc:code>, <Q::pc:useModuleName>,
2172 wakaba 1.22 <Q::pc:useCharClassName>,
2173 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2174 wakaba 1.6
2175 wakaba 1.9 @IntCloneMethod:
2176     @@Return:
2177     @@@Type:
2178     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2179     @@@PerlDef:
2180     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2181     ::ManakaiDOM:Perl.new>;
2182     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2183     for my $prop (<Q::pc:code>) {
2184     $node->{$prop} = $nodeObject->{$prop};
2185     }
2186     $node->{<Q::pc:nodeType>} = 'inunparsed';
2187 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2188     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2189     $node->{<Q::pc:useModuleName>}
2190     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2191 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2192     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2193     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2194 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2195     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2196 wakaba 1.9
2197 wakaba 1.6 @Attr:
2198     @@Name: code
2199     @@enDesc:
2200     Perl code.
2201     @@Type:
2202     lang:Perl::ManakaiDOM:all
2203     @@Get:
2204     @@@disDef:
2205     @@@@GetProp: code
2206     @@Set:
2207     @@@disDef:
2208     @@@@SetProp: code
2209    
2210     @ToStringMethod:
2211     @@Return:
2212     @@@Type:
2213 wakaba 1.12 DISLang:String::ManakaiDOM:all
2214 wakaba 1.6 @@@enDesc:
2215     Perl code.
2216     @@@PerlDef:
2217     my $node = $self->{<Q::TreeCore:node>};
2218     $r = $node->{<Q::pc:code>};
2219     ##PerlInlineUnparsedCode
2220    
2221     ClsDef:
2222     @ClsQName: ManakaiPerlStringLiteral
2223     @ClsISA: ManakaiPerlCodeFragment
2224     @enDesc:
2225     Perl string literal.
2226    
2227     @IntMethod:
2228     @@Name:newObject
2229     @@ManakaiDOM:isStatic:1
2230     @@Description:
2231     @@@lang:en
2232     @@@@:
2233     Creates a new instance object for
2234     <Class::ManakaiPerlStringLiteral>.
2235     @@Return:
2236     @@@Type:
2237     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2238     @@@Description:
2239     @@@@lang:en
2240     @@@@@:
2241     The newly created node object.
2242     @@@PerlDef:
2243     @@@@@:
2244     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2245     ::ManakaiDOM:Perl.new>;
2246     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2247     $node->{<Q::infoset:data>} = '';
2248     $node->{<Q::pc:nodeType>} = 'string';
2249     @@@@ImplNote:
2250     @@@@@lang:en
2251     @@@@@@:
2252 wakaba 1.22 Properties: <Q::pc:nodeType>, <Q::pc:useCharClassName>,
2253 wakaba 1.14 <Q::infoset:data>, <Q::pc:useModuleName>,
2254 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2255 wakaba 1.6
2256 wakaba 1.9 @IntCloneMethod:
2257     @@Return:
2258     @@@Type:
2259     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2260     @@@PerlDef:
2261     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2262     ::ManakaiDOM:Perl.new>;
2263     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2264     for my $prop (<Q::infoset:data>) {
2265     $node->{$prop} = $nodeObject->{$prop};
2266     }
2267     $node->{<Q::pc:nodeType>} = 'string';
2268 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2269     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2270     $node->{<Q::pc:useModuleName>}
2271     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2272 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2273     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2274     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2275 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2276     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2277 wakaba 1.9
2278 wakaba 1.6 @Attr:
2279     @@Name: data
2280     @@enDesc:
2281     String data.
2282     @@Type:
2283     DISLang:String::ManakaiDOM:all
2284     @@Get:
2285     @@@disDef:
2286     @@@@GetProp:
2287     infoset:data
2288     @@Set:
2289     @@@disDef:
2290     @@@@SetProp:
2291     infoset:data
2292    
2293 wakaba 1.14 @NumValMethod:
2294     @@Return:
2295     @@@Type:
2296     DISIDL:AnyRealNumber::ManakaiDOM:all
2297     @@@enDesc:
2298     Numeric value of the Perl code.
2299     @@@PerlDef:
2300     $r = 0 + $self->{<Q::TreeCore:node>}->{<Q::infoset:data>};
2301    
2302 wakaba 1.6 @ToStringMethod:
2303     @@Return:
2304     @@@Type:
2305 wakaba 1.12 DISLang:String::ManakaiDOM:all
2306 wakaba 1.6 @@@enDesc:
2307     Perl code.
2308     @@@PerlDef:
2309     my $node = $self->{<Q::TreeCore:node>};
2310     $r = $node->{<Q::infoset:data>};
2311     $r =~ s/(['\\])/\\$1/g;
2312     $r = q<'> . $r . q<'>;
2313     ##PerlStringLiteral
2314    
2315 wakaba 1.12 ## TODO: -> Separate module
2316     PropDef:
2317     @QName:
2318     infoset:data
2319    
2320 wakaba 1.6 ClsDef:
2321     @ClsQName: ManakaiPerlBare
2322     @ClsISA: ManakaiPerlCodeFragment
2323     @enDesc:
2324     Unparsed Perl inline code fragments.
2325    
2326     @IntMethod:
2327     @@Name:newObject
2328     @@ManakaiDOM:isStatic:1
2329     @@Description:
2330     @@@lang:en
2331     @@@@:
2332     Creates a new instance object for
2333     <Class::ManakaiPerlInlineBare>.
2334     @@Return:
2335     @@@Type:
2336     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2337     @@@Description:
2338     @@@@lang:en
2339     @@@@@:
2340     The newly created node object.
2341     @@@PerlDef:
2342     @@@@@:
2343     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2344     ::ManakaiDOM:Perl.new>;
2345     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2346     $node->{<Q::pc:code>} = '';
2347     $node->{<Q::pc:nodeType>} = 'bare';
2348     @@@@ImplNote:
2349     @@@@@lang:en
2350     @@@@@@:
2351 wakaba 1.14 Properties: <Q::pc:nodeType>, <Q::pc:code>, <Q::pc:useModuleName>,
2352 wakaba 1.22 <Q::pc:useCharClassName>,
2353 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2354 wakaba 1.6
2355 wakaba 1.9 @IntCloneMethod:
2356     @@Return:
2357     @@@Type:
2358     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2359     @@@PerlDef:
2360     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2361     ::ManakaiDOM:Perl.new>;
2362     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2363     for my $prop (<Q::pc:code>) {
2364     $node->{$prop} = $nodeObject->{$prop};
2365     }
2366     $node->{<Q::pc:nodeType>} = 'bare';
2367 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2368     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2369     $node->{<Q::pc:useModuleName>}
2370     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2371 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2372     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2373     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2374 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2375     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2376 wakaba 1.9
2377 wakaba 1.6 @Attr:
2378     @@Name: code
2379     @@enDesc:
2380     Perl code.
2381     @@Type:
2382     lang:Perl::ManakaiDOM:all
2383     @@Get:
2384     @@@disDef:
2385     @@@@GetProp: code
2386     @@Set:
2387     @@@disDef:
2388     @@@@SetProp: code
2389    
2390     @ToStringMethod:
2391     @@Return:
2392     @@@Type:
2393 wakaba 1.12 DISLang:String::ManakaiDOM:all
2394 wakaba 1.6 @@@enDesc:
2395     Perl code.
2396     @@@PerlDef:
2397     my $node = $self->{<Q::TreeCore:node>};
2398     $r = $node->{<Q::pc:code>};
2399     ##PerlBare
2400    
2401     ClsDef:
2402     @ClsQName: ManakaiPerlAtom
2403     @ClsISA: ManakaiPerlBare
2404     @enDesc:
2405     Unparsed Perl atomic code fragments (such as numeric literal).
2406    
2407     @IntMethod:
2408     @@Name:newObject
2409     @@ManakaiDOM:isStatic:1
2410     @@Description:
2411     @@@lang:en
2412     @@@@:
2413     Creates a new instance object for
2414     <Class::ManakaiPerlAtom>.
2415     @@Return:
2416     @@@Type:
2417     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2418     @@@Description:
2419     @@@@lang:en
2420     @@@@@:
2421     The newly created node object.
2422     @@@PerlDef:
2423     @@@@@:
2424     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2425     ::ManakaiDOM:Perl.new>;
2426     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2427     $node->{<Q::pc:code>} = '';
2428     $node->{<Q::pc:nodeType>} = 'atom';
2429     @@@@ImplNote:
2430     @@@@@lang:en
2431     @@@@@@:
2432 wakaba 1.14 Properties: <Q::pc:nodeType>, <Q::pc:code>, <Q::pc:useModuleName>,
2433 wakaba 1.22 <Q::pc:useCharClassName>,
2434 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2435 wakaba 1.6
2436 wakaba 1.9 @IntCloneMethod:
2437     @@Return:
2438     @@@Type:
2439     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2440     @@@PerlDef:
2441     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2442     ::ManakaiDOM:Perl.new>;
2443     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2444     for my $prop (<Q::pc:code>) {
2445     $node->{$prop} = $nodeObject->{$prop};
2446     }
2447     $node->{<Q::pc:nodeType>} = 'atom';
2448 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2449     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2450     $node->{<Q::pc:useModuleName>}
2451     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2452 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2453     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2454     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2455 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2456     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2457 wakaba 1.14
2458     @NumValMethod:
2459     @@Return:
2460     @@@Type:
2461     DISIDL:AnyRealNumber::ManakaiDOM:all
2462     @@@enDesc:
2463     Numeric value of the Perl code.
2464     @@@PerlDef:
2465     $r = 0 + $self->{<Q::TreeCore:node>}->{<Q::pc:code>};
2466 wakaba 1.9
2467 wakaba 1.6 @ToStringMethod:
2468     @@Return:
2469     @@@Type:
2470 wakaba 1.12 DISLang:String::ManakaiDOM:all
2471 wakaba 1.6 @@@enDesc:
2472     Perl code.
2473     @@@PerlDef:
2474     my $node = $self->{<Q::TreeCore:node>};
2475     $r = $node->{<Q::pc:code>};
2476     ##PerlAtom
2477    
2478     ClsDef:
2479     @ClsQName: ManakaiPerlVariable
2480     @ClsISA: ManakaiPerlCodeFragment
2481     @enDesc:
2482     Unparsed Perl variable.
2483     \
2484     {NOTE:: Future version of the implementation may
2485     support to specify array index or hash key.
2486     \
2487     }
2488    
2489     @IntMethod:
2490     @@Name:newObject
2491     @@ManakaiDOM:isStatic:1
2492     @@Description:
2493     @@@lang:en
2494     @@@@:
2495     Creates a new instance object for
2496     <Class::ManakaiPerlVariable>.
2497     @@Return:
2498     @@@Type:
2499     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2500     @@@Description:
2501     @@@@lang:en
2502     @@@@@:
2503     The newly created node object.
2504     @@@PerlDef:
2505     @@@@@:
2506     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2507     ::ManakaiDOM:Perl.new>;
2508     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2509     $node->{<Q::pc:variableType>} = '';
2510     $node->{<Q::pc:nodeType>} = 'variable';
2511     @@@@ImplNote:
2512     @@@@@lang:en
2513     @@@@@@:
2514     Properties: <Q::pc:nodeType>, <Q::pc:variableType>,
2515     <Q::packageName>, <Q::localName> (required),
2516 wakaba 1.22 <Q::pc:useCharClassName>,
2517 wakaba 1.14 <Q::variableScope>, <Q::hashKey>, <Q::pc:useModuleName>,
2518 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2519 wakaba 1.9
2520     @IntCloneMethod:
2521     @@Return:
2522     @@@Type:
2523     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2524     @@@PerlDef:
2525     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2526     ::ManakaiDOM:Perl.new>;
2527     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2528     for my $prop (<Q::pc:variableType>, <Q::packageName>,
2529     <Q::localName>, <Q::variableScope>, <Q::hashKey>) {
2530     $node->{$prop} = $nodeObject->{$prop};
2531     }
2532     $node->{<Q::pc:nodeType>} = 'variable';
2533 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2534     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2535     $node->{<Q::pc:useModuleName>}
2536     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2537 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2538     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2539     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2540 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2541     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2542 wakaba 1.6
2543     @Attr:
2544     @@Name: variableType
2545     @@enDesc:
2546     Perl variable type (<CODE::$>, <CODE::@>, <CODE::%>,
2547     <CODE::&> or empty string).
2548     @@Type:
2549     lang:Perl::ManakaiDOM:all
2550     @@Get:
2551     @@@disDef:
2552     @@@@GetProp: variableType
2553     @@Set:
2554     @@@disDef:
2555     @@@@SetProp: variableType
2556    
2557     @Attr:
2558     @@Name: packageName
2559     @@enDesc:
2560     The name of the package to which this variable belongs.
2561     @@Type:
2562     Perl:package-name::ManakaiDOM:all
2563     @@Get:
2564     @@@nullCase:
2565     @@@@enDesc:
2566     This package belongs to the current package or
2567     does not belong to any package.
2568     @@@disDef:
2569     @@@@GetProp: packageName
2570     @@Set:
2571     @@@nullCase:
2572     @@@@enDesc:
2573     This package belongs to the current package or
2574     does not belong to any package.
2575     @@@disDef:
2576 wakaba 1.11 @@@@SetProp: packageName
2577 wakaba 1.6
2578     @Attr:
2579     @@Name: localName
2580     @@enDesc:
2581     The local variable name.
2582     @@Type:
2583     lang:Perl::ManakaiDOM:all
2584     @@Get:
2585     @@@disDef:
2586     @@@@GetProp: localName
2587     @@Set:
2588     @@@disDef:
2589     @@@@SetProp: localName
2590    
2591     @Attr:
2592     @@Name: variableScope
2593     @@enDesc:
2594     Scope modifier (<CODE::my> or <CODE::our> or <CODE::local>).
2595     @@Type:
2596     lang:Perl::ManakaiDOM:all
2597     @@Get:
2598     @@@nullCase:
2599     @@@@enDesc:
2600     This variable does not have scope modifier.
2601     @@@disDef:
2602     @@@@GetProp: variableScope
2603     @@Set:
2604     @@@nullCase:
2605     @@@@enDesc:
2606     This variable does not have scope modifier.
2607     @@@disDef:
2608     @@@@SetProp: variableScope
2609    
2610     @ToStringMethod:
2611     @@Return:
2612     @@@Type:
2613 wakaba 1.12 DISLang:String::ManakaiDOM:all
2614 wakaba 1.6 @@@enDesc:
2615     Perl code.
2616     @@@PerlDef:
2617     my $node = $self->{<Q::TreeCore:node>};
2618 wakaba 1.11 if ($node->{<Q::pc:variableScope>}) {
2619     $r = $node->{<Q::pc:variableScope>} . ' ';
2620     }
2621     $r .= $node->{<Q::pc:variableType>};
2622 wakaba 1.6 $r .= $node->{<Q::pc:packageName>} . '::'
2623     if defined $node->{<Q::pc:packageName>};
2624     $r .= $node->{<Q::pc:localName>};
2625     if ($node->{<Q::pc:variableType>} eq '$' and
2626     defined $node->{<Q::pc:hashKey>}) {
2627     my $hashKey = $node->{<Q::pc:hashKey>};
2628     $hashKey =~ s/(['\\])/\\$1/g;
2629     $r .= q<{'> . $hashKey . q<'}>;
2630     }
2631    
2632     @Attr:
2633     @@Name: hashKey
2634     @@enDesc:
2635     The key for hash.
2636     \
2637     {NOTE:: Using Perl code for key is not supported in the current
2638     version of the implementation.
2639     \
2640     }
2641     @@Type:
2642     DISLang:String::ManakaiDOM:all
2643     @@Get:
2644     @@@nullCase:
2645     @@@@enDesc:
2646     This variable is not for hash value access.
2647     @@@disDef:
2648     @@@@GetProp: hashKey
2649     @@Set:
2650     @@@nullCase:
2651     @@@@enDesc:
2652     This variable is not for hash value access.
2653     @@@disDef:
2654     @@@@SetProp: hashKey
2655 wakaba 1.15 ##PerlVariable
2656 wakaba 1.6
2657     PropDef:
2658     @QName: variableScope
2659     @enDesc:
2660     Variable scope (<CODE::local>, <CODE::my> or <CODE::our>).
2661    
2662     PropDef:
2663     @QName: variableType
2664     @enDesc:
2665     Variable type prefix.
2666    
2667     PropDef:
2668     @QName: hashKey
2669     @enDesc:
2670     Hash key string.
2671    
2672     ClsDef:
2673     @ClsQName: ManakaiPerlAnyContainer
2674     @ClsISA: ManakaiPerlCodeFragment
2675     @enDesc:
2676     A base class implemented by both inline container and
2677     block-level container.
2678    
2679     @Attr:
2680     @@Name: length
2681     @@enDesc:
2682     The number of child code fragments.
2683     @@Type:
2684 wakaba 1.12 DOMMain:unsigned-long::ManakaiDOM:all
2685 wakaba 1.6 @@Get:
2686     @@@PerlDef:
2687     $r = @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}};
2688    
2689     @Method:
2690     @@Name: appendStringLiteral
2691     @@enDesc:
2692     Appends a Perl string literal (<CODE::q>).
2693     @@Param:
2694     @@@Name: stringArg
2695     @@@Type:
2696     DISLang:String::ManakaiDOM:all
2697     @@@enDesc:
2698     A string.
2699     @@Return:
2700     @@@Type: ManakaiPerlStringLiteral
2701     @@@enDesc:
2702     The newly created Perl string literal object.
2703     @@@PerlDef:
2704     $r = <ClassM::ManakaiPerlStringLiteral.newObject>;
2705     my $node = $self->{<Q::TreeCore:node>};
2706     $r->{<Q::infoset:data>} = $stringArg;
2707     $node-><M::ManakaiDOM:ManakaiDOMNodeObject
2708     ::ManakaiDOM:Perl.importTree> ($r);
2709     push @{$node->{<Q::pc:childNodes>}}, $r;
2710     $r->{<Q::pc:parent>} = $node;
2711     if (defined wantarray) {
2712     __CODE{ManakaiNode:getNewReference::
2713     $object => $r, $ref => $r,
2714     $class =>{<ClassName::ManakaiPerlStringLiteral>},
2715     }__;
2716     }
2717    
2718    
2719     @Method:
2720     @@Name: appendAtom
2721     @@enDesc:
2722     Appends a Perl atomic code fragment.
2723     @@Param:
2724     @@@Name: codeArg
2725     @@@Type:
2726     lang:Perl::ManakaiDOM:all
2727     @@@enDesc:
2728     An atom.
2729     @@Return:
2730     @@@Type: ManakaiPerlAtom
2731     @@@enDesc:
2732     The newly created Perl code object.
2733     @@@PerlDef:
2734     $r = <ClassM::ManakaiPerlAtom.newObject>;
2735     my $node = $self->{<Q::TreeCore:node>};
2736 wakaba 1.7 $r->{<Q::pc:code>} = $codeArg;
2737 wakaba 1.6 $node-><M::ManakaiDOM:ManakaiDOMNodeObject
2738     ::ManakaiDOM:Perl.importTree> ($r);
2739     push @{$node->{<Q::pc:childNodes>}}, $r;
2740     $r->{<Q::pc:parent>} = $node;
2741     if (defined wantarray) {
2742     __CODE{ManakaiNode:getNewReference::
2743     $object => $r, $ref => $r,
2744     $class =>{<ClassName::ManakaiPerlAtom>},
2745     }__;
2746     }
2747    
2748    
2749     @Method:
2750     @@Name: appendBare
2751     @@enDesc:
2752     Appends a Perl bare code fragment.
2753     @@Param:
2754     @@@Name: codeArg
2755     @@@Type:
2756     lang:Perl::ManakaiDOM:all
2757     @@@enDesc:
2758 wakaba 1.7 An bare code.
2759 wakaba 1.6 @@Return:
2760     @@@Type: ManakaiPerlBare
2761     @@@enDesc:
2762     The newly created Perl code object.
2763     @@@PerlDef:
2764     $r = <ClassM::ManakaiPerlBare.newObject>;
2765     my $node = $self->{<Q::TreeCore:node>};
2766 wakaba 1.7 $r->{<Q::pc:code>} = $codeArg;
2767 wakaba 1.6 $node-><M::ManakaiDOM:ManakaiDOMNodeObject
2768     ::ManakaiDOM:Perl.importTree> ($r);
2769     push @{$node->{<Q::pc:childNodes>}}, $r;
2770     $r->{<Q::pc:parent>} = $node;
2771     if (defined wantarray) {
2772     __CODE{ManakaiNode:getNewReference::
2773     $object => $r, $ref => $r,
2774     $class =>{<ClassName::ManakaiPerlBare>},
2775     }__;
2776     }
2777 wakaba 1.11
2778     @Method:
2779     @@Name: appendNewAssignment
2780     @@enDesc:
2781     Appends a newly created <Class::ManakaiPerlAssign> object.
2782     @@Param:
2783     @@@Name: leftArg
2784     @@@Type: ManakaiPerlCodeFragment
2785     @@@enDesc:
2786     A left hand side code fragment object.
2787     @@Param:
2788     @@@Name: rightArg
2789     @@@Type: ManakaiPerlCodeFragment
2790     @@@enDesc:
2791     A right hand side code fragment object.
2792     @@Return:
2793     @@@RaiseException:
2794     @@@@@:BAD_CHILD_ERR
2795     @@@@enDesc:
2796     An attempt is made to append a child
2797     that is not valid type.
2798     @@@RaiseException:
2799     @@@@@:IN_USE_NODE_ERR
2800     @@@@enDesc:
2801     An attempt is made to append a node that is
2802     already used elsewhere.
2803     @@@PerlDef:
2804     for my $arg ([leftArg => $leftArg], [rightArg => $rightArg]) {
2805     if ({
2806     atom => 1, bare => 1, incontainer => 1, assign => true,
2807     inunparsed => 1, variable => 1, string => true,
2808     }->{$arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:nodeType>}}) {
2809     if ($arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
2810     __EXCEPTION{IN_USE_NODE_ERR::
2811     pc:childNode => {$arg->[1]},
2812     MDOMX:param-name => {$arg->[0]},
2813     }__;
2814     }
2815     } else {
2816     __EXCEPTION{BAD_CHILD_ERR::
2817     pc:parentNode => {$self},
2818     pc:childNode => {$arg->[1]},
2819     MDOMX:param-name => {$arg->[0]},
2820     }__;
2821     }
2822     } # left/right
2823    
2824     my $assign = <ClassM::ManakaiPerlAssignment.newObject>;
2825     $assign->{<Q::pc:left>} = $leftArg->{<Q::TreeCore:node>};
2826     $assign->{<Q::pc:right>} = $rightArg->{<Q::TreeCore:node>};
2827     $leftArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign;
2828     $rightArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign;
2829     $self->{<Q::TreeCore:node>}-><M::MNodeObject.importTree> ($assign);
2830     $assign->{<Q::pc:parent>} = $self->{<Q::TreeCore:node>};
2831     push @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}}, $assign;
2832 wakaba 1.8 ##PerlAnyContainer
2833 wakaba 1.6
2834 wakaba 1.8 ClsDef:
2835     @ClsQName: ManakaiPerlStatement
2836     @ClsISA: ManakaiPerlInlineContainer
2837     @enDesc:
2838     Perl statements.
2839    
2840     @IntMethod:
2841     @@Name:newObject
2842     @@ManakaiDOM:isStatic:1
2843     @@Description:
2844     @@@lang:en
2845     @@@@:
2846     Creates a new instance object for
2847     <Class::ManakaiPerlStatement>.
2848     @@Return:
2849     @@@Type:
2850     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2851     @@@Description:
2852     @@@@lang:en
2853     @@@@@:
2854     The newly created node object.
2855     @@@PerlDef:
2856     @@@@@:
2857     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2858     ::ManakaiDOM:Perl.new>;
2859     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2860 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
2861 wakaba 1.8 $node->{<Q::pc:childNodes>} = [];
2862     $node->{<Q::pc:nodeType>} = 'statement';
2863     @@@@ImplNote:
2864     @@@@@lang:en
2865     @@@@@@:
2866 wakaba 1.14 Properties: <Q::pc:nodeType>, <Q::pc:childNodes>,
2867 wakaba 1.22 <Q::pc:parent>, <Q::pc:useModuleName>, <Q::pc:useCharClassName>,
2868 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2869 wakaba 1.9
2870     @IntCloneMethod:
2871     @@Return:
2872     @@@Type:
2873     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2874     @@@PerlDef:
2875     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2876     ::ManakaiDOM:Perl.new>;
2877     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2878     $node->{<Q::pc:nodeType>} = 'statement';
2879 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
2880 wakaba 1.9 $node->{<Q::pc:childNodes>} = [];
2881     for my $cno (@{$nodeObject->{<Q::pc:childNodes>}}) {
2882     my $pack;
2883     my $nt = $cno->{<Q::pc:nodeType>};
2884     __CODE{pc:nodeTypeToPackageName::
2885     $nodeType => $nt, $packageName => $pack, $object => $cno}__;
2886     ## NOTE: Method name written directly
2887 wakaba 1.15 my $cno_clone = $pack->_make_clone_object ($cno);
2888 wakaba 1.9 push @{$node->{<Q::pc:childNodes>}}, $cno_clone;
2889     $cno_clone->{<Q::pc:parent>} = $node;
2890     ## NOTE: Tree ID is not updated yet.
2891     }
2892 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2893     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2894     $node->{<Q::pc:useModuleName>}
2895     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2896 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2897     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2898     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2899 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2900     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2901 wakaba 1.8
2902     @ToStringMethod:
2903     @@Return:
2904     @@@Type:
2905 wakaba 1.12 DISLang:String::ManakaiDOM:all
2906 wakaba 1.8 @@@enDesc:
2907     Perl code.
2908     @@@PerlDef:
2909     $r = $self->SUPER::stringify;
2910 wakaba 1.16 $r .= ";\n" if length $r;
2911 wakaba 1.8 ##PerlStatement
2912 wakaba 1.6
2913     ClsDef:
2914     @ClsQName: ManakaiPerlInlineContainer
2915     @ClsISA: ManakaiPerlAnyContainer
2916     @enDesc:
2917     Unparsed Perl inline code block.
2918    
2919     @IntMethod:
2920     @@Name:newObject
2921     @@ManakaiDOM:isStatic:1
2922     @@Description:
2923     @@@lang:en
2924     @@@@:
2925     Creates a new instance object for
2926     <Class::ManakaiPerlInlineContainer>.
2927     @@Return:
2928     @@@Type:
2929     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2930     @@@Description:
2931     @@@@lang:en
2932     @@@@@:
2933     The newly created node object.
2934     @@@PerlDef:
2935     @@@@@:
2936     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2937     ::ManakaiDOM:Perl.new>;
2938     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2939 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
2940 wakaba 1.6 $node->{<Q::pc:childNodes>} = [];
2941     $node->{<Q::pc:nodeType>} = 'incontainer';
2942     @@@@ImplNote:
2943     @@@@@lang:en
2944     @@@@@@:
2945 wakaba 1.9 Properties: <Q::pc:nodeType>, <Q::pc:childNodes>,
2946 wakaba 1.22 <Q::pc:parent>, <Q::pc:useModuleName>, <Q::pc:useCharClassName>,
2947 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
2948 wakaba 1.9
2949     @IntCloneMethod:
2950     @@Return:
2951     @@@Type:
2952     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
2953     @@@PerlDef:
2954     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
2955     ::ManakaiDOM:Perl.new>;
2956     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
2957 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
2958 wakaba 1.9 $node->{<Q::pc:nodeType>} = 'incontainer';
2959     $node->{<Q::pc:childNodes>} = [];
2960     for my $cno (@{$nodeObject->{<Q::pc:childNodes>}}) {
2961     my $pack;
2962     my $nt = $cno->{<Q::pc:nodeType>};
2963     __CODE{pc:nodeTypeToPackageName::
2964     $nodeType => $nt, $packageName => $pack, $object => $cno}__;
2965     ## NOTE: Method name written directly
2966 wakaba 1.15 my $cno_clone = $pack->_make_clone_object ($cno);
2967 wakaba 1.9 push @{$node->{<Q::pc:childNodes>}}, $cno_clone;
2968     $cno_clone->{<Q::pc:parent>} = $node;
2969     ## NOTE: Tree ID is not updated yet.
2970     }
2971 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
2972     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
2973     $node->{<Q::pc:useModuleName>}
2974     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
2975 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
2976     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
2977     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
2978 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
2979     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
2980 wakaba 1.6
2981     @Method:
2982     @@Name: appendCodeFragment
2983     @@enDesc:
2984     Appends a <Class::ManakaiPerlCodeFragment> object.
2985     @@Param:
2986     @@@Name: codeArg
2987     @@@Type: ManakaiPerlCodeFragment
2988     @@@enDesc:
2989     A code fragment object.
2990     @@Return:
2991     @@@RaiseException:
2992     @@@@@:BAD_CHILD_ERR
2993     @@@@enDesc:
2994     An attempt is made to append a child
2995     that is not a <Class::ManakaiPerlUnparsedCode>.
2996     @@@RaiseException:
2997     @@@@@:IN_USE_NODE_ERR
2998     @@@@enDesc:
2999     An attempt is made to append a node that is
3000     already used elsewhere.
3001     @@@PerlDef:
3002     if ({
3003 wakaba 1.11 atom => 1, bare => 1, incontainer => 1, assign => true,
3004     inunparsed => 1, variable => 1, string => 1,
3005 wakaba 1.6 }->{$codeArg->{<Q::TreeCore:node>}->{<Q::pc:nodeType>}}) {
3006     if ($codeArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
3007     __EXCEPTION{IN_USE_NODE_ERR::
3008     pc:childNode => {$codeArg},
3009     }__;
3010     }
3011     $self->{<Q::TreeCore:node>}-><M::MNodeObject.importTree>
3012     ($codeArg->{<Q::TreeCore:node>});
3013     push @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}},
3014     $codeArg->{<Q::TreeCore:node>};
3015     $codeArg->{<Q::TreeCore:node>}->{<Q::pc:parent>}
3016     = $self->{<Q::TreeCore:node>};
3017     } else {
3018     __EXCEPTION{BAD_CHILD_ERR::
3019     pc:parentNode => {$self},
3020     pc:childNode => {$codeArg},
3021     }__;
3022     }
3023    
3024     @Method:
3025     @@Name: appendCode
3026     @@enDesc:
3027     Appends an unparsed Perl code fragment.
3028     @@Param:
3029     @@@Name: codeArg
3030     @@@Type:
3031     lang:Perl::ManakaiDOM:all
3032     @@@enDesc:
3033     An unparsed Perl code fragment.
3034     @@Return:
3035     @@@Type: ManakaiPerlInlineUnparsedCode
3036     @@@enDesc:
3037     The newly created Perl code object.
3038     @@@PerlDef:
3039     $r = <ClassM::ManakaiPerlInlineUnparsedCode.newObject>;
3040     my $node = $self->{<Q::TreeCore:node>};
3041     $r->{<Q::code>} = $codeArg;
3042     $node-><M::ManakaiDOM:ManakaiDOMNodeObject
3043     ::ManakaiDOM:Perl.importTree> ($r);
3044     push @{$node->{<Q::pc:childNodes>}}, $r;
3045     $r->{<Q::pc:parent>} = $node;
3046     if (defined wantarray) {
3047     __CODE{ManakaiNode:getNewReference::
3048     $object => $r, $ref => $r,
3049     $class =>{<ClassName::ManakaiPerlInlineUnparsedCode>},
3050     }__;
3051     }
3052    
3053     @ToStringMethod:
3054     @@Return:
3055     @@@Type:
3056 wakaba 1.12 DISLang:String::ManakaiDOM:all
3057 wakaba 1.6 @@@enDesc:
3058     Perl code.
3059     @@@PerlDef:
3060     for my $cno (@{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}}) {
3061 wakaba 1.7 my $cn = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($cno);
3062 wakaba 1.6 if ($cno->{<Q::pc:nodeType>} eq 'incontainer' and
3063     \ @{$self->{<Q::TreeCore:node>}->{<Q::pc:childNodes>}} == 1) {
3064     $r .= '(' . $cn->stringify . ')';
3065     } else {
3066     $r .= $cn->stringify;
3067     }
3068     }
3069     ##PerlInlineContainer
3070    
3071 wakaba 1.8 ClsDef:
3072     @ClsQName: ManakaiPerlBlock
3073     @ClsISA: ManakaiPerlStatementContainer
3074     @enDesc:
3075     Perl block-level code block.
3076    
3077     @IntMethod:
3078     @@Name:newObject
3079     @@ManakaiDOM:isStatic:1
3080     @@Description:
3081     @@@lang:en
3082     @@@@:
3083     Creates a new instance object for
3084     <Class::ManakaiPerlBlock>.
3085     @@Return:
3086     @@@Type:
3087     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3088     @@@Description:
3089     @@@@lang:en
3090     @@@@@:
3091     The newly created node object.
3092     @@@PerlDef:
3093     @@@@@:
3094     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3095     ::ManakaiDOM:Perl.new>;
3096     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3097 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
3098 wakaba 1.8 $node->{<Q::pc:childNodes>} = [];
3099     $node->{<Q::pc:nodeType>} = 'block';
3100     @@@@ImplNote:
3101     @@@@@lang:en
3102     @@@@@@:
3103 wakaba 1.9 Properties: <Q::pc:nodeType>, <Q::pc:childNodes>, <Q::pc:label>,
3104 wakaba 1.10 <Q::pc:parent>, <Q::pc:sourceFile>, <Q::pc:sourceLine>,
3105 wakaba 1.22 <Q::pc:currentSoruceFile>, <Q::pc:useCharClassName>,
3106 wakaba 1.14 <Q::pc:currentSourceLine>, <Q::pc:useModuleName>,
3107 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
3108 wakaba 1.9
3109     @IntCloneMethod:
3110     @@Return:
3111     @@@Type:
3112     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3113     @@@PerlDef:
3114     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3115     ::ManakaiDOM:Perl.new>;
3116     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3117 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
3118 wakaba 1.9 $node->{<Q::pc:nodeType>} = 'block';
3119     $node->{<Q::pc:childNodes>} = [];
3120     for my $cno (@{$nodeObject->{<Q::pc:childNodes>}}) {
3121     my $pack;
3122     my $nt = $cno->{<Q::pc:nodeType>};
3123     __CODE{pc:nodeTypeToPackageName::
3124     $nodeType => $nt, $packageName => $pack, $object => $cno}__;
3125     ## NOTE: Method name written directly
3126     my $cno_clone = $pack->_make_clone_object ($cno);
3127     push @{$node->{<Q::pc:childNodes>}}, $cno_clone;
3128     $cno_clone->{<Q::pc:parent>} = $node;
3129     ## NOTE: Tree ID is not updated yet.
3130     }
3131 wakaba 1.10 for my $prop (<Q::pc:label>, <Q::pc:sourceFile>, <Q::pc:sourceLine>,
3132     <Q::pc:currentSourceFile>, <Q::pc:currentSourceLine>) {
3133     $node->{$prop} = $nodeObject->{$prop};
3134     }
3135 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
3136     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
3137     $node->{<Q::pc:useModuleName>}
3138     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
3139 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
3140     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
3141     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
3142 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
3143     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
3144 wakaba 1.8
3145     @ToStringMethod:
3146     @@Return:
3147     @@@Type:
3148 wakaba 1.12 DISLang:String::ManakaiDOM:all
3149 wakaba 1.8 @@@enDesc:
3150     Perl code.
3151     @@@PerlDef:
3152 wakaba 1.9 my $node = $self->{<Q::TreeCore:node>};
3153     if (@{$node->{<Q::pc:childNodes>}} == 1 and
3154     $node->{<Q::pc:childNodes>}->[0]->{<Q::pc:nodeType>} eq 'block') {
3155     my $cn;
3156     __CODE{ManakaiNode:getWeakReference::
3157     $object => {$node->{<Q::pc:childNodes>}->[0]},
3158     $ref => $cn,
3159     $class => {<ClassName::ManakaiPerlBlock>}}__;
3160     $r = $cn->stringify;
3161     } else {
3162     for my $cno (@{$node->{<Q::pc:childNodes>}}) {
3163     my $cn = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($cno);
3164     if ($cno->{<Q::pc:nodeType>} eq 'incontainer' and
3165     \ @{$node->{<Q::pc:childNodes>}} == 1) {
3166     $r .= '(' . $cn->stringify . ')';
3167     } else {
3168     $r .= $cn->stringify;
3169     }
3170 wakaba 1.8 }
3171 wakaba 1.9 __DEEP{
3172     my $file = $self-><AG::ManakaiPerlCodeFragment.fileNode>;
3173 wakaba 1.19 $r = sprintf (qq<\n{\n#line %d "%s [b] (Chunk #%d)"\n>,
3174 wakaba 1.10 $node->{<Q::pc:sourceLine>} || 1,
3175     $node->{<Q::pc:sourceFile>} ||
3176     $file-><AG::ManakaiPerlFile.sourceFile>,
3177 wakaba 1.9 $file-><M::ManakaiPerlFile.getNextChunkNumber>)
3178     . $r
3179 wakaba 1.19 . sprintf (qq<\n#line 1 "%s [/b] (Chunk #%d)"\n}\n>,
3180 wakaba 1.9 $file-><AG::ManakaiPerlFile.sourceFile>,
3181 wakaba 1.21 $file-><M::ManakaiPerlFile.getNextChunkNumber>)
3182     if length $r;
3183 wakaba 1.9 }__;
3184 wakaba 1.8 }
3185    
3186     ##PerlBlock
3187    
3188 wakaba 1.9 ClsDef:
3189     @ClsQName: ManakaiPerlBlockContainer
3190     @ClsISA: ManakaiPerlStatementContainer
3191     @enDesc:
3192     Perl block-level code container whose content may or may
3193     not semantically be self-contained.
3194    
3195     @IntMethod:
3196     @@Name:newObject
3197     @@ManakaiDOM:isStatic:1
3198     @@Description:
3199     @@@lang:en
3200     @@@@:
3201     Creates a new instance object for
3202     <Class::ManakaiPerlBlockContainer>.
3203     @@Return:
3204     @@@Type:
3205     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3206     @@@Description:
3207     @@@@lang:en
3208     @@@@@:
3209     The newly created node object.
3210     @@@PerlDef:
3211     @@@@@:
3212     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3213     ::ManakaiDOM:Perl.new>;
3214     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3215 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
3216 wakaba 1.9 $node->{<Q::pc:childNodes>} = [];
3217     $node->{<Q::pc:nodeType>} = 'blockcontainer';
3218     @@@@ImplNote:
3219     @@@@@lang:en
3220     @@@@@@:
3221 wakaba 1.10 Properties: <Q::pc:nodeType>, <Q::pc:childNodes>,
3222     <Q::pc:parent>, <Q::pc:sourceFile>, <Q::pc:sourceLine>,
3223 wakaba 1.22 <Q::pc:currentSourceFile>, <Q::pc:useCharClassName>,
3224 wakaba 1.14 <Q::pc:currentSourceLine>, <Q::pc:useModuleName>,
3225 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
3226 wakaba 1.9
3227     @IntCloneMethod:
3228     @@Return:
3229     @@@Type:
3230     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3231     @@@PerlDef:
3232     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3233     ::ManakaiDOM:Perl.new>;
3234     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3235 wakaba 1.11 push @{$node->{<Q::TreeCore:subnode>}}, <Q::pc:childNodes>;
3236 wakaba 1.9 $node->{<Q::pc:nodeType>} = 'blockcontainer';
3237     $node->{<Q::pc:childNodes>} = [];
3238     for my $cno (@{$nodeObject->{<Q::pc:childNodes>}}) {
3239     my $pack;
3240     my $nt = $cno->{<Q::pc:nodeType>};
3241     __CODE{pc:nodeTypeToPackageName::
3242     $nodeType => $nt, $packageName => $pack, $object => $cno}__;
3243     ## NOTE: Method name written directly
3244     my $cno_clone = $pack->_make_clone_object ($cno);
3245     push @{$node->{<Q::pc:childNodes>}}, $cno_clone;
3246     $cno_clone->{<Q::pc:parent>} = $node;
3247     ## NOTE: Tree ID is not updated yet.
3248     }
3249 wakaba 1.10 for my $prop (<Q::pc:sourceFile>, <Q::pc:sourceLine>,
3250     <Q::pc:currentSourceFile>, <Q::pc:currentSourceLine>) {
3251     $node->{$prop} = $nodeObject->{$prop};
3252     }
3253 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
3254     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
3255     $node->{<Q::pc:useModuleName>}
3256     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
3257 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
3258     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
3259     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
3260 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
3261     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
3262 wakaba 1.9
3263     @ToStringMethod:
3264     @@Return:
3265     @@@Type:
3266 wakaba 1.12 DISLang:String::ManakaiDOM:all
3267 wakaba 1.9 @@@enDesc:
3268     Perl code.
3269     @@@PerlDef:
3270     my $node = $self->{<Q::TreeCore:node>};
3271     if (@{$node->{<Q::pc:childNodes>}} == 1 and
3272     {
3273     block => true, blockcontainer => true,
3274     }->{$node->{<Q::pc:childNodes>}->[0]->{<Q::pc:nodeType>}}) {
3275     my $cn;
3276     __CODE{ManakaiNode:getWeakReference::
3277     $object => {$node->{<Q::pc:childNodes>}->[0]},
3278     $ref => $cn,
3279     $class => {<ClassName::ManakaiPerlBlock>}}__;
3280     $r = $cn->stringify;
3281     } else {
3282     for my $cno (@{$node->{<Q::pc:childNodes>}}) {
3283     my $cn = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($cno);
3284     if ($cno->{<Q::pc:nodeType>} eq 'incontainer' and
3285     \ @{$node->{<Q::pc:childNodes>}} == 1) {
3286     $r .= '(' . $cn->stringify . ')';
3287     } else {
3288     $r .= $cn->stringify;
3289     }
3290     }
3291     __DEEP{
3292     my $file = $self-><AG::ManakaiPerlCodeFragment.fileNode>;
3293 wakaba 1.19 $r = sprintf (qq<\n#line %d "%s [bc] (Chunk #%d)"\n>,
3294 wakaba 1.10 $node->{<Q::pc:sourceLine>} || 1,
3295     $node->{<Q::pc:sourceFile>} ||
3296     $file-><AG::ManakaiPerlFile.sourceFile>,
3297 wakaba 1.9 $file-><M::ManakaiPerlFile.getNextChunkNumber>)
3298     . $r
3299 wakaba 1.19 . sprintf (qq<\n#line 1 "%s [/bc] (Chunk #%d)"\n>,
3300 wakaba 1.9 $file-><AG::ManakaiPerlFile.sourceFile>,
3301     $file-><M::ManakaiPerlFile.getNextChunkNumber>);
3302     }__;
3303     }
3304    
3305     ##PerlBlockContainer
3306    
3307 wakaba 1.11 ClsDef:
3308     @ClsQName: ManakaiPerlAssignment
3309     @ClsISA: ManakaiPerlCodeFragment
3310     @enDesc:
3311     Perl variable assignment.
3312    
3313     @IntMethod:
3314     @@Name:newObject
3315     @@ManakaiDOM:isStatic:1
3316     @@Description:
3317     @@@lang:en
3318     @@@@:
3319     Creates a new instance object for
3320     <Class::ManakaiPerlAssignment>.
3321     @@Return:
3322     @@@Type:
3323     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3324     @@@Description:
3325     @@@@lang:en
3326     @@@@@:
3327     The newly created node object.
3328     @@@PerlDef:
3329     @@@@@:
3330     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3331     ::ManakaiDOM:Perl.new>;
3332     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3333     push @{$node->{<Q::TreeCore:subnode0>}}, <Q::pc:left>, <Q::pc:right>;
3334     $node->{<Q::pc:nodeType>} = 'assign';
3335     @@@@ImplNote:
3336     @@@@@lang:en
3337     @@@@@@:
3338     Properties: <Q::pc:nodeType>, <Q::pc:left>, <Q::pc:right>,
3339 wakaba 1.22 <Q::pc:parent>, <Q::pc:useModuleName>, <Q::pc:useCharClassName>,
3340 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
3341 wakaba 1.11
3342     @IntCloneMethod:
3343     @@Return:
3344     @@@Type:
3345     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3346     @@@PerlDef:
3347     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3348     ::ManakaiDOM:Perl.new>;
3349     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3350     push @{$node->{<Q::TreeCore:subnode0>}}, <Q::pc:left>, <Q::pc:right>;
3351     $node->{<Q::pc:nodeType>} = 'assign';
3352     for my $prop (<Q::pc:left>, <Q::pc:right>) {
3353     my $pack;
3354     my $cno = $nodeObject->{$prop};
3355     my $nt = $cno->{<Q::pc:nodeType>};
3356     __CODE{pc:nodeTypeToPackageName::
3357     $nodeType => $nt, $packageName => $pack, $object => $cno}__;
3358     ## NOTE: Method name written directly
3359     my $cno_clone = $pack->_make_clone_object ($cno);
3360     $node->{$prop} = $cno_clone;
3361     $cno_clone->{<Q::pc:parent>} = $node;
3362     ## NOTE: Tree ID is not updated yet.
3363     }
3364 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
3365     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
3366     $node->{<Q::pc:useModuleName>}
3367     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
3368 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
3369     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
3370     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
3371 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
3372     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
3373 wakaba 1.11
3374     @ToStringMethod:
3375     @@Return:
3376     @@@Type:
3377 wakaba 1.12 DISLang:String::ManakaiDOM:all
3378 wakaba 1.11 @@@enDesc:
3379     Perl code.
3380     @@@PerlDef:
3381     my $node = $self->{<Q::TreeCore:node>};
3382     $r = <ClassM::ManakaiPerlCodeFragment.getNodeReference>
3383     ($node->{<Q::pc:left>})->stringify . ' = ' .
3384     <ClassM::ManakaiPerlCodeFragment.getNodeReference>
3385     ($node->{<Q::pc:right>})->stringify;
3386     ##PerlAssignment
3387    
3388 wakaba 1.12 ClsDef:
3389     @ClsQName: ManakaiPerlIf
3390     @ClsISA: ManakaiPerlCodeFragment
3391     @enDesc:
3392     Perl variable assignment.
3393    
3394     @IntMethod:
3395     @@Name:newObject
3396     @@ManakaiDOM:isStatic:1
3397     @@Description:
3398     @@@lang:en
3399     @@@@:
3400     Creates a new instance object for
3401     <Class::ManakaiPerlAssignment>.
3402     @@Return:
3403     @@@Type:
3404     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3405     @@@Description:
3406     @@@@lang:en
3407     @@@@@:
3408     The newly created node object.
3409     @@@PerlDef:
3410     @@@@@:
3411     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3412     ::ManakaiDOM:Perl.new>;
3413     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3414     push @{$node->{<Q::TreeCore:subnode0>}}, <Q::pc:condition>,
3415     <Q::pc:true>, <Q::pc:false>;
3416     $node->{<Q::pc:nodeType>} = 'if';
3417     @@@@ImplNote:
3418     @@@@@lang:en
3419     @@@@@@:
3420     Properties: <Q::pc:nodeType>, <Q::pc:true>, <Q::pc:false>,
3421 wakaba 1.22 <Q::pc:useCharClassName>,
3422 wakaba 1.14 <Q::pc:parent>, <Q::pc:condition>, <Q::pc:useModuleName>,
3423 wakaba 1.19 <Q::pc:requireResourceURI>, <Q::pc:requireModuleName>.
3424 wakaba 1.12
3425     @IntCloneMethod:
3426     @@Return:
3427     @@@Type:
3428     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
3429     @@@PerlDef:
3430     my $node = $r = <ClassM::ManakaiDOM:ManakaiDOMNodeObject
3431     ::ManakaiDOM:Perl.new>;
3432     push @{$node->{<Q::TreeCore:origin>}}, <Q::pc:parent>;
3433     push @{$node->{<Q::TreeCore:subnode0>}}, <Q::pc:condition>,
3434     <Q::pc:true>, <Q::pc:false>;
3435     $node->{<Q::pc:nodeType>} = 'if';
3436     for my $prop (<Q::pc:true>, <Q::pc:false>, <Q::pc:condition>) {
3437     my $pack;
3438     my $cno = $nodeObject->{$prop};
3439     next unless $cno;
3440     my $nt = $cno->{<Q::pc:nodeType>};
3441     __CODE{pc:nodeTypeToPackageName::
3442     $nodeType => $nt, $packageName => $pack, $object => $cno}__;
3443     ## NOTE: Method name written directly
3444     my $cno_clone = $pack->_make_clone_object ($cno);
3445     $node->{$prop} = $cno_clone;
3446     $cno_clone->{<Q::pc:parent>} = $node;
3447     ## NOTE: Tree ID is not updated yet.
3448     }
3449 wakaba 1.14 $node->{<Q::pc:requireResourceURI>}
3450     = {%{$nodeObject->{<Q::pc:requireResourceURI>} || {}}};
3451     $node->{<Q::pc:useModuleName>}
3452     = {%{$nodeObject->{<Q::pc:useModuleName>} || {}}};
3453 wakaba 1.22 $node->{<Q::pc:useCharClassName>}
3454     = {map {$_ => {%{$nodeObject->{<Q::pc:useCharClassName>}->{$_}}}}
3455     keys %{$nodeObject->{<Q::pc:useCharClassName>} || {}}};
3456 wakaba 1.19 $node->{<Q::pc:requireModuleName>}
3457     = {%{$nodeObject->{<Q::pc:requireModuleName>} || {}}};
3458 wakaba 1.12
3459     @ToStringMethod:
3460     @@Return:
3461     @@@Type:
3462     DISLang:String::ManakaiDOM:all
3463     @@@enDesc:
3464     Perl code.
3465     @@@PerlDef:
3466     my $node = $self->{<Q::TreeCore:node>};
3467     $r = <ClassM::ManakaiPerlCodeFragment.getNodeReference>
3468     ($node->{<Q::pc:condition>})->stringify;
3469     my $true_code = <ClassM::ManakaiPerlCodeFragment.getNodeReference>
3470     ($node->{<Q::pc:true>})->stringify if $node->{<Q::pc:true>};
3471     my $false_code = <ClassM::ManakaiPerlCodeFragment.getNodeReference>
3472     ($node->{<Q::pc:false>})->stringify if $node->{<Q::pc:false>};
3473     if (defined $true_code) {
3474     if (defined $false_code) {
3475     $r = q<if (> . $r . q<) {> . $true_code .
3476     q<} else {> . $false_code . q<}>;
3477     } else {
3478     $r = q<if (> . $r . q<) {> . $true_code . q<}>;
3479     }
3480     } else {
3481     $r = q<unless (> . $r . q<) {> . $false_code . q<}>;
3482     }
3483     ##PerlIf
3484    
3485     PropDef:
3486     @QName:condition
3487     @enDesc:
3488     Condition.
3489     PropDef:
3490     @QName:true
3491     @enDesc:
3492     If true.
3493     PropDef:
3494     @QName:false
3495     @enDesc:
3496     If false.
3497    
3498 wakaba 1.11 PropDef:
3499     @QName:left
3500     @FullName:
3501     @@lang:en
3502     @@@: Left hand side
3503     PropDef:
3504     @QName:right
3505     @FullName:
3506     @@lang:en
3507     @@@: Right hand side
3508    
3509 wakaba 1.8 PropDef:
3510     @QName:label
3511     @enDesc:
3512     Perl statement / block label.
3513    
3514 wakaba 1.6 ElementTypeBinding:
3515     @Name: RaiseException
3516     @ElementType:
3517     ManakaiDOM:raises
3518    
3519     ClsDef:
3520     @ClsQName: ManakaiPerlCodeImplementation
3521 wakaba 1.1 @enDesc:
3522     The class that provides factory methods.
3523 wakaba 1.20
3524     @ClsISA:
3525     dx:ManakaiDefaultExceptionHandler::ManakaiDOM:Perl
3526 wakaba 1.17
3527     @DISLang:role:
3528     DOMMetaImpl:ManakaiAnyImplementationRole
3529     @DOMMetaImpl:provideFeature: CoreFeature10
3530 wakaba 1.1
3531     @Role:
3532     @@@:
3533     DOMCore:DOMImplementation::ManakaiDOM:ManakaiDOM
3534     @@compat:
3535     DOMCore:ManakaiDOMImplementation::ManakaiDOM:ManakaiDOMLatest
3536    
3537     @Method:
3538     @@Name: createPerlFile
3539     @@enDesc:
3540     Creates a Perl code file.
3541     @@Return:
3542     @@@Type: ManakaiPerlFile
3543     @@@enDesc: A newly created Perl source file object.
3544     @@@PerlDef:
3545     $r = <ClassM::ManakaiPerlFile.newObject>;
3546 wakaba 1.6 __CODE{ManakaiNode:getNewReference::
3547     $object => $r, $ref => $r,
3548     $class => {<ClassName::ManakaiPerlFile>}}__;
3549 wakaba 1.1
3550 wakaba 1.13 @Method:
3551     @@Name: createPerlPackage
3552     @@enDesc:
3553     Creates a new package scope block.
3554     @@Param:
3555     @@@Name: packageName
3556     @@@Type:
3557     Perl:package-name::ManakaiDOM:all
3558     @@@enDesc:
3559     The fully-qualified name of the package to create.
3560     @@Return:
3561     @@@Type: ManakaiPerlPackageScope
3562     @@@enDesc:
3563     The newly created package scope object.
3564     @@@PerlDef:
3565     $r = <ClassM::ManakaiPerlPackageScope.newObject>;
3566     $r->{<Q::pc:packageName>} = $packageName;
3567     __CODE{ManakaiNode:getNewReference::
3568     $object => $r, $ref => $r,
3569     $class => {<ClassName::ManakaiPerlPackageScope>}}__;
3570    
3571 wakaba 1.1 @IntMethod:
3572     @@Name: perlComment
3573     @@ManakaiDOM:isStatic:1
3574     @@enDesc:
3575     Generates a Perl comment string.
3576     @@Param:
3577     @@@Name: str
3578     @@@Type:
3579 wakaba 1.12 DISLang:String::ManakaiDOM:all
3580 wakaba 1.1 @@@enDesc:
3581     A comment text.
3582     @@Return:
3583     @@@Type:
3584 wakaba 1.12 DISLang:String::ManakaiDOM:all
3585 wakaba 1.1 @@@enDesc:
3586     A Perl comment string.
3587     @@@PerlDef:
3588     $r = $str;
3589     $r =~ s/\n/\n## /g;
3590     $r =~ s/\n## $/\n/s;
3591     $r .= "\n" unless $r =~ /\n$/;
3592     $r = q<## > . $r;
3593    
3594     @IntMethod:
3595     @@Name: rfc3339DateTime
3596     @@ManakaiDOM:isStatic:1
3597     @@enDesc:
3598     Returns RFC 3339 <CODE::date-time> representation of a date.
3599     @@Param:
3600     @@@Name: perlDate
3601     @@@Type:
3602 wakaba 1.12 DOMMain:unsigned-long::ManakaiDOM:all
3603 wakaba 1.1 @@@enDesc:
3604     A Perl representation of date.
3605     @@Return:
3606     @@@Type:
3607 wakaba 1.12 DISLang:String::ManakaiDOM:all
3608 wakaba 1.1 @@@enDesc:
3609     RFC 3339 date string.
3610     @@@PerlDef:
3611     my @time = gmtime $perlDate;
3612     $r = sprintf q<%04d-%02d-%02dT%02d:%02d:%02d+00:00>,
3613     $time[5] + 1900, $time[4] + 1, @time[3,2,1,0];
3614    
3615     @IntMethod:
3616     @@Name: versionDateTime
3617     @@ManakaiDOM:isStatic:1
3618     @@enDesc:
3619     Returns date for version.
3620     @@Param:
3621     @@@Name: perlDate
3622     @@@Type:
3623 wakaba 1.12 DOMMain:unsigned-long::ManakaiDOM:all
3624 wakaba 1.1 @@@enDesc:
3625     A Perl representation of date.
3626     @@Return:
3627     @@@Type:
3628 wakaba 1.12 DISLang:String::ManakaiDOM:all
3629 wakaba 1.1 @@@enDesc:
3630     A Perl number literal.
3631     @@@PerlDef:
3632     my @time = gmtime $perlDate;
3633     $r = sprintf q<%04d%02d%02d.%02d%02d>,
3634     $time[5] + 1900, $time[4] + 1, @time[3,2,1];
3635    
3636     @Method:
3637     @@Name: perlLiteral
3638     @@enDesc:
3639     Perl code representation.
3640     @@Param:
3641     @@@Name: val
3642     @@@Type:
3643 wakaba 1.12 DOMMain:any::ManakaiDOM:all
3644 wakaba 1.1 @@@enDesc:
3645     A Perl value.
3646     @@Return:
3647     @@@Type:
3648 wakaba 1.12 DISLang:String::ManakaiDOM:all
3649 wakaba 1.1 @@@enDesc:
3650     A Perl lexical representation of <P::val>.
3651     @@@PerlDef:
3652     unless (defined $val) {
3653     $r = q<undef>;
3654     } elsif (ref $val eq 'ARRAY') {
3655     __DEEP{
3656     $r = q<[> . <ClassM::ManakaiPerlCodeImplementation
3657 wakaba 1.14 .perlList> ($val) . q<]>;
3658 wakaba 1.1 }__;
3659     } elsif (ref $val eq 'HASH') {
3660     __DEEP{
3661     $r = q<{> . <ClassM::ManakaiPerlCodeImplementation
3662 wakaba 1.14 .perlList> ([%$val]) . q<}>;
3663 wakaba 1.1 }__;
3664     } else {
3665     $val =~ s/(['\\])/\\$1/g;
3666     $r = q<'> . $val . q<'>;
3667     }
3668    
3669     @Method:
3670     @@Name: perlList
3671     @@enDesc:
3672     Perl code representation of a list.
3673     @@Param:
3674     @@@Name: val
3675     @@@Type:
3676 wakaba 1.12 Perl:ARRAY::ManakaiDOM:all
3677 wakaba 1.1 @@@enDesc:
3678     A Perl array reference.
3679     @@Return:
3680     @@@Type:
3681 wakaba 1.12 DISLang:String::ManakaiDOM:all
3682 wakaba 1.1 @@@enDesc:
3683     A Perl lexical representation of <CODE::@$val>.
3684     @@@PerlDef:
3685     __DEEP{
3686     $r = join (q<, >, map {<ClassM::ManakaiPerlCodeImplementation
3687     .perlLiteral> ($_)} @{$val});
3688     }__;
3689 wakaba 1.5
3690     @Method:
3691     @@Name: createPerlSub
3692     @@enDesc:
3693     Creates a new <Class::ManakaiPerlSub> object.
3694     @@Param:
3695     @@@Name: subName
3696     @@@Type:
3697 wakaba 1.12 DISLang:String::ManakaiDOM:all
3698 wakaba 1.5 @@@enDesc:
3699     The name of the subroutine to create.
3700     @@@nullCase:
3701     @@@@enDesc:
3702     The subroutine created has no name.
3703     @@Return:
3704     @@@Type:ManakaiPerlSub
3705     @@@enDesc:
3706     Newly created Perl subroutine object.
3707     @@@PerlDef:
3708     __DEEP{
3709 wakaba 1.6 $r = <ClassM::ManakaiPerlSub.newObject>;
3710     __CODE{ManakaiNode:getNewReference::
3711     $object => $r, $ref => $r,
3712     $class => {<ClassName::ManakaiPerlSub>}}__;
3713     $r-><AS::ManakaiPerlSub.localName> ($subName) if defined $subName;
3714 wakaba 1.5 }__;
3715    
3716     @Method:
3717     @@Name: createPerlUnparsedCode
3718     @@enDesc:
3719     Creates a new <Class::ManakaiPerlUnparsedCode> object.
3720     @@Param:
3721     @@@Name: codeArg
3722     @@@Type:
3723     lang:Perl::ManakaiDOM:all
3724     @@@enDesc:
3725     The code fragment.
3726     @@@nullCase:
3727     @@@@enDesc:
3728     The fragment initially has no code.
3729     @@Return:
3730     @@@Type:ManakaiPerlUnparsedCode
3731     @@@enDesc:
3732     Newly created Perl code object.
3733     @@@PerlDef:
3734     __DEEP{
3735 wakaba 1.6 $r = <ClassM::ManakaiPerlUnparsedCode.newObject>;
3736     __CODE{ManakaiNode:getNewReference::
3737     $object => $r, $ref => $r,
3738     $class => {<ClassName::ManakaiPerlUnparsedCode>}}__;
3739 wakaba 1.7 $r-><AS::ManakaiPerlUnparsedCode.code> ($codeArg) if defined $codeArg;
3740 wakaba 1.6 }__;
3741    
3742     @Method:
3743     @@Name: createPerlInlineContainer
3744     @@enDesc:
3745     Creates a new <Class::ManakaiPerlInlineContainer> object.
3746     @@Return:
3747     @@@Type:ManakaiPerlInlineContainer
3748     @@@enDesc:
3749     Newly created Perl code object.
3750     @@@PerlDef:
3751     __DEEP{
3752     $r = <ClassM::ManakaiPerlInlineContainer.newObject>;
3753     __CODE{ManakaiNode:getNewReference::
3754     $object => $r, $ref => $r,
3755     $class => {<ClassName::ManakaiPerlInlineContainer>}}__;
3756     }__;
3757    
3758     @Method:
3759     @@Name: createPerlInlineUnparsedCode
3760     @@enDesc:
3761     Creates a new <Class::ManakaiPerlInlineUnparsedCode> object.
3762     @@Param:
3763     @@@Name: codeArg
3764     @@@Type:
3765     lang:Perl::ManakaiDOM:all
3766     @@@enDesc:
3767     The code fragment.
3768     @@@nullCase:
3769     @@@@enDesc:
3770     The fragment initially has no code.
3771     @@Return:
3772     @@@Type:ManakaiPerlInlineUnparsedCode
3773     @@@enDesc:
3774     Newly created Perl code object.
3775     @@@PerlDef:
3776     __DEEP{
3777     $r = <ClassM::ManakaiPerlInlineUnparsedCode.newObject>;
3778     __CODE{ManakaiNode:getNewReference::
3779     $object => $r, $ref => $r,
3780     $class => {<ClassName::ManakaiPerlInlineUnparsedCode>}}__;
3781 wakaba 1.7 $r-><AS::ManakaiPerlInlineUnparsedCode.code> ($codeArg)
3782 wakaba 1.6 if defined $codeArg;
3783     }__;
3784    
3785     @Method:
3786     @@Name: createPerlBare
3787     @@enDesc:
3788     Creates a new <Class::ManakaiPerlBare> object.
3789     @@Param:
3790     @@@Name: codeArg
3791     @@@Type:
3792     lang:Perl::ManakaiDOM:all
3793     @@@enDesc:
3794     The code fragment.
3795     @@Return:
3796     @@@Type:ManakaiPerlBare
3797     @@@enDesc:
3798     Newly created Perl code object.
3799     @@@PerlDef:
3800     __DEEP{
3801     $r = <ClassM::ManakaiPerlBare.newObject>;
3802     __CODE{ManakaiNode:getNewReference::
3803     $object => $r, $ref => $r,
3804     $class => {<ClassName::ManakaiPerlBare>}}__;
3805 wakaba 1.7 $r-><AS::ManakaiPerlBare.code> ($codeArg);
3806 wakaba 1.6 }__;
3807    
3808     @Method:
3809     @@Name: createPerlAtom
3810     @@enDesc:
3811     Creates a new <Class::ManakaiPerlAtom> object.
3812     @@Param:
3813     @@@Name: codeArg
3814     @@@Type:
3815     lang:Perl::ManakaiDOM:all
3816     @@@enDesc:
3817     The code fragment.
3818     @@Return:
3819     @@@Type:ManakaiPerlAtom
3820     @@@enDesc:
3821     Newly created Perl code object.
3822     @@@PerlDef:
3823     __DEEP{
3824     $r = <ClassM::ManakaiPerlAtom.newObject>;
3825     __CODE{ManakaiNode:getNewReference::
3826     $object => $r, $ref => $r,
3827     $class => {<ClassName::ManakaiPerlAtom>}}__;
3828 wakaba 1.7 $r-><AS::ManakaiPerlBare.code> ($codeArg);
3829 wakaba 1.6 }__;
3830    
3831     @Method:
3832     @@Name: createPerlStringLiteral
3833     @@enDesc:
3834     Creates a new <Class::ManakaiPerlStringLiteral> object.
3835     @@Param:
3836     @@@Name: stringArg
3837     @@@Type:
3838     DISLang:String::ManakaiDOM:all
3839     @@@enDesc: A string.
3840     @@Return:
3841     @@@Type:ManakaiPerlStringLiteral
3842     @@@enDesc:
3843     Newly created Perl code object.
3844     @@@PerlDef:
3845     __DEEP{
3846     $r = <ClassM::ManakaiPerlStringLiteral.newObject>;
3847     __CODE{ManakaiNode:getNewReference::
3848     $object => $r, $ref => $r,
3849     $class => {<ClassName::ManakaiPerlStringLiteral>}}__;
3850 wakaba 1.7 $r-><AS::ManakaiPerlStringLiteral.data> ($stringArg);
3851 wakaba 1.6 }__;
3852    
3853     @Method:
3854     @@Name: createPerlVariable
3855     @@enDesc:
3856     Creates a new <Class::ManakaiPerlVariable> object.
3857     @@Param:
3858     @@@Name: variableType
3859     @@@Type:
3860     DISLang:String::ManakaiDOM:all
3861     @@@enDesc:
3862     Variable prefix.
3863 wakaba 1.16 @@@nullCase:
3864     @@@@enDesc:
3865     If the <P::packageName> is <DOM::null>, then
3866     the <P::variableType> is detected by the prefix of
3867     <P::localName>. Otherwise, it is an unprefixed variable
3868     such as file handle.
3869 wakaba 1.6 @@Param:
3870     @@@Name: packageName
3871     @@@Type:
3872     Perl:package-name::ManakaiDOM:all
3873     @@@enDesc:
3874     Package name.
3875     @@@nullCase:
3876     @@@@enDesc:
3877     The variable belongs to the current package or a
3878     lexical-scoped variable.
3879     @@Param:
3880     @@@Name: localName
3881     @@@Type:
3882     DISLang:String::ManakaiDOM:all
3883     @@@enDesc:
3884 wakaba 1.16 Variable name. If both <P::variableType> and <P::packageName>
3885     is <DOM::null>, the <P::localName> value may be prefixed
3886     by any possible <P::variableType> value.
3887 wakaba 1.6 @@Return:
3888     @@@Type:ManakaiPerlVariable
3889     @@@enDesc:
3890     Newly created Perl variable object.
3891     @@@PerlDef:
3892     __DEEP{
3893     $r = <ClassM::ManakaiPerlVariable.newObject>;
3894     __CODE{ManakaiNode:getNewReference::
3895     $object => $r, $ref => $r,
3896     $class => {<ClassName::ManakaiPerlVariable>}}__;
3897 wakaba 1.16 if (not $variableType and not $packageName and
3898     $localName =~ s/^(\\?[\$\@%&*])//) {
3899     $variableType = $1;
3900     }
3901 wakaba 1.7 $r-><AS::ManakaiPerlVariable.variableType> ($variableType);
3902     $r-><AS::ManakaiPerlVariable.packageName> ($packageName);
3903     $r-><AS::ManakaiPerlVariable.localName> ($localName);
3904 wakaba 1.8 }__;
3905    
3906     @Method:
3907     @@Name: createPerlBlock
3908     @@enDesc:
3909     Creates a new <Class::ManakaiPerlBlock> object.
3910     @@Return:
3911     @@@Type:ManakaiPerlBlock
3912     @@@enDesc:
3913     Newly created Perl code object.
3914     @@@PerlDef:
3915     __DEEP{
3916     $r = <ClassM::ManakaiPerlBlock.newObject>;
3917     __CODE{ManakaiNode:getNewReference::
3918     $object => $r, $ref => $r,
3919     $class => {<ClassName::ManakaiPerlBlock>}}__;
3920 wakaba 1.5 }__;
3921 wakaba 1.9
3922     @Method:
3923     @@Name: createPerlBlockContainer
3924     @@enDesc:
3925     Creates a new <Class::ManakaiPerlBlockContainer> object.
3926     @@Return:
3927     @@@Type:ManakaiPerlBlockContainer
3928     @@@enDesc:
3929     Newly created Perl code object.
3930     @@@PerlDef:
3931     __DEEP{
3932     $r = <ClassM::ManakaiPerlBlockContainer.newObject>;
3933     __CODE{ManakaiNode:getNewReference::
3934     $object => $r, $ref => $r,
3935     $class => {<ClassName::ManakaiPerlBlockContainer>}}__;
3936     }__;
3937 wakaba 1.11
3938     @Method:
3939     @@Name: createPerlStatement
3940     @@enDesc:
3941     Creates a new Perl statement.
3942     @@Param:
3943     @@@Name: codeArg
3944     @@@Type:
3945     lang:Perl::ManakaiDOM:all
3946     @@@enDesc:
3947     A Perl statement without terminating <Perl::;>.
3948     @@@nullCase:
3949     @@@@enDesc:
3950     No initial content.
3951     @@Return:
3952     @@@Type: ManakaiPerlStatement
3953     @@@enDesc:
3954     The newly created Perl code object.
3955     @@@PerlDef:
3956     $r = <ClassM::ManakaiPerlStatement.newObject>;
3957     __CODE{ManakaiNode:getNewReference::
3958     $object => $r, $ref => $r,
3959     $class =>{<ClassName::ManakaiPerlStatement>},
3960     }__;
3961     if (defined $codeArg) {
3962     __DEEP{
3963     $r-><M::ManakaiPerlAnyContainer.appendBare> ($codeArg);
3964     }__;
3965     }
3966 wakaba 1.12
3967     @Method:
3968     @@Name: createPerlIf
3969     @@enDesc:
3970     Creates a <Class::ManakaiPerlIf> object.
3971     @@Param:
3972     @@@Name: conditionArg
3973     @@@Type: ManakaiPerlCodeFragment
3974     @@@enDesc:
3975     Conditoon code fragment object.
3976     @@Param:
3977     @@@Name: trueArg
3978     @@@Type: ManakaiPerlCodeFragment
3979     @@@enDesc:
3980     A true code fragment object.
3981     @@@nullCase:
3982     @@@@enDesc: No true code.
3983     @@Param:
3984     @@@Name: falseArg
3985     @@@Type: ManakaiPerlCodeFragment
3986     @@@enDesc:
3987     A false code fragment object.
3988     @@@nullCase:
3989     @@@@enDesc: No false code.
3990     @@Return:
3991 wakaba 1.21 @@@Type: ManakaiPerlIf
3992 wakaba 1.12 @@@RaiseException:
3993     @@@@@:BAD_CHILD_ERR
3994     @@@@enDesc:
3995     An attempt is made to append a child
3996     that is not valid type.
3997     @@@RaiseException:
3998     @@@@@:IN_USE_NODE_ERR
3999     @@@@enDesc:
4000     An attempt is made to append a node that is
4001     already used elsewhere.
4002     @@@PerlDef:
4003     for my $arg ([conditionArg => $conditionArg]) {
4004     if ({
4005     atom => 1, bare => 1, incontainer => 1, assign => true,
4006     inunparsed => 1, variable => 1, string => true,
4007     }->{$arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:nodeType>}}) {
4008     if ($arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
4009     __EXCEPTION{IN_USE_NODE_ERR::
4010     pc:childNode => {$arg->[1]},
4011     MDOMX:param-name => {$arg->[0]},
4012     }__;
4013     }
4014     } else {
4015     __EXCEPTION{BAD_CHILD_ERR::
4016     pc:parentNode => {$self},
4017     pc:childNode => {$arg->[1]},
4018     MDOMX:param-name => {$arg->[0]},
4019     }__;
4020     }
4021     } # c
4022    
4023     for my $arg ([trueArg => $trueArg],
4024     [falseArg => $falseArg]) {
4025     next unless $arg->[1];
4026     if ({
4027     blockcontainer => true,
4028     }->{$arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:nodeType>}}) {
4029     if ($arg->[1]->{<Q::TreeCore:node>}->{<Q::pc:parent>}) {
4030     __EXCEPTION{IN_USE_NODE_ERR::
4031     pc:childNode => {$arg->[1]},
4032     MDOMX:param-name => {$arg->[0]},
4033     }__;
4034     }
4035     } else {
4036     __EXCEPTION{BAD_CHILD_ERR::
4037     pc:parentNode => {$self},
4038     pc:childNode => {$arg->[1]},
4039     MDOMX:param-name => {$arg->[0]},
4040     }__;
4041     }
4042     } # t/f
4043    
4044     my $assign = <ClassM::ManakaiPerlIf.newObject>;
4045     $assign->{<Q::pc:condition>} = $conditionArg->{<Q::TreeCore:node>};
4046     $assign->{<Q::pc:true>} = $trueArg->{<Q::TreeCore:node>} if $trueArg;
4047     $assign->{<Q::pc:false>} = $falseArg->{<Q::TreeCore:node>} if $falseArg;
4048 wakaba 1.21 $assign-><M::MNodeObject.importTree> ($_)
4049 wakaba 1.12 for (grep {$_}
4050     $assign->{<Q::pc:condition>}, $assign->{<Q::pc:true>},
4051     $assign->{<Q::pc:false>});
4052     $conditionArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign;
4053     $trueArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign if $trueArg;
4054     $falseArg->{<Q::TreeCore:node>}->{<Q::pc:parent>} = $assign if $falseArg;
4055 wakaba 1.21 if (defined wantarray) {
4056     __CODE{ManakaiNode:getNewReference::
4057     $object => $assign, $ref => $r,
4058     $class =>{<ClassName::ManakaiPerlIf>},
4059     }__;
4060     }
4061 wakaba 1.1 ##PerlCodeImplementation
4062    
4063 wakaba 1.5 ResourceDef:
4064     @QName: MNodeObject
4065     @rdf:type:
4066     ManakaiDOM:Class
4067     @AliasFor:
4068     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
4069    
4070 wakaba 1.1 PropDef:
4071     @QName: code
4072     @enDesc: Perl code.
4073    
4074     PropDef:
4075     @QName: sourceFile
4076     @enDesc:
4077     Source file.
4078    
4079     PropDef:
4080     @QName: sourceLine
4081     @enDesc:
4082     Source line number.
4083 wakaba 1.10
4084     PropDef:
4085     @QName: currentSourceFile
4086     @enDesc:
4087     <QUOTE::Current> source file.
4088    
4089     PropDef:
4090     @QName: currentSourceLine
4091     @enDesc:
4092     <QUOTE::Current> source line number.
4093 wakaba 1.1
4094     PropDef:
4095     @QName: prototype
4096     @enDesc:
4097     Prototype of subroutine.
4098    
4099     PropDef:
4100     @QName: parent
4101     @enDesc:
4102     Higher-level object.
4103    
4104     PropDef:
4105     @QName: sub
4106     @enDesc:
4107     Perl subroutines.
4108    
4109     PropDef:
4110     @QName: packageName
4111     @Type:
4112 wakaba 1.12 Perl:package-name::ManakaiDOM:all
4113 wakaba 1.1 @enDesc:
4114     The fully qualified names of packages.
4115    
4116     PropDef:
4117     @QName: childNodes
4118     @enDesc:
4119     Child code fragments.
4120    
4121     PropDef:
4122     @QName: localName
4123     @enDesc:
4124     Scoped names.
4125 wakaba 1.4
4126     ## -- Exceptions
4127    
4128     ExceptionDef:
4129     @ClsQName: ManakaiPerlCodeException
4130     @enDesc:
4131     Exceptions for the <Module::PerlCode> module.
4132     @ClsISA:
4133     ManakaiDOM:ManakaiDOMException::ManakaiDOM:Perl
4134     @XConstGroupDef:
4135     @@ClsQName: ManakaiPerlCodeExceptionCode
4136     @@enDesc:
4137     Exception codes for <Class::ManakaiPerlCodeException>.
4138 wakaba 1.5 @@XConstDef:
4139     @@@Name: HIERARCHY_REQUEST_ERR
4140     @@@Value:3
4141     @@@enDesc:
4142     An attempt is made to break the hierarchy.
4143     @@@XSubTypeDef:
4144     @@@@QName: BAD_CHILD_ERR
4145     @@@@enDesc:
4146     An attempt is made to append a node as a child whose type
4147     is not allowed.
4148     @@@@XParam:
4149     @@@@@QName: childNode
4150     @@@@@enDesc:
4151     The node attempted to append.
4152     @@@@XParam:
4153     @@@@@QName: parentNode
4154     @@@@@enDesc:
4155     The node to whose child list an attempt to append is made.
4156     @@@XSubTypeDef:
4157     @@@@QName: IN_USE_NODE_ERR
4158     @@@@enDesc:
4159     An attempt is made to append a node that has already been used
4160     elsewhere.
4161     @@@@XParam:
4162     @@@@@QName: childNode
4163     @@@@@enDesc:
4164     The node attempted to append.
4165     @@@@XParam:
4166     @@@@@QName: parentNode
4167     @@@@@enDesc:
4168     The parent node of the <XP::childNode>.
4169 wakaba 1.4 @@XConstDef:
4170     @@@Name: NOT_SUPPORTED_ERR
4171     @@@Value:9
4172     @@@enDesc:
4173     An attempt is made to do something the implementation does not support.
4174     @@@XSubTypeDef:
4175     @@@@QName: UNSUPPORTED_OPERATOR_ERR
4176     @@@@enDesc:
4177     The implementation does not support the specified operator.
4178     @@@@XParam:
4179     @@@@@QName: operator
4180     @@@@@enDesc:
4181     The operator that is not supported.
4182     @@@@enMufDef:
4183     Operator "%p (name => {<Q::pc:operator>});" is not supported
4184    
4185     ElementTypeBinding:
4186     @Name: ExceptionDef
4187     @ElementType:
4188     dis:ResourceDef
4189     @ShadowContent:
4190     @@rdf:type:
4191     ManakaiDOM:ExceptionClass
4192     @@AliasFor:
4193     @@@@:
4194     ::ManakaiDOM:Perl
4195     @@@For:
4196     !=ManakaiDOM:Perl
4197     @@ForCheck:
4198     ManakaiDOM:Perl
4199     @@DOMMain:implementFeature: CoreFeature10
4200    
4201     ElementTypeBinding:
4202     @Name: XConstGroupDef
4203     @ElementType:
4204     dis:ResourceDef
4205     @ShadowContent:
4206     @@rdf:type:
4207     ManakaiDOM:ConstGroup
4208     @@Type:
4209     DOMMain:unsigned-short::ManakaiDOM:all
4210     @@rdfs:subClassOf:
4211     DOMMain:unsigned-short::ManakaiDOM:all
4212    
4213     ElementTypeBinding:
4214     @Name: XConstDef
4215     @ElementType:
4216     dis:ResourceDef
4217     @ShadowContent:
4218     @@rdf:type:
4219     ManakaiDOM:Const
4220    
4221     ElementTypeBinding:
4222     @Name: XSubTypeDef
4223     @ElementType:
4224     dis:ResourceDef
4225     @ShadowContent:
4226     @@rdf:type:
4227     ManakaiDOM:ExceptionOrWarningSubType
4228    
4229     ElementTypeBinding:
4230     @Name: XParam
4231     @ElementType:
4232     ManakaiDOM:exceptionOrWarningParameter
4233    
4234     ElementTypeBinding:
4235     @Name: XParamDef
4236     @ElementType:
4237     dis:ResourceDef
4238     @ShadowContent:
4239     @@rdf:type:
4240     DOMMain:XWParameter
4241     @@AliasFor:
4242     @@@For:
4243     !=ManakaiDOM:all
4244     @@@@:
4245     ::ManakaiDOM:all
4246    
4247     ElementTypeBinding:
4248     @Name: enMufDef
4249     @ElementType:
4250     dis:Def
4251     @ShadowContent:
4252     @@ContentType:
4253     lang:muf
4254     @@lang:en
4255    
4256 wakaba 1.1
4257     ElementTypeBinding:
4258     @Name: ClsDef
4259     @ElementType:
4260     dis:ResourceDef
4261     @ShadowContent:
4262     @@rdf:type:
4263     ManakaiDOM:Class
4264     @@AliasFor:
4265     @@@@:
4266     ::ManakaiDOM:Perl
4267     @@@For:
4268     !=ManakaiDOM:Perl
4269     @@ForCheck:
4270     ManakaiDOM:Perl
4271     @@DOMMain:implementFeature: CoreFeature10
4272    
4273     ElementTypeBinding:
4274     @Name: ClsQName
4275     @ElementType:
4276     dis:QName
4277    
4278     ElementTypeBinding:
4279     @Name: ClsISA
4280     @ElementType:
4281     dis:ISA
4282    
4283     ElementTypeBinding:
4284     @Name: Method
4285     @ElementType:
4286     dis:ResourceDef
4287     @ShadowContent:
4288     @@rdf:type:
4289     DISLang:Method
4290    
4291     ElementTypeBinding:
4292     @Name: ToStringMethod
4293     @ElementType:
4294     dis:ResourceDef
4295     @ShadowContent:
4296     @@rdf:type:
4297     DISLang:Method
4298     @@Operator:
4299     @@@@:
4300     DISPerl:AsStringMethod
4301     @@@ContentType:
4302     dis:TypeQName
4303     @@Description:
4304     @@@lang:en
4305     @@@@:
4306     Returns the textual Perl source code representation of this object.
4307 wakaba 1.9
4308 wakaba 1.14 ElementTypeBinding:
4309     @Name: NumValMethod
4310     @ElementType:
4311     dis:ResourceDef
4312     @ShadowContent:
4313     @@rdf:type:
4314     DISLang:Method
4315     @@Operator:
4316     @@@@: 0+
4317     @@@ContentType:
4318     lang:Perl
4319     @@Description:
4320     @@@lang:en
4321     @@@@:
4322     Returns the numeric value of this object.
4323 wakaba 1.9
4324     ElementTypeBinding:
4325     @Name: IntCloneMethod
4326     @ElementType:
4327     dis:ResourceDef
4328     @ShadowContent:
4329     @@rdf:type:
4330     DISLang:Method
4331     @@Name: makeCloneObject
4332     @@Description:
4333     @@@lang:en
4334     @@@@:
4335     Returns the node object of a deep clone of a node object.
4336     @@ManakaiDOM:isStatic:1
4337     @@ManakaiDOM:isForInternal:1
4338     @@ResourceDef:
4339     @@@rdf:type:
4340     DISLang:MethodParameter
4341     @@@Name: nodeObject
4342     @@@Type:
4343     ManakaiDOM:ManakaiDOMNodeObject::ManakaiDOM:Perl
4344     @@@Description:
4345     @@@@lang:en
4346     @@@@@: Node object to copy.
4347     @ShadowSibling:
4348     @@ResourceDef:
4349     @@@rdf:type:
4350     DISLang:Method
4351     @@@Operator:
4352     @@@@@:
4353     DISPerl:CloneMethod
4354     @@@@ContentType:
4355     dis:TypeQName
4356     @@@Description:
4357     @@@@lang:en
4358     @@@@@:
4359     Generates a deep clone of this node and returns it.
4360     @@@ResourceDef:
4361     @@@@rdf:type:
4362     DISLang:MethodReturn
4363     @@@@Type: ManakaiPerlCodeFragment
4364     @@@@Description:
4365     @@@@@lang:en
4366     @@@@@@:
4367     The newly created clone node.
4368     \
4369     {NOTE:: The <A::.parentNode> attribute of the clone
4370     is set to <DOM::null>.
4371     \
4372     }
4373     @@@@Def:
4374     @@@@@ContentType:
4375     lang:Perl
4376     @@@@@@:
4377     ## NOTE: Method name directly written
4378     my $ro = $self->_make_clone_object ($self->{<Q::TreeCore:node>});
4379     $ro-><M::ManakaiDOM:ManakaiDOMNodeObject
4380     ::ManakaiDOM:Perl.changeTreeID>
4381     (<Code::ManakaiDOM:generateUniqueID
4382     ::ManakaiDOM:Perl>);
4383     $r = <ClassM::ManakaiPerlCodeFragment.getNodeReference> ($ro);
4384 wakaba 1.1
4385     ElementTypeBinding:
4386     @Name: IntMethod
4387     @ElementType:
4388     dis:ResourceDef
4389     @ShadowContent:
4390     @@rdf:type:
4391     DISLang:Method
4392     @@ManakaiDOM:isForInternal:1
4393    
4394     ElementTypeBinding:
4395     @Name: Attr
4396     @ElementType:
4397     dis:ResourceDef
4398     @ShadowContent:
4399     @@rdf:type:
4400     DISLang:Attribute
4401    
4402     ElementTypeBinding:
4403     @Name: Return
4404     @ElementType:
4405     dis:ResourceDef
4406     @ShadowContent:
4407     @@rdf:type:
4408     DISLang:MethodReturn
4409    
4410     ElementTypeBinding:
4411     @Name: Get
4412     @ElementType:
4413     dis:ResourceDef
4414     @ShadowContent:
4415     @@rdf:type:
4416     DISLang:AttributeGet
4417    
4418     ElementTypeBinding:
4419     @Name: Set
4420     @ElementType:
4421     dis:ResourceDef
4422     @ShadowContent:
4423     @@rdf:type:
4424     DISLang:AttributeSet
4425    
4426     ElementTypeBinding:
4427     @Name: Param
4428     @ElementType:
4429     dis:ResourceDef
4430     @ShadowContent:
4431     @@rdf:type:
4432     DISLang:MethodParameter
4433    
4434     ElementTypeBinding:
4435     @Name: PerlDef
4436     @ElementType:
4437     dis:Def
4438     @ShadowContent:
4439     @@ContentType:
4440     lang:Perl
4441    
4442     ElementTypeBinding:
4443     @Name: disDef
4444     @ElementType:
4445     dis:Def
4446     @ShadowContent:
4447     @@ContentType:
4448     lang:dis
4449    
4450     ElementTypeBinding:
4451     @Name: InCase
4452     @ElementType:
4453     dis:ResourceDef
4454     @ShadowContent:
4455     @@rdf:type:
4456     ManakaiDOM:InCase
4457    
4458     ElementTypeBinding:
4459     @Name: nullCase
4460     @ElementType:
4461     dis:ResourceDef
4462     @ShadowContent:
4463     @@rdf:type:
4464     ManakaiDOM:InCase
4465     @@Value:
4466     @@@is-null:1
4467    
4468     ElementTypeBinding:
4469     @Name: TrueCase
4470     @ElementType:
4471     dis:ResourceDef
4472     @ShadowContent:
4473     @@rdf:type:
4474     ManakaiDOM:InCase
4475     @@Value:true
4476     @@Type:
4477 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
4478 wakaba 1.1
4479    
4480     ElementTypeBinding:
4481     @Name: FalseCase
4482     @ElementType:
4483     dis:ResourceDef
4484     @ShadowContent:
4485     @@rdf:type:
4486     ManakaiDOM:InCase
4487     @@Value:false
4488     @@Type:
4489 wakaba 1.12 DOMMain:boolean::ManakaiDOM:all
4490 wakaba 1.1
4491     ElementTypeBinding:
4492     @Name: enDesc
4493     @ElementType:
4494     dis:Description
4495     @ShadowContent:
4496     @@lang:en
4497    
4498     ElementTypeBinding:
4499     @Name: PropDef
4500     @ElementType:
4501     dis:ResourceDef
4502     @ShadowContent:
4503     @@rdf:type:
4504     rdf:Property
4505     @@AliasFor:
4506     @@@@:
4507     ::ManakaiDOM:all
4508     @@@For:
4509     !=ManakaiDOM:all
4510    
4511     ElementTypeBinding:
4512     @Name: NamedParam
4513     @ElementType:
4514     dis:ResourceDef
4515     @ShadowContent:
4516     @@rdf:type:
4517     DISLang:MethodParameter
4518     @@DISPerl:isNamedParameter:1
4519    

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24