Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
725 lines (663 sloc) 24.1 KB
use Metamodel;
use Op;
use RxOp;
use CClass;
use CgOp;
use Body;
use Unit;
use JSYNC;
use NAMOutput;
use NieczaFrontendSTD;
use NieczaPassBegin;
use NieczaPassBeta;
use NieczaPassSimplifier;
use NieczaBackendNAM;
use NieczaBackendDotnet;
use NieczaBackendClisp;
use NieczaBackendHoopl;
use NieczaPathSearch;
use NieczaCompiler;
use MONKEY_TYPING;
use GetOptLong;
use NieczaActions;
use OpHelpers;
use Operator;
use OptRxSimple;
use STD;
use Sig;
use Stash;
augment class Op::SimplePair { #OK exist
method code($body) {
CgOp.bif_pair(CgOp.const(CgOp.string_var($.key)), $.value.cgop($body));
}
}
augment class Op::SimpleParcel { #OK exist
method code($body) {
CgOp.bif_comma(map { $_.cgop($body) }, @$.items);
}
}
augment class STD {
method nibbler() {
my @nibbles;
my $from = self.pos;
my $to = $from;
loop {
my $here = self.cursor($to);
last if head($here.stopper);
if head($here.starter) -> $starter {
push @nibbles, Match.synthetic(:cursor(self), :$from, :$to,
:method<Str>, :captures()) if $from != $to;
my $nibbler = head(self.cursor($starter.to).nibbler) or return ();
my $stopper = head(self.cursor($nibbler.to).stopper) or return ();
$from = $to = $stopper.to;
push @nibbles, $starter;
push @nibbles, @( $nibbler<nibbles> );
push @nibbles, $stopper;
}
elsif head($here.escape) -> $escape {
push @nibbles, Match.synthetic(:cursor(self), :$from, :$to,
:method<Str>, :captures()) if $from != $to;
$from = $to = $escape.to;
push @nibbles, $escape;
}
else {
$to++;
}
}
push @nibbles, Match.synthetic(:cursor(self), :$from, :$to,
:method<Str>, :captures()) if $from != $to || !@nibbles;
$*LAST_NIBBLE = $to;
$*LAST_NIBBLE_START = self.pos;
if defined substr(self.orig, self.pos, $to - self.pos).index("\n") {
$*LAST_NIBBLE_MULTILINE = $to;
$*LAST_NIBBLE_MULTILINE_START = self.pos;
}
Match.synthetic(:cursor(self), from => self.pos, :$to, :method<nibbler>,
:captures(nibbles => @nibbles))
}
token ws () {
:my $startpos = Q:CgOp { (box Num (cast num (cursor_pos (cast cursor (@ {self}))))) };
:my $stub = return self if @*MEMOS[$startpos]<ws> :exists; #OK
:dba('whitespace')
[
|| \h+ <![\#\s\\]> { @*MEMOS[ Q:CgOp { (box Num (cast num (cursor_pos (cast cursor (@ {$¢}))))) } ]<ws> = $startpos; } # common case
|| <?before \w> <?after \w> :::
{ @*MEMOS[$startpos]<ws>:delete; }
<.sorry: "Whitespace is required between alphanumeric tokens"> # must \s+ between words
|| [ <.unsp>
| <.vws> <.heredoc>
| <.unv>
# | $ { $¢.moreinput } NIECZA break inf loop
]*
{
my $pos = Q:CgOp { (box Num (cast num (cursor_pos (cast cursor (@ {$¢}))))) };
if ($pos == $startpos) {
@*MEMOS[$pos]<ws>:delete;
}
else {
@*MEMOS[$pos]<ws> = $startpos;
@*MEMOS[$pos]<endstmt> = @*MEMOS[$startpos]<endstmt>
if @*MEMOS[$startpos]<endstmt> :exists;
}
}
]
}
}
augment class Op::ShortCircuitAssign { #OK
method code($body) {
my $sym = ::GLOBAL::NieczaActions.gensym;
my $assn = CgOp.assign(CgOp.letvar($sym), $.rhs.cgop($body));
my $cond = CgOp.letvar($sym);
my $cassn;
if $.kind eq '&&' {
$cassn = CgOp.ternary(CgOp.obj_getbool($cond), $assn, $cond);
}
elsif $.kind eq '||' {
$cassn = CgOp.ternary(CgOp.obj_getbool($cond), $cond, $assn);
}
elsif $.kind eq 'andthen' {
$cassn = CgOp.ternary(CgOp.obj_getdef($cond), $assn, $cond);
}
elsif $.kind eq '//' {
$cassn = CgOp.ternary(CgOp.obj_getdef($cond), $cond, $assn);
}
CgOp.letn($sym, $.lhs.cgop($body), $cassn);
}
}
augment class Op::Start { #OK
method code($body) {
CgOp.ternary(
CgOp.obj_getbool(CgOp.scopedlex($.condvar)),
CgOp.corelex('Nil'),
CgOp.prog(
CgOp.sink(CgOp.assign(CgOp.scopedlex($.condvar),
CgOp.box('Bool', CgOp.bool(1)))),
$.body.cgop($body)));
}
}
augment class Op::Assign { #OK
method code($body) {
CgOp.assign($.lhs.cgop($body), $.rhs.cgop($body));
}
}
augment class Sig::Parameter { #OK
method do_copy($val) {
CgOp.prog(
CgOp.scopedlex($!slot, ($!hash ?? CgOp._cgop("newhash") !!
$!list ?? CgOp._cgop("newarray") !!
CgOp._cgop("newtypedscalar",
CgOp.class_ref("mo", @( $!tclass // 'Any' ))))),
CgOp.sink(CgOp.assign(CgOp.scopedlex($!slot), $val)))
}
method bind_inline($body, @posr) {
my $get = $!full_parcel ?? self.parcel_get_inline(@posr) !!
$!slurpycap ?? self.slurpycap_get_inline(@posr) !!
$!slurpy ?? self.slurpy_get_inline(@posr) !!
self.single_get_inline($body, @posr);
if (defined $!slot) {
return self.do_copy($get) if $!is_copy;
CgOp.scopedlex($!slot, $!rwtrans ?? $get !!
CgOp.newboundvar(+(!$!rw), +$!list, $get));
} else {
CgOp.sink($get);
}
}
}
augment class STD::P6 { #OK
# note: until %*LANG is initialized we can't use <.ws>
token comp_unit {
:my $*DEBUG = $GLOBAL::DEBUG_STD // 0;
:my $*begin_compunit = 1;
:my $*endargs = -1;
:my %*LANG;
:my $*PKGDECL ::= "";
:my $*IN_DECL = '';
:my $*HAS_SELF = '';
:my $*DECLARAND;
:my $*OFTYPE;
:my $*NEWPKG;
:my $*NEWLEX;
:my $*QSIGIL ::= '';
:my $*IN_META = '';
:my $*QUASIMODO;
:my $*SCOPE = "";
:my $*LEFTSIGIL;
:my $*PRECLIM;
:my %*MYSTERY = ();
:my $*INVOCANT_OK;
:my $*INVOCANT_IS;
:my $*CURLEX;
:my $*MULTINESS = '';
:my $*SIGNUM = 0;
:my $*MONKEY_TYPING = False;
:my %*WORRIES;
:my @*WORRIES;
:my $*FATALS = 0;
:my $*IN_SUPPOSE = False;
:my $*CURPKG;
{
%*LANG<MAIN> = ::STD::P6 ;
%*LANG<Q> = ::STD::Q ;
%*LANG<Quasi> = ::STD::Quasi ;
%*LANG<Regex> = ::STD::Regex ;
%*LANG<P5> = ::STD::P5 ;
%*LANG<P5Regex> = ::STD::P5::Regex ;
@*WORRIES = ();
self.load_setting($*SETTINGNAME);
my $oid = $*SETTING.id;
my $id = 'MY:file<' ~ $*FILE<name> ~ '>';
$*CURLEX = Stash.new(
'OUTER::' => [$oid],
'!file' => $*FILE, '!line' => 0,
'!id' => [$id],
);
$STD::ALL.{$id} = $*CURLEX;
$*UNIT = $*CURLEX;
$STD::ALL.<UNIT> = $*UNIT;
self.finishlex;
# $¢ = self.cursor_fresh($*CURLEX<$?LANGNAME>);
}:s
<.unitstart>
<statementlist>
[ <?unitstopper> || <.panic: "Confused"> ]
# "CHECK" time...
$<LEX> = { $*CURLEX }
{
$¢.explain_mystery();
if @*WORRIES {
note "Potential difficulties:\n " ~ join( "\n ", @*WORRIES) ~ "\n";
}
die "Check failed\n" if $*FATALS;
}
}
constant %item_assignment = (:dba('item assignment') , :prec<i=>, :assoc<right>, :!pure);
token infixish ($in_meta?) {
:my ($O, $sym);
:temp $*IN_META;
:my $stub = ($*IN_META = $in_meta // $*IN_META); #OK not used
<!stdstopper>
<!infixstopper>
:dba('infix or meta-infix')
[
| <colonpair> $<fake> = {1} { $sym = ':' }
{ $O = {:prec(%item_assignment<prec>), :assoc<unary>,
:dba<adverb> } }
# actual test is non-inclusive!
| [
| :dba('bracketed infix') '[' ~ ']' <infix=.infixish('[]')> { $O = $<infix><O>; $sym = $<infix><sym> }
[ <!before '='> { self.worry("Useless use of [] around infix op") unless $*IN_META; } ]?
| <infix=infix_circumfix_meta_operator> { $O = $<infix><O>; $sym = $<infix><sym>; }
| <infix=infix_prefix_meta_operator> { $O = $<infix><O>; $sym = $<infix><sym>; }
| <infix> { $O = $<infix><O>; $sym = $<infix><sym>; }
| {} <?dotty> <.panic: "Method call found where infix expected (omit whitespace?)">
| {} <?postfix> <.panic: "Postfix found where infix expected (omit whitespace?)">
]
[ <?before '='> <assign_meta_operator($<infix>)>
{$O = $<assign_meta_operator>[0]<O>}
{$sym = $<assign_meta_operator>[0]<sym>}
]?
]
$<O> = { $O } $<sym> = { $sym }
}
}
augment class Sig::Parameter { #OK
method bind_inline($body, @posr) {
my $get = $!full_parcel ?? self.parcel_get_inline(@posr) !!
$!slurpycap ?? self.slurpycap_get_inline(@posr) !!
$!slurpy ?? self.slurpy_get_inline(@posr) !!
self.single_get_inline($body, @posr);
if (defined $!slot) {
if $!is_copy {
self.do_copy($get);
} else {
CgOp.scopedlex($!slot, $!rwtrans ?? $get !!
CgOp.newboundvar(+(!$!rw), +$!list, $get));
}
} else {
CgOp.sink($get);
}
}
}
augment class NieczaActions {
method variable($/) {
my $sigil = $<sigil> ?? ~$<sigil> !! substr(~$/, 0, 1);
my $twigil = $<twigil> ?? $<twigil>[0]<sym> !! '';
my ($name, $rest);
my $dsosl = $<desigilname> ?? $<desigilname>.ast !!
$<sublongname> ?? $<sublongname>.ast !!
Any;
if defined($dsosl) && defined($dsosl<ind>) {
make { term => self.docontext($/, $sigil, $dsosl<ind>) };
return;
} elsif defined $dsosl {
($name, $rest) = $dsosl<name path>;
} elsif $<name> {
# Both these cases are marked XXX in STD. I agree. What are they for?
if $<name>[0].ast<dc> {
$/.CURSOR.sorry("*ONE* pair of leading colons SHALL BE ENOUGH");
make { term => ::Op::StatementList.new };
return;
}
if substr(~$/,0,3) eq '$::' {
$rest = $<name>[0].ast.<names>;
$name = pop $rest;
} else {
if $<name>[0].ast<names> > 1 {
$/.CURSOR.sorry("Nonsensical attempt to qualify a self-declared named parameter detected");
make { term => ::Op::StatementList.new };
return;
}
$name = $<name>[0].ast<names>[0];
$twigil = ':';
}
} elsif $<special_variable> {
$name = substr(~$<special_variable>, 1);
$twigil = '*' if $name eq '/' or $name eq '!';
} elsif $<index> {
make { capid => $<index>.ast, term =>
mkcall($/, '&postcircumfix:<[ ]>',
::Op::ContextVar.new(name => '$*/'),
::Op::Num.new(value => $<index>.ast))
};
return Nil;
} elsif $<postcircumfix> {
if $<postcircumfix>[0].reduced eq 'postcircumfix:sym<< >>' { #XXX fiddly
make { capid => $<postcircumfix>[0].ast.args[0].text, term =>
mkcall($/, '&postcircumfix:<{ }>',
::Op::ContextVar.new(name => '$*/'),
@( $<postcircumfix>[0].ast.args))
};
return;
} else {
make { term => self.docontext($/, $sigil, $<postcircumfix>[0].ast.args[0]) };
return;
}
} else {
$/.CURSOR.sorry("Non-simple variables NYI");
make { term => ::Op::StatementList.new };
return;
}
make {
sigil => $sigil, twigil => $twigil, name => $name, rest => $rest
};
}
sub qpvalue($ast) {
if $ast.^isa(::Op::SimpleParcel) {
join " ", map &qpvalue, @( $ast.items )
} elsif $ast.^isa(::Op::StringLiteral) {
$ast.text;
} elsif $ast.^isa(::Op::Paren) {
qpvalue($ast.inside);
} else {
"XXX"
}
}
method colonpair($/) {
my $n;
if !$<v>.^isa(Match) {
$n = ":" ~ ($<v> ?? '' !! '!') ~ $<k>;
} else {
$n = ":" ~ $<k> ~ "<" ~ qpvalue($<v>.ast) ~ ">";
}
my $tv = $<v>.^isa(Match) ?? $<v>.ast !!
::Op::Lexical.new(name => $<v> ?? 'True' !! 'False');
if $tv ~~ Str {
if substr($<v>,1,1) eq '<' {
$tv = mkcall($/, '&postcircumfix:<{ }>',
::Op::ContextVar.new(name => '$*/'),
::Op::StringLiteral.new(text => ~$<k>));
} else {
$tv = self.do_variable_reference($/,
{ sigil => ~$<v><sigil>,
twigil => ($<v><twigil> ?? ~$<v><twigil>[0] !! ''),
name => $<k> });
}
}
make { ext => $n, term => ::Op::SimplePair.new(key => $<k>, value => $tv) };
}
method simple_longname($/) {
my $r = self.mangle_longname($/);
($r<path>:exists) ?? [ @($r<path>), $r<name> ] !! [ 'MY', $r<name> ];
}
method parameter($/) {
my $rw = False;
my $copy = False;
my $sorry;
my $slurpy = False;
my $slurpycap = False;
my $optional = False;
my $rwt = False;
my $type;
if $<type_constraint> {
$type = self.simple_longname($<type_constraint>[0]<typename><longname>);
}
for @( $<trait> ) -> $trait {
if $trait.ast<rw> { $rw = True }
elsif $trait.ast<copy> { $copy = True }
elsif $trait.ast<parcel> { $rwt = True }
elsif $trait.ast<readonly> { $rw = False }
else {
$trait.CURSOR.sorry('Unhandled trait ' ~ $trait.ast.keys.[0]);
}
}
if $<post_constraint> > 0 {
$/.sorry('Parameter post constraints NYI');
make ::Sig::Parameter.new;
return Nil;
}
my $default = $<default_value> ?? $<default_value>[0].ast !! Any;
my $tag = $<quant> ~ ':' ~ $<kind>;
if $tag eq '**:*' { $sorry = "Slice parameters NYI" }
elsif $tag eq '*:*' { $slurpy = True }
elsif $tag eq '|:*' { $slurpycap = True }
elsif $tag eq '\\:!' { $rwt = True }
elsif $tag eq '\\:?' { $rwt = True; $optional = True }
elsif $tag eq ':!' { }
elsif $tag eq ':*' { $optional = True }
elsif $tag eq ':?' { $optional = True }
elsif $tag eq '?:?' { $optional = True }
elsif $tag eq '!:!' { }
elsif $tag eq '!:?' { $optional = True }
elsif $tag eq '!:*' { }
else { $sorry = "Confusing parameters ($tag)" }
if $sorry { $/.CURSOR.sorry($sorry); }
my $p = $<param_var> // $<named_param>;
make ::Sig::Parameter.new(name => ~$/, :$default,
:$optional, :$slurpy, :$rw, type => ($type // 'Any'),
:$slurpycap, rwtrans => $rwt, is_copy => $copy, |$p.ast);
}
}
for <
ann arith assign bget bif_array_constructor bif_at_key bif_at_pos
bif_bool bif_chars bif_chr bif_coerce_to_int bif_coerce_to_num
bif_comma bif_cross bif_defined bif_delete_key bif_divide
bif_exists_key bif_gettimeofday bif_grep bif_hash bif_hash_keys
bif_hash_kv bif_hash_pairs bif_hash_values bif_item bif_list
bif_make bif_map bif_minus bif_mod bif_mul bif_negate bif_not
bif_now bif_num bif_numand bif_numcompl bif_numeq bif_numge
bif_numgt bif_numle bif_numlshift bif_numlt bif_numne bif_numor
bif_numrshift bif_numxor bif_ord bif_pair bif_plus bif_postinc
bif_rand bif_rat_approx bif_simple_eval bif_str bif_streq
bif_strge bif_strgt bif_strle bif_strlt bif_strne bif_substr3
bif_zip bool box boxlist bset callframe callnext call_uncloned_sub
cast cgoto char class_ref compare const context_get control
corelex cotake cursor_ast cursor_backing cursor_butpos cursor_dows
cursor_fresh cursor_from cursor_item cursor_O cursor_pos
cursor_reduced cursor_start cursor_synthcap cursor_synthetic
cursor_unmatch cursor_unpackcaps default_new die do_require ehspan
exactnum exit fcclist_new fetch fladlist_new foreign_class
frame_caller frame_file frame_hint frame_line from_json from_jsync
fvarlist_item fvarlist_length fvarlist_new getargv getfield
get_first getindex getslot goto how instrole int iter_copy_elems
iter_flatten iter_hasarg iter_hasflat iter_to_list label labelid
letn letscope letvar llhow_name ltm_push_alts mrl_count mrl_index
ncgoto newblankrwscalar newboundvar newrwlistvar newrwscalar
newscalar newtypedscalar newvarrayvar newvhashvar newvnewarrayvar
newvnewhashvar newvsubvar note null num_to_string obj_asbool
obj_asdef obj_asnum obj_asstr obj_at_key obj_at_pos obj_delete_key
obj_does obj_exists_key obj_getbool obj_getdef obj_getnum
obj_getstr obj_isa obj_is_defined obj_llhow obj_newblank
obj_typename obj_vasbool obj_vasdef obj_vasnum obj_vasstr
obj_vat_key obj_vat_pos obj_vdelete_key obj_vexists_key obj_what
outerlex path_any_exists path_change_ext path_combine
path_dir_exists path_file_exists path_modified path_realpath
popcut print prog promote_to_list pushcut rawcall rawnew rawnewarr
rawnewzarr rawscall rawsget rawsset return role_apply run_dispatch
rxbacktrack rxbprim rxcall rxclosequant rxcommitgroup rxend
rxfinalend rxframe rxgetpos rxgetquant rxincorpcut rxincorpshift
rxincquant rxinit rxopenquant rxpushb rxpushcapture rxsetcapsfrom
rxsetclass rxsetpos rxsetquant rxstripcaps say scopedlex setbox
setfield setindex setslot set_status sig_slurp_capture sink slurp
span specificlex spew stab_privatemethod stab_what startgather
start_iter status_get str strbuf_append strbuf_new strbuf_seal
str_chr strcmp str_flip str_length str_substring str_tolower
str_tonum str_toupper take ternary to_json to_jsync treader_getc
treader_getline treader_open treader_slurp treader_stdin unbox
var_get_var varhash_clear varhash_contains_key varhash_delete_key
varhash_dup varhash_getindex varhash_new varhash_setindex
var_islist var_new_tied vvarlist_append vvarlist_clone
vvarlist_count vvarlist_from_fvarlist vvarlist_item
vvarlist_new_empty vvarlist_new_singleton vvarlist_pop
vvarlist_push vvarlist_shift vvarlist_sort vvarlist_to_fvarlist
vvarlist_unshift vvarlist_unshiftn whileloop xspan bif_times
bif_divop obj_can bif_sqrt bif_push bif_pop bif_unshift bif_shift
> -> $name {
my $fnc = anon sub CgOperator (\|@parcel) {
Q:CgOp {
(letn arr {[@parcel]}
items (getslot items vvarlist (@ (l arr)))
(sink (vvarlist_shift (l items)))
(vvarlist_unshift (l items) {$name})
(l arr))
}
};
Q:CgOp { (rnull (_cgop _addmethod (obj_llhow (@ {CgOp})) 0
(obj_getstr {$name}) (@ {$fnc}))) }
}
Q:CgOp { (rnull (_cgop _invalidate (obj_llhow (@ {CgOp})))) };
augment class Op::ImmedForLoop { #OK
method code_labelled($body, $l) {
my $id = ::GLOBAL::NieczaActions.genid;
CgOp.rnull(CgOp.letn(
"!iter$id", CgOp.start_iter($.source.cgop($body)),
(map { $_, CgOp.null('var') }, @$.var),
CgOp.whileloop(0, 0,
CgOp.iter_hasflat(CgOp.letvar("!iter$id")),
CgOp.prog(
(map { CgOp.letvar($_,
CgOp.vvarlist_shift(CgOp.letvar("!iter$id")))},@$.var),
CgOp.sink(CgOp.xspan("redo$id", "next$id", 0,
$.sink.cgop($body),
1, $l, "next$id",
2, $l, "last$id",
3, $l, "redo$id")))),
CgOp.label("last$id")));
}
}
augment class RxOp::ProtoRedis { #OK
method code($) {
CgOp.letn(
"fns", CgOp.run_dispatch(CgOp.callframe,
CgOp.fetch(CgOp.scopedlex('self'))),
"i", CgOp.int(0),
"ks", CgOp.null('vvarlist'),
CgOp.pushcut('LTM'),
CgOp.label('nextfn'),
CgOp.cgoto('backtrack',
CgOp.compare('>=', CgOp.letvar("i"),
CgOp.mrl_count(CgOp.letvar("fns")))),
CgOp.rxpushb('LTM', 'nextfn'),
CgOp.letvar("ks", CgOp.start_iter(
CgOp.subcall(CgOp.mrl_index(CgOp.letvar("i"),
CgOp.letvar("fns")), CgOp.rxcall('MakeCursorV')))),
CgOp.letvar("i", CgOp.arith('+', CgOp.letvar("i"), CgOp.int(1))),
CgOp.label('nextcsr'),
CgOp.ncgoto('backtrack', CgOp.iter_hasflat(CgOp.letvar('ks'))),
CgOp.rxpushb('SUBRULE', 'nextcsr'),
CgOp.rxcall('EndWith', CgOp.cast('cursor',
CgOp.fetch(CgOp.vvarlist_shift(CgOp.letvar('ks'))))),
CgOp.goto('backtrack'));
}
}
my $usage = q:to/EOM/;
niecza -- a command line wrapper for Niecza
usage: niecza -e 'code' # run a one-liner
OR: niecza file.pl [args] # run a program
OR: niecza -C MyModule # precompile a module
OR: niecza # interactive shell
general options:
-B --backend=NAME # select backend (nam, dotnet, clisp, hoopl)
-L --language=NAME # select your setting
-v --verbose # detailed timing info
-c --compile # don't run (implied with -C)
--stop-after=STAGE # stop after STAGE and dump AST
--safe # disable system interaction
--help # display this message
backend options:
--obj-dir=DIR # select output location (all)
EOM
my $runobj = Q:CgOp { (box Str (rawcall get_BaseDirectory (rawscall System.AppDomain.get_CurrentDomain))) };
my $basedir = $runobj.IO.append("..").realpath;
my @lib = $basedir.append("lib"), ".".IO.realpath;
my $lang = "CORE";
my $safe = False;
my $bcnd = "dotnet";
my $odir = $basedir.append("obj");
my $verb = 0;
my @eval;
my $cmod = False;
my $comp = False;
my $stop = "";
my $aotc = False;
GetOptions(:!permute,
"evaluate|e=s" => sub { push @eval, $_ },
"compile-module|C" => sub { $cmod = True },
"backend|B=s" => sub { $bcnd = $_ },
"language|L=s" => sub { $lang = $_ },
"verbose|v" => sub { $verb++ },
"compile|c" => sub { $comp = True },
"safe" => sub { $safe = True },
"stop=s" => sub { $stop = $_ },
"aot" => sub { $aotc = True },
"include|I=s" => sub { unshift @lib, $_.IO.realpath },
"obj-dir=s" => sub { $odir = $_ },
"help|h" => sub { say $usage; exit 0 },
);
my $backend;
if $bcnd eq 'nam' {
$backend = NieczaBackendNAM.new(obj_dir => $odir);
}
elsif $bcnd eq 'dotnet' || $bcnd eq 'mono' {
$backend = NieczaBackendDotnet.new(obj_dir => $odir, safemode => $safe);
}
elsif $bcnd eq 'clisp' {
$backend = NieczaBackendClisp.new(obj_dir => $odir);
}
elsif $bcnd eq 'hoopl' {
$backend = NieczaBackendHoopl.new(obj_dir => $odir);
}
else {
note "Backend '$bcnd' not supported";
exit 1;
}
my $stages;
if $bcnd eq 'clisp' {
$stages = [
NieczaPassBegin.new,
NieczaPassSimplifier.new,
];
} elsif $bcnd eq 'hoopl' {
$stages = [
NieczaPassBegin.new,
NieczaPassSimplifier.new,
];
} else {
$stages = [
NieczaPassBegin.new,
NieczaPassBeta.new,
NieczaPassSimplifier.new,
];
}
my $c = NieczaCompiler.new(
module_finder => NieczaPathSearch.new(
path => @lib,
),
frontend => NieczaFrontendSTD.new(
lang => $lang,
safemode => $safe,
),
stages => $stages,
backend => $backend,
verbose => $verb,
);
if $cmod {
if @eval {
note "Module compilation cannot be used with strings to evaluate";
exit 1;
}
if !@*ARGS {
say "No modules named to compile!";
exit 0;
}
for @*ARGS {
$c.compile_module($_, $stop);
}
}
elsif @eval {
$c.backend.run_args = @*ARGS;
for @eval {
$c.compile_string($_, !$comp, $stop);
}
}
elsif @*ARGS {
my $file = shift @*ARGS;
$c.backend.run_args = @*ARGS;
$c.compile_file($file, !$comp, $stop);
}
else {
while True {
print "niecza> ";
my $l = $*IN.get // last;
$c.compile_string("say (" ~ $l ~ ").perl", !$comp, $stop);
}
}
Something went wrong with that request. Please try again.