# Do not edit this file - Generated by Perlito6 9.0
use v5;
use utf8;
use strict;
use warnings;
no warnings ('redefine', 'once', 'void', 'uninitialized', 'misc', 'recursion');
use Perlito6::Perl5::Runtime;
use Perlito6::Perl5::Prelude;
our $MATCH = Perlito6::Match->new();
{
package GLOBAL;
sub new { shift; bless { @_ }, "GLOBAL" }
# use v6
;
{
package Perlito6::Clojure::LexicalBlock;
sub new { shift; bless { @_ }, "Perlito6::Clojure::LexicalBlock" }
sub block { $_[0]->{block} };
sub emit_clojure {
my $self = $_[0];
if (!(((defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))))) {
return scalar ('nil')
};
((my $str) = '');
((my $has_my_decl) = 0);
((my $my_decl) = '');
for my $decl ( @{(defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))} ) {
if ((Main::isa($decl, 'Decl') && (($decl->decl() eq 'my')))) {
($has_my_decl = 1);
($my_decl = ($my_decl . '(' . ($decl->var())->emit_clojure() . ' (sv-undef))'))
};
if (((Main::isa($decl, 'Bind') && Main::isa(($decl->parameters()), 'Decl')) && ((($decl->parameters())->decl() eq 'my')))) {
($has_my_decl = 1);
($my_decl = ($my_decl . '(' . (($decl->parameters())->var())->emit_clojure() . ' (sv-undef))'))
}
};
if ($has_my_decl) {
($str = ($str . '(let (' . $my_decl . ') '))
}
else {
($str = ($str . '(do '))
};
for my $decl ( @{(defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY')))} ) {
if ((!(((Main::isa($decl, 'Decl') && (($decl->decl() eq 'my'))))))) {
($str = ($str . ($decl)->emit_clojure()))
}
};
return scalar (($str . ')'))
}
}
;
{
package CompUnit;
sub new { shift; bless { @_ }, "CompUnit" }
sub attributes { $_[0]->{attributes} };
sub methods { $_[0]->{methods} };
sub emit_clojure {
my $self = $_[0];
((my $class_name) = Main::to_lisp_namespace($self->{name}));
((my $str) = (chr(59) . chr(59) . ' class ' . $self->{name} . (chr(10))));
($str = ($str . '(defpackage ' . $class_name . (chr(10)) . ' (:use common-lisp mp-Main))' . (chr(10)) . chr(59) . chr(59) . ' (in-package ' . $class_name . ')' . (chr(10))));
((my $has_my_decl) = 0);
((my $my_decl) = '');
for my $decl ( @{(defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))} ) {
if ((Main::isa($decl, 'Decl') && (($decl->decl() eq 'my')))) {
($has_my_decl = 1);
($my_decl = ($my_decl . '(' . ($decl->var())->emit_clojure() . ' (sv-undef))'))
};
if (((Main::isa($decl, 'Bind') && Main::isa(($decl->parameters()), 'Decl')) && ((($decl->parameters())->decl() eq 'my')))) {
($has_my_decl = 1);
($my_decl = ($my_decl . '(' . (($decl->parameters())->var())->emit_clojure() . ' (sv-undef))'))
}
};
if ($has_my_decl) {
($str = ($str . '(let (' . $my_decl . ')' . (chr(10))))
};
($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)));
((my $dumper) = '');
for my $decl ( @{(defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))} ) {
if ((Main::isa($decl, 'Decl') && (($decl->decl() eq 'has')))) {
((my $accessor_name) = ($decl->var())->name());
($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) '));
($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)))
};
if (Main::isa($decl, 'Method')) {
((my $sig) = $decl->sig());
((my $invocant) = $sig->invocant());
((my $pos) = $sig->positional());
((my $str_specific) = ('(' . $invocant->emit_clojure() . ' ' . $class_name . ')'));
((my $str_optionals) = '');
for my $field ( @{($pos)} ) {
($str_optionals = ($str_optionals . ' ' . $field->emit_clojure()))
};
if (($str_optionals)) {
($str_specific = ($str_specific . ' ' . chr(38) . 'optional' . $str_optionals))
};
((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => $decl->block())));
($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)))
};
if (Main::isa($decl, 'Sub')) {
($str = ($str . '(in-package ' . $class_name . ')' . (chr(10)) . ' ' . ($decl)->emit_clojure() . (chr(10)) . '(in-package mp-Main)' . (chr(10))))
}
};
if (($self->{name} ne 'Pair')) {
($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))))
};
for my $decl ( @{(defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY')))} ) {
if ((((!(((Main::isa($decl, 'Decl') && (((($decl->decl() eq 'has')) || (($decl->decl() eq 'my')))))))) && (!((Main::isa($decl, 'Method'))))) && (!((Main::isa($decl, 'Sub')))))) {
($str = ($str . ($decl)->emit_clojure() . (chr(10))))
}
};
if ($has_my_decl) {
($str = ($str . ')'))
};
($str = ($str . (chr(10)) . (chr(10))))
}
}
;
{
package Val::Int;
sub new { shift; bless { @_ }, "Val::Int" }
sub emit_clojure {
my $self = $_[0];
$self->{int}
}
}
;
{
package Val::Bit;
sub new { shift; bless { @_ }, "Val::Bit" }
sub emit_clojure {
my $self = $_[0];
$self->{bit}
}
}
;
{
package Val::Num;
sub new { shift; bless { @_ }, "Val::Num" }
sub emit_clojure {
my $self = $_[0];
$self->{num}
}
}
;
{
package Val::Buf;
sub new { shift; bless { @_ }, "Val::Buf" }
sub emit_clojure {
my $self = $_[0];
(chr(34) . Main::lisp_escape_string($self->{buf}) . chr(34))
}
}
;
{
package Lit::Array;
sub new { shift; bless { @_ }, "Lit::Array" }
sub emit_clojure {
my $self = $_[0];
((my $ast) = $self->expand_interpolation());
return scalar ($ast->emit_clojure())
}
}
;
{
package Lit::Hash;
sub new { shift; bless { @_ }, "Lit::Hash" }
sub emit_clojure {
my $self = $_[0];
((my $ast) = $self->expand_interpolation());
return scalar ($ast->emit_clojure())
}
}
;
{
package Index;
sub new { shift; bless { @_ }, "Index" }
sub emit_clojure {
my $self = $_[0];
return scalar (('(elt ' . $self->{obj}->emit_clojure() . ' ' . $self->{index_exp}->emit_clojure() . ')'))
}
}
;
{
package Lookup;
sub new { shift; bless { @_ }, "Lookup" }
sub emit_clojure {
my $self = $_[0];
if (Main::isa($self->{obj}, 'Var')) {
if (((($self->{obj}->name() eq 'MATCH')) || (($self->{obj}->name() eq chr(47))))) {
return scalar (('(gethash ' . $self->{index_exp}->emit_clojure() . ' (sv-hash ' . $self->{obj}->emit_clojure() . '))'))
}
};
return scalar (('(gethash ' . $self->{index_exp}->emit_clojure() . ' ' . $self->{obj}->emit_clojure() . ')'))
}
}
;
{
package Var;
sub new { shift; bless { @_ }, "Var" }
sub emit_clojure {
my $self = $_[0];
((my $ns) = '');
if ($self->{namespace}) {
($ns = (Main::to_lisp_namespace($self->{namespace}) . '::'))
};
((($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}))))))
}
}
;
{
package Bind;
sub new { shift; bless { @_ }, "Bind" }
sub emit_clojure {
my $self = $_[0];
if ((Main::isa($self->{parameters}, 'Decl') && (($self->{parameters}->decl() eq 'my')))) {
return scalar (('(setf ' . ($self->{parameters}->var())->emit_clojure() . ' ' . $self->{arguments}->emit_clojure() . ')'))
};
('(setf ' . $self->{parameters}->emit_clojure() . ' ' . $self->{arguments}->emit_clojure() . ')')
}
}
;
{
package Proto;
sub new { shift; bless { @_ }, "Proto" }
sub emit_clojure {
my $self = $_[0];
('(proto-' . Main::to_lisp_namespace($self->{name}) . ')')
}
}
;
{
package Call;
sub new { shift; bless { @_ }, "Call" }
sub emit_clojure {
my $self = $_[0];
((my $arguments) = '');
if ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))) {
($arguments = Main::join(([ map { $_->emit_clojure() } @{( (defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY'))) )} ]), ' '))
};
((my $invocant) = $self->{invocant}->emit_clojure());
if (($invocant eq 'self')) {
($invocant = 'sv-self')
};
if ((($self->{method} eq 'values'))) {
if (($self->{hyper})) {
die(('not implemented'))
}
else {
return scalar ((chr(64) . chr(123) . $invocant . chr(125)))
}
};
if (($self->{method} eq 'isa')) {
if (((((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[0])->buf()) eq 'Str')) {
return scalar (('(typep ' . $invocant . ' ' . chr(39) . 'string)'))
};
return scalar (('(typep ' . $invocant . ' ' . chr(39) . Main::to_lisp_namespace(((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))->[0])->buf()) . ')'))
};
if (($self->{method} eq 'chars')) {
if (($self->{hyper})) {
die(('not implemented'))
}
else {
return scalar (('(length ' . $invocant . ')'))
}
};
if (((($self->{method} eq 'yaml')) || (($self->{method} eq 'say')))) {
if (($self->{hyper})) {
return scalar (('[ map ' . chr(123) . ' ' . $self->{method} . '( ' . chr(36) . '_, ' . ', ' . $arguments . ')' . ' ' . chr(125) . ' ' . chr(64) . chr(123) . ' ' . $invocant . ' ' . chr(125) . ' ]'))
}
else {
return scalar (('(' . $self->{method} . ' ' . $invocant . ' ' . $arguments . ')'))
}
};
((my $meth) = (Main::to_lisp_identifier($self->{method}) . ' '));
if (($self->{method} eq 'postcircumfix:<( )>')) {
($meth = '')
};
if (($self->{hyper})) {
('(mapcar ' . chr(35) . chr(39) . $meth . $invocant . ')')
}
else {
return scalar (('(' . $meth . $invocant . ' ' . $arguments . ')'))
}
}
}
;
{
package Apply;
sub new { shift; bless { @_ }, "Apply" }
sub emit_clojure {
my $self = $_[0];
((my $ns) = '');
if ($self->{namespace}) {
($ns = (Main::to_lisp_namespace($self->{namespace}) . '::'))
};
((my $code) = ($ns . $self->{code}));
((my $args) = '');
if ((defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY')))) {
($args = Main::join(([ map { $_->emit_clojure() } @{( (defined $self->{arguments} ? $self->{arguments} : ($self->{arguments} ||= bless([], 'ARRAY'))) )} ]), ' '))
};
if (($code eq 'self')) {
return scalar ('sv-self')
};
if (($code eq 'False')) {
return scalar ('nil')
};
if (($code eq 'make')) {
return scalar (('(return-from mp6-function ' . $args . ')'))
};
if (($code eq 'substr')) {
return scalar (('(sv-substr ' . $args . ')'))
};
if (($code eq 'say')) {
return scalar (('(mp-Main::sv-say (list ' . $args . '))'))
};
if (($code eq 'print')) {
return scalar (('(mp-Main::sv-print (list ' . $args . '))'))
};
if (($code eq 'infix:<' . chr(126) . '>')) {
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() . '))'))
};
if (($code eq 'warn')) {
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*)'))
};
if (($code eq 'die')) {
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))'))
};
if (($code eq 'array')) {
return scalar ($args)
};
if (($code eq 'prefix:<' . chr(126) . '>')) {
return scalar (('(sv-string ' . $args . ')'))
};
if (($code eq 'prefix:<' . chr(33) . '>')) {
return scalar (('(not (sv-bool ' . $args . '))'))
};
if (($code eq 'prefix:<' . chr(63) . '>')) {
return scalar (('(sv-bool ' . $args . ')'))
};
if (($code eq 'prefix:<' . chr(36) . '>')) {
return scalar (('(sv-scalar ' . $args . ')'))
};
if (($code eq 'prefix:<' . chr(64) . '>')) {
return scalar ($args)
};
if (($code eq 'prefix:<' . chr(37) . '>')) {
return scalar ($args)
};
if (($code eq 'infix:<+>')) {
return scalar (('(+ ' . $args . ')'))
};
if (($code eq 'infix:<->')) {
return scalar (('(-' . $args . ')'))
};
if (($code eq 'infix:<>>')) {
return scalar (('(> ' . $args . ')'))
};
if (($code eq 'infix:<' . chr(38) . chr(38) . '>')) {
return scalar (('(sv-and ' . $args . ')'))
};
if (($code eq 'infix:<' . chr(124) . chr(124) . '>')) {
return scalar (('(sv-or ' . $args . ')'))
};
if (($code eq 'infix:<eq>')) {
return scalar (('(sv-eq ' . $args . ')'))
};
if (($code eq 'infix:<ne>')) {
return scalar (('(not (sv-eq ' . $args . '))'))
};
if (($code eq 'infix:<' . chr(61) . chr(61) . '>')) {
return scalar (('(eql ' . $args . ')'))
};
if (($code eq 'infix:<' . chr(33) . chr(61) . '>')) {
return scalar (('(not (eql ' . $args . '))'))
};
if (($code eq 'ternary:<' . chr(63) . chr(63) . ' ' . chr(33) . chr(33) . '>')) {
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() . ')'))
};
return scalar (('(' . $ns . Main::to_lisp_identifier($self->{code}) . ' ' . $args . ')'))
}
}
;
{
package Return;
sub new { shift; bless { @_ }, "Return" }
sub emit_clojure {
my $self = $_[0];
return scalar (('(return-from mp6-function ' . $self->{result}->emit_clojure() . ')'))
}
}
;
{
package If;
sub new { shift; bless { @_ }, "If" }
sub emit_clojure {
my $self = $_[0];
((my $block1) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY'))))));
((my $block2) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{otherwise} ? $self->{otherwise} : ($self->{otherwise} ||= bless([], 'ARRAY'))))));
('(if (sv-bool ' . $self->{cond}->emit_clojure() . ') ' . $block1->emit_clojure() . ' ' . $block2->emit_clojure() . ')')
}
}
;
{
package For;
sub new { shift; bless { @_ }, "For" }
sub emit_clojure {
my $self = $_[0];
((my $cond) = $self->{cond});
((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{body} ? $self->{body} : ($self->{body} ||= bless([], 'ARRAY'))))));
if ((Main::isa($cond, 'Var') && ($cond->sigil() eq chr(64)))) {
($cond = Apply->new(('code' => 'prefix:<' . chr(64) . '>'), ('arguments' => do {
(my $List_a = bless [], 'ARRAY');
(my $List_v = bless [], 'ARRAY');
push( @{$List_a}, $cond );
$List_a
})))
};
('(dolist (' . $self->{topic}->emit_clojure() . ' ' . $cond->emit_clojure() . ') ' . $block->emit_clojure() . ')')
}
}
;
{
package Decl;
sub new { shift; bless { @_ }, "Decl" }
sub emit_clojure {
my $self = $_[0];
((my $decl) = $self->{decl});
((my $name) = $self->{var}->name());
((($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()))
}
}
;
{
package Method;
sub new { shift; bless { @_ }, "Method" }
sub emit_clojure {
my $self = $_[0];
}
}
;
{
package Sub;
sub new { shift; bless { @_ }, "Sub" }
sub emit_clojure {
my $self = $_[0];
((my $sig) = $self->{sig});
((my $pos) = $sig->positional());
((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY'))))));
(my $str);
if (($pos)) {
for my $field ( @{($pos)} ) {
($str = ($str . $field->emit_clojure() . ' '))
}
};
if ($str) {
($str = (chr(38) . 'optional ' . $str))
};
if ($self->{name}) {
('(defun ' . Main::to_lisp_identifier($self->{name}) . ' (' . $str . ')' . (chr(10)) . ' (block mp6-function ' . $block->emit_clojure() . '))' . (chr(10)))
}
else {
('(fn ' . $self->{name} . ' [' . $str . ']' . (chr(10)) . ' (block mp6-function ' . $block->emit_clojure() . '))' . (chr(10)))
}
}
}
;
{
package Do;
sub new { shift; bless { @_ }, "Do" }
sub emit_clojure {
my $self = $_[0];
((my $block) = Perlito6::Clojure::LexicalBlock->new(('block' => (defined $self->{block} ? $self->{block} : ($self->{block} ||= bless([], 'ARRAY'))))));
return scalar ($block->emit_clojure())
}
}
;
{
package Use;
sub new { shift; bless { @_ }, "Use" }
sub emit_clojure {
my $self = $_[0];
(chr(10) . chr(59) . chr(59) . ' use ' . Main::to_lisp_namespace($self->{mod}) . (chr(10)))
}
}
}
1;