/[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.24 - (hide annotations) (download)
Mon Sep 5 05:21:12 2005 UTC (19 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.23: +8 -4 lines
New DOMFeature module introduced

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24