1# Do not edit this file - Generated by Perlito6 9.0 2use v5; 3use utf8; 4use strict; 5use warnings; 6no warnings ('redefine', 'once', 'void', 'uninitialized', 'misc', 'recursion'); 7use Perlito6::Perl5::Runtime; 8use Perlito6::Perl5::Prelude; 9our $MATCH = Perlito6::Match->new(); 10{ 11package GLOBAL; 12 sub new { shift; bless { @_ }, "GLOBAL" } 13 14 # use v6 15; 16 { 17 package Perlito6::Clojure::LexicalBlock; 18 sub new { shift; bless { @_ }, "Perlito6::Clojure::LexicalBlock" } 19 sub block { $_[0]->{block} }; 20 sub emit_clojure { 21 my $self = $_[0]; 22 if (!(((defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))))) { 23 return scalar ('nil') 24 }; 25 ((my $str) = ''); 26 ((my $has_my_decl) = 0); 27 ((my $my_decl) = ''); 28 for my $decl ( @{(defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))} ) { 29 if ((Main::isa($decl, 'Decl') && (($decl->decl() eq 'my')))) { 30 ($has_my_decl = 1); 31 ($my_decl = ($my_decl . '(' . ($decl->var())->emit_clojure() . ' (sv-undef))')) 32 }; 33 if (((Main::isa($decl, 'Bind') && Main::isa(($decl->parameters()), 'Decl')) && ((($decl->parameters())->decl() eq 'my')))) { 34 ($has_my_decl = 1); 35 ($my_decl = ($my_decl . '(' . (($decl->parameters())->var())->emit_clojure() . ' (sv-undef))')) 36 } 37 }; 38 if ($has_my_decl) { 39 ($str = ($str . '(let (' . $my_decl . ') ')) 40 } 41 else { 42 ($str = ($str . '(do ')) 43 }; 44 for my $decl ( @{(defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))} ) { 45 if ((!(((Main::isa($decl, 'Decl') && (($decl->decl() eq 'my'))))))) { 46 ($str = ($str . ($decl)->emit_clojure())) 47 } 48 }; 49 return scalar (($str . ')')) 50 } 51 } 52 53; 54 { 55 package CompUnit; 56 sub new { shift; bless { @_ }, "CompUnit" } 57 sub attributes { $_[0]->{attributes} }; 58 sub methods { $_[0]->{methods} }; 59 sub emit_clojure { 60 my $self = $_[0]; 61 ((my $class_name) = Main::to_lisp_namespace($self->{name})); 62 ((my $str) = (chr(59) . chr(59) . ' class ' . $self->{name} . (chr(10)))); 63 ($str = ($str . '(defpackage ' . $class_name . (chr(10)) . ' (:use common-lisp mp-Main))' . (chr(10)) . chr(59) . chr(59) . ' (in-package ' . $class_name . ')' . (chr(10)))); 64 ((my $has_my_decl) = 0); 65 ((my $my_decl) = ''); 66 for my $decl ( @{(defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))} ) { 67 if ((Main::isa($decl, 'Decl') && (($decl->decl() eq 'my')))) { 68 ($has_my_decl = 1); 69 ($my_decl = ($my_decl . '(' . ($decl->var())->emit_clojure() . ' (sv-undef))')) 70 }; 71 if (((Main::isa($decl, 'Bind') && Main::isa(($decl->parameters()), 'Decl')) && ((($decl->parameters())->decl() eq 'my')))) { 72 ($has_my_decl = 1); 73 ($my_decl = ($my_decl . '(' . (($decl->parameters())->var())->emit_clojure() . ' (sv-undef))')) 74 } 75 }; 76 if ($has_my_decl) { 77 ($str = ($str . '(let (' . $my_decl . ')' . (chr(10)))) 78 }; 79 ($str = ($str . '(if (not (ignore-errors (find-class ' . chr(39) . $class_name . ')))' . chr(10) . ' (defclass ' . $class_name . ' () ()))' . chr(10) . chr(10) . '(let (x) ' . chr(10) . ' (setq x (make-instance ' . chr(39) . $class_name . '))' . chr(10) . ' (defun proto-' . $class_name . ' () x))' . chr(10))); 80 ((my $dumper) = ''); 81 for my $decl ( @{(defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))} ) { 82 if ((Main::isa($decl, 'Decl') && (($decl->decl() eq 'has')))) { 83 ((my $accessor_name) = ($decl->var())->name()); 84 ($dumper = ($dumper . '(let ((m (make-instance ' . chr(39) . 'mp-Pair))) ' . '(setf (sv-key m) ' . chr(34) . Main::lisp_escape_string($accessor_name) . chr(34) . ') ' . '(setf (sv-value m) (' . Main::to_lisp_identifier($accessor_name) . ' self)) m) ')); 85 ($str = ($str . chr(59) . chr(59) . ' has ' . chr(36) . '.' . $accessor_name . chr(10) . '(let ((new-slots (list (list :name ' . chr(39) . Main::to_lisp_identifier($accessor_name) . chr(10) . ' :readers ' . chr(39) . '(' . Main::to_lisp_identifier($accessor_name) . ')' . chr(10) . ' :writers ' . chr(39) . '((setf ' . Main::to_lisp_identifier($accessor_name) . '))' . chr(10) . ' :initform ' . chr(39) . '(sv-undef)' . chr(10) . ' :initfunction (constantly (sv-undef))))))' . chr(10) . '(dolist (slot-defn (sb-mop:class-direct-slots (find-class ' . chr(39) . $class_name . ')))' . chr(10) . '(push (list :name (sb-mop:slot-definition-name slot-defn)' . chr(10) . ' :readers (sb-mop:slot-definition-readers slot-defn)' . chr(10) . ' :writers (sb-mop:slot-definition-writers slot-defn)' . chr(10) . ' :initform (sb-mop:slot-definition-initform slot-defn)' . chr(10) . ' :initfunction (sb-mop:slot-definition-initfunction slot-defn))' . chr(10) . 'new-slots))' . chr(10) . '(sb-mop:ensure-class ' . chr(39) . $class_name . ' :direct-slots new-slots))' . chr(10) . chr(10))) 86 }; 87 if (Main::isa($decl, 'Method')) { 88 ((my $sig) = $decl->sig()); 89 ((my $invocant) = $sig->invocant()); 90 ((my $pos) = $sig->positional()); 91 ((my $str_specific) = ('(' . $invocant->emit_clojure() . ' ' . $class_name . ')')); 92 ((my $str_optionals) = ''); 93 for my $field ( @{($pos)} ) { 94 ($str_optionals = ($str_optionals . ' ' . $field->emit_clojure())) 95 }; 96 if (($str_optionals)) { 97 ($str_specific = ($str_specific . ' ' . chr(38) . 'optional' . $str_optionals)) 98 }; 99 ((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => $decl->block()))); 100 ($str = ($str . chr(59) . chr(59) . ' method ' . $decl->name() . chr(10) . '(if (not (ignore-errors (find-method ' . chr(39) . Main::to_lisp_identifier($decl->name()) . ' () ())))' . chr(10) . ' (defmulti ' . Main::to_lisp_identifier($decl->name()) . ' class)' . chr(10) . '(defmethod ' . Main::to_lisp_identifier($decl->name()) . ' [' . $str_specific . ']' . chr(10) . ' (block mp6-function' . chr(10) . ' ' . $block->emit_clojure() . '))' . chr(10) . chr(10))) 101 }; 102 if (Main::isa($decl, 'Sub')) { 103 ($str = ($str . '(in-package ' . $class_name . ')' . (chr(10)) . ' ' . ($decl)->emit_clojure() . (chr(10)) . '(in-package mp-Main)' . (chr(10)))) 104 } 105 }; 106 if (($self->{name} ne 'Pair')) { 107 ($str = ($str . '(defmethod sv-perl ((self ' . $class_name . '))' . (chr(10)) . ' (mp-Main::sv-lisp_dump_object ' . chr(34) . '::' . Main::lisp_escape_string($self->{name}) . chr(34) . ' (list ' . $dumper . ')))' . (chr(10)) . (chr(10)))) 108 }; 109 for my $decl ( @{(defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))} ) { 110 if ((((!(((Main::isa($decl, 'Decl') && (((($decl->decl() eq 'has')) || (($decl->decl() eq 'my')))))))) && (!((Main::isa($decl, 'Method'))))) && (!((Main::isa($decl, 'Sub')))))) { 111 ($str = ($str . ($decl)->emit_clojure() . (chr(10)))) 112 } 113 }; 114 if ($has_my_decl) { 115 ($str = ($str . ')')) 116 }; 117 ($str = ($str . (chr(10)) . (chr(10)))) 118 } 119 } 120 121; 122 { 123 package Val::Int; 124 sub new { shift; bless { @_ }, "Val::Int" } 125 sub emit_clojure { 126 my $self = $_[0]; 127 $self->{int} 128 } 129 } 130 131; 132 { 133 package Val::Bit; 134 sub new { shift; bless { @_ }, "Val::Bit" } 135 sub emit_clojure { 136 my $self = $_[0]; 137 $self->{bit} 138 } 139 } 140 141; 142 { 143 package Val::Num; 144 sub new { shift; bless { @_ }, "Val::Num" } 145 sub emit_clojure { 146 my $self = $_[0]; 147 $self->{num} 148 } 149 } 150 151; 152 { 153 package Val::Buf; 154 sub new { shift; bless { @_ }, "Val::Buf" } 155 sub emit_clojure { 156 my $self = $_[0]; 157 (chr(34) . Main::lisp_escape_string($self->{buf}) . chr(34)) 158 } 159 } 160 161; 162 { 163 package Lit::Array; 164 sub new { shift; bless { @_ }, "Lit::Array" } 165 sub emit_clojure { 166 my $self = $_[0]; 167 ((my $ast) = $self->expand_interpolation()); 168 return scalar ($ast->emit_clojure()) 169 } 170 } 171 172; 173 { 174 package Lit::Hash; 175 sub new { shift; bless { @_ }, "Lit::Hash" } 176 sub emit_clojure { 177 my $self = $_[0]; 178 ((my $ast) = $self->expand_interpolation()); 179 return scalar ($ast->emit_clojure()) 180 } 181 } 182 183; 184 { 185 package Index; 186 sub new { shift; bless { @_ }, "Index" } 187 sub emit_clojure { 188 my $self = $_[0]; 189 return scalar (('(elt ' . $self->{obj}->emit_clojure() . ' ' . $self->{index_exp}->emit_clojure() . ')')) 190 } 191 } 192 193; 194 { 195 package Lookup; 196 sub new { shift; bless { @_ }, "Lookup" } 197 sub emit_clojure { 198 my $self = $_[0]; 199 if (Main::isa($self->{obj}, 'Var')) { 200 if (((($self->{obj}->name() eq 'MATCH')) || (($self->{obj}->name() eq chr(47))))) { 201 return scalar (('(gethash ' . $self->{index_exp}->emit_clojure() . ' (sv-hash ' . $self->{obj}->emit_clojure() . '))')) 202 } 203 }; 204 return scalar (('(gethash ' . $self->{index_exp}->emit_clojure() . ' ' . $self->{obj}->emit_clojure() . ')')) 205 } 206 } 207 208; 209 { 210 package Var; 211 sub new { shift; bless { @_ }, "Var" } 212 sub emit_clojure { 213 my $self = $_[0]; 214 ((my $ns) = ''); 215 if ($self->{namespace}) { 216 ($ns = (Main::to_lisp_namespace($self->{namespace}) . '::')) 217 }; 218 ((($self->{twigil} eq '.')) ? (('(' . Main::to_lisp_identifier($self->{name}) . ' sv-self)')) : (((($self->{name} eq chr(47))) ? (Main::to_lisp_identifier('MATCH')) : (($ns . Main::to_lisp_identifier($self->{name})))))) 219 } 220 } 221 222; 223 { 224 package Bind; 225 sub new { shift; bless { @_ }, "Bind" } 226 sub emit_clojure { 227 my $self = $_[0]; 228 if ((Main::isa($self->{parameters}, 'Decl') && (($self->{parameters}->decl() eq 'my')))) { 229 return scalar (('(setf ' . ($self->{parameters}->var())->emit_clojure() . ' ' . $self->{arguments}->emit_clojure() . ')')) 230 }; 231 ('(setf ' . $self->{parameters}->emit_clojure() . ' ' . $self->{arguments}->emit_clojure() . ')') 232 } 233 } 234 235; 236 { 237 package Proto; 238 sub new { shift; bless { @_ }, "Proto" } 239 sub emit_clojure { 240 my $self = $_[0]; 241 ('(proto-' . Main::to_lisp_namespace($self->{name}) . ')') 242 } 243 } 244 245; 246 { 247 package Call; 248 sub new { shift; bless { @_ }, "Call" } 249 sub emit_clojure { 250 my $self = $_[0]; 251 ((my $arguments) = ''); 252 if ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))) { 253 ($arguments = Main::join(([ map { $_->emit_clojure() } @{( (defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY'))) )} ]), ' ')) 254 }; 255 ((my $invocant) = $self->{invocant}->emit_clojure()); 256 if (($invocant eq 'self')) { 257 ($invocant = 'sv-self') 258 }; 259 if ((($self->{method} eq 'values'))) { 260 if (($self->{hyper})) { 261 die(('not implemented')) 262 } 263 else { 264 return scalar ((chr(64) . chr(123) . $invocant . chr(125))) 265 } 266 }; 267 if (($self->{method} eq 'isa')) { 268 if (((((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[0])->buf()) eq 'Str')) { 269 return scalar (('(typep ' . $invocant . ' ' . chr(39) . 'string)')) 270 }; 271 return scalar (('(typep ' . $invocant . ' ' . chr(39) . Main::to_lisp_namespace(((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[0])->buf()) . ')')) 272 }; 273 if (($self->{method} eq 'chars')) { 274 if (($self->{hyper})) { 275 die(('not implemented')) 276 } 277 else { 278 return scalar (('(length ' . $invocant . ')')) 279 } 280 }; 281 if (((($self->{method} eq 'yaml')) || (($self->{method} eq 'say')))) { 282 if (($self->{hyper})) { 283 return scalar (('[ map ' . chr(123) . ' ' . $self->{method} . '( ' . chr(36) . '_, ' . ', ' . $arguments . ')' . ' ' . chr(125) . ' ' . chr(64) . chr(123) . ' ' . $invocant . ' ' . chr(125) . ' ]')) 284 } 285 else { 286 return scalar (('(' . $self->{method} . ' ' . $invocant . ' ' . $arguments . ')')) 287 } 288 }; 289 ((my $meth) = (Main::to_lisp_identifier($self->{method}) . ' ')); 290 if (($self->{method} eq 'postcircumfix:<( )>')) { 291 ($meth = '') 292 }; 293 if (($self->{hyper})) { 294 ('(mapcar ' . chr(35) . chr(39) . $meth . $invocant . ')') 295 } 296 else { 297 return scalar (('(' . $meth . $invocant . ' ' . $arguments . ')')) 298 } 299 } 300 } 301 302; 303 { 304 package Apply; 305 sub new { shift; bless { @_ }, "Apply" } 306 sub emit_clojure { 307 my $self = $_[0]; 308 ((my $ns) = ''); 309 if ($self->{namespace}) { 310 ($ns = (Main::to_lisp_namespace($self->{namespace}) . '::')) 311 }; 312 ((my $code) = ($ns . $self->{code})); 313 ((my $args) = ''); 314 if ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))) { 315 ($args = Main::join(([ map { $_->emit_clojure() } @{( (defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY'))) )} ]), ' ')) 316 }; 317 if (($code eq 'self')) { 318 return scalar ('sv-self') 319 }; 320 if (($code eq 'False')) { 321 return scalar ('nil') 322 }; 323 if (($code eq 'make')) { 324 return scalar (('(return-from mp6-function ' . $args . ')')) 325 }; 326 if (($code eq 'substr')) { 327 return scalar (('(sv-substr ' . $args . ')')) 328 }; 329 if (($code eq 'say')) { 330 return scalar (('(mp-Main::sv-say (list ' . $args . '))')) 331 }; 332 if (($code eq 'print')) { 333 return scalar (('(mp-Main::sv-print (list ' . $args . '))')) 334 }; 335 if (($code eq 'infix:<' . chr(126) . '>')) { 336 return scalar (('(concatenate ' . chr(39) . 'string (sv-string ' . ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[0])->emit_clojure() . ') (sv-string ' . ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[1])->emit_clojure() . '))')) 337 }; 338 if (($code eq 'warn')) { 339 return scalar (('(write-line (format nil ' . chr(34) . chr(126) . chr(123) . chr(126) . 'a' . chr(126) . chr(125) . chr(34) . ' (list ' . $args . ')) *error-output*)')) 340 }; 341 if (($code eq 'die')) { 342 return scalar (('(do (write-line (format nil ' . chr(34) . chr(126) . chr(123) . chr(126) . 'a' . chr(126) . chr(125) . chr(34) . ' (list ' . $args . ')) *error-output*) (sb-ext:quit))')) 343 }; 344 if (($code eq 'array')) { 345 return scalar ($args) 346 }; 347 if (($code eq 'prefix:<' . chr(126) . '>')) { 348 return scalar (('(sv-string ' . $args . ')')) 349 }; 350 if (($code eq 'prefix:<' . chr(33) . '>')) { 351 return scalar (('(not (sv-bool ' . $args . '))')) 352 }; 353 if (($code eq 'prefix:<' . chr(63) . '>')) { 354 return scalar (('(sv-bool ' . $args . ')')) 355 }; 356 if (($code eq 'prefix:<' . chr(36) . '>')) { 357 return scalar (('(sv-scalar ' . $args . ')')) 358 }; 359 if (($code eq 'prefix:<' . chr(64) . '>')) { 360 return scalar ($args) 361 }; 362 if (($code eq 'prefix:<' . chr(37) . '>')) { 363 return scalar ($args) 364 }; 365 if (($code eq 'infix:<+>')) { 366 return scalar (('(+ ' . $args . ')')) 367 }; 368 if (($code eq 'infix:<->')) { 369 return scalar (('(-' . $args . ')')) 370 }; 371 if (($code eq 'infix:<>>')) { 372 return scalar (('(> ' . $args . ')')) 373 }; 374 if (($code eq 'infix:<' . chr(38) . chr(38) . '>')) { 375 return scalar (('(sv-and ' . $args . ')')) 376 }; 377 if (($code eq 'infix:<' . chr(124) . chr(124) . '>')) { 378 return scalar (('(sv-or ' . $args . ')')) 379 }; 380 if (($code eq 'infix:<eq>')) { 381 return scalar (('(sv-eq ' . $args . ')')) 382 }; 383 if (($code eq 'infix:<ne>')) { 384 return scalar (('(not (sv-eq ' . $args . '))')) 385 }; 386 if (($code eq 'infix:<' . chr(61) . chr(61) . '>')) { 387 return scalar (('(eql ' . $args . ')')) 388 }; 389 if (($code eq 'infix:<' . chr(33) . chr(61) . '>')) { 390 return scalar (('(not (eql ' . $args . '))')) 391 }; 392 if (($code eq 'ternary:<' . chr(63) . chr(63) . ' ' . chr(33) . chr(33) . '>')) { 393 return scalar (('(if (sv-bool ' . ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[0])->emit_clojure() . ') ' . ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[1])->emit_clojure() . ' ' . ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[2])->emit_clojure() . ')')) 394 }; 395 return scalar (('(' . $ns . Main::to_lisp_identifier($self->{code}) . ' ' . $args . ')')) 396 } 397 } 398 399; 400 { 401 package Return; 402 sub new { shift; bless { @_ }, "Return" } 403 sub emit_clojure { 404 my $self = $_[0]; 405 return scalar (('(return-from mp6-function ' . $self->{result}->emit_clojure() . ')')) 406 } 407 } 408 409; 410 { 411 package If; 412 sub new { shift; bless { @_ }, "If" } 413 sub emit_clojure { 414 my $self = $_[0]; 415 ((my $block1) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))))); 416 ((my $block2) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{otherwise} ? $self->{otherwise} : ($self->{otherwise} ||= bless([], 'ARRAY')))))); 417 ('(if (sv-bool ' . $self->{cond}->emit_clojure() . ') ' . $block1->emit_clojure() . ' ' . $block2->emit_clojure() . ')') 418 } 419 } 420 421; 422 { 423 package For; 424 sub new { shift; bless { @_ }, "For" } 425 sub emit_clojure { 426 my $self = $_[0]; 427 ((my $cond) = $self->{cond}); 428 ((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))))); 429 if ((Main::isa($cond, 'Var') && ($cond->sigil() eq chr(64)))) { 430 ($cond = Apply->new(('code' => 'prefix:<' . chr(64) . '>'), ('arguments' => do { 431 (my $List_a = bless [], 'ARRAY'); 432 (my $List_v = bless [], 'ARRAY'); 433 push( @{$List_a}, $cond ); 434 $List_a 435}))) 436 }; 437 ('(dolist (' . $self->{topic}->emit_clojure() . ' ' . $cond->emit_clojure() . ') ' . $block->emit_clojure() . ')') 438 } 439 } 440 441; 442 { 443 package Decl; 444 sub new { shift; bless { @_ }, "Decl" } 445 sub emit_clojure { 446 my $self = $_[0]; 447 ((my $decl) = $self->{decl}); 448 ((my $name) = $self->{var}->name()); 449 ((($decl eq 'has')) ? (('sub ' . $name . ' ' . chr(123) . ' ' . chr(64) . '_ ' . chr(61) . chr(61) . ' 1 ' . chr(63) . ' ( ' . chr(36) . '_[0]->' . chr(123) . $name . chr(125) . ' ) ' . ': ( ' . chr(36) . '_[0]->' . chr(123) . $name . chr(125) . ' ' . chr(61) . ' ' . chr(36) . '_[1] ) ' . chr(125))) : ($self->{decl} . ' ' . $self->{type} . ' ' . $self->{var}->emit_clojure())) 450 } 451 } 452 453; 454 { 455 package Method; 456 sub new { shift; bless { @_ }, "Method" } 457 sub emit_clojure { 458 my $self = $_[0]; 459 460 } 461 } 462 463; 464 { 465 package Sub; 466 sub new { shift; bless { @_ }, "Sub" } 467 sub emit_clojure { 468 my $self = $_[0]; 469 ((my $sig) = $self->{sig}); 470 ((my $pos) = $sig->positional()); 471 ((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))))); 472 (my $str); 473 if (($pos)) { 474 for my $field ( @{($pos)} ) { 475 ($str = ($str . $field->emit_clojure() . ' ')) 476 } 477 }; 478 if ($str) { 479 ($str = (chr(38) . 'optional ' . $str)) 480 }; 481 if ($self->{name}) { 482 ('(defun ' . Main::to_lisp_identifier($self->{name}) . ' (' . $str . ')' . (chr(10)) . ' (block mp6-function ' . $block->emit_clojure() . '))' . (chr(10))) 483 } 484 else { 485 ('(fn ' . $self->{name} . ' [' . $str . ']' . (chr(10)) . ' (block mp6-function ' . $block->emit_clojure() . '))' . (chr(10))) 486 } 487 } 488 } 489 490; 491 { 492 package Do; 493 sub new { shift; bless { @_ }, "Do" } 494 sub emit_clojure { 495 my $self = $_[0]; 496 ((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))))); 497 return scalar ($block->emit_clojure()) 498 } 499 } 500 501; 502 { 503 package Use; 504 sub new { shift; bless { @_ }, "Use" } 505 sub emit_clojure { 506 my $self = $_[0]; 507 (chr(10) . chr(59) . chr(59) . ' use ' . Main::to_lisp_namespace($self->{mod}) . (chr(10))) 508 } 509 } 510 511 512} 513 5141; 515