12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289 |
- #!/usr/bin/env perl
- use utf8;
- use 5.016;
- BEGIN { # support for running sidef locally from everywhere
- if (-w __FILE__) {
- require File::Spec;
- require File::Basename;
- unshift @INC,
- File::Spec->catdir(
- File::Basename::dirname(
- File::Spec->file_name_is_absolute(__FILE__)
- ? __FILE__
- : File::Spec->rel2abs(__FILE__)
- ),
- File::Spec->updir,
- 'lib'
- );
- }
- }
- binmode STDIN, ":utf8";
- binmode STDOUT, ":utf8";
- binmode STDERR, ":utf8" if $^P == 0; # to work under Devel::* modules
- use Sidef;
- my $name = 'Sidef';
- my $version = $Sidef::VERSION;
- my %args;
- if ($#ARGV != -1 and chr ord $ARGV[0] eq '-') {
- require Getopt::Std;
- $Getopt::Std::STANDARD_HELP_VERSION = 1;
- Getopt::Std::getopts('e:E:Dho:ivHWwbcrR:tCO:kP:M:sN:', \%args);
- }
- # Fix potential case mismatches for -R
- if (defined $args{R}) {
- if (lc($args{R}) eq 'perl') {
- $args{R} = 'Perl';
- }
- elsif (lc($args{R}) eq 'sidef') {
- $args{R} = 'Sidef';
- }
- }
- # Help
- if (defined $args{h}) {
- HELP_MESSAGE();
- exit 0;
- }
- # Version
- if (defined $args{v}) {
- VERSION_MESSAGE();
- exit 0;
- }
- # Warnings stack backtrace
- if (defined $args{w}) {
- $SIG{__WARN__} = sub {
- require Carp;
- Carp::cluck(@_);
- };
- }
- # Fatal warnings stack backtrace
- if (defined $args{W}) {
- $SIG{__DIE__} = $SIG{__WARN__} = sub {
- require Carp;
- Carp::confess(@_);
- };
- }
- # Interactive help
- if (defined $args{H}) {
- help_interactive();
- exit 0;
- }
- # Interactive coding
- if (defined $args{i}) {
- code_interactive();
- exit 0;
- }
- # Precision
- if (defined $args{P}) {
- require Sidef::Types::Number::Number;
- if ($args{P} <= 0) {
- die "Invalid precision: <<$args{P}>> (expected a positive integer)\n";
- }
- $Sidef::Types::Number::Number::PREC = $args{P} << 2;
- }
- # Other Number options
- if (defined $args{N}) {
- require Sidef::Types::Number::Number;
- my @options = split(/\s*;\s*/, $args{N});
- foreach my $option (@options) {
- if ($option =~ /^\s*(\w+)\s*=\s*(\S+)/) {
- my ($name, $value) = ($1, $2);
- if ($value eq 'true') {
- $value = 1;
- }
- elsif ($value eq 'false') {
- $value = 0;
- }
- no strict 'refs';
- ${'Sidef::Types::Number::Number::' . $name} = $value;
- }
- else {
- die "Invalid format: <<$option>>!\nExpected: 'NAME1=VALUE1; NAME2=VALUE2;'";
- }
- }
- }
- # Test mode
- if (defined $args{t}) {
- local $args{c} = 0;
- my @argv = splice(@ARGV);
- my @fails;
- require Encode;
- while (defined(my $script_name = shift @argv)) {
- my $script_name = Encode::decode_utf8($script_name);
- say "\n** Executing: $script_name";
- say "-" x 80;
- my $sidef = Sidef->new(opt => \%args,
- name => $script_name);
- my $code = read_script($script_name);
- my $deparsed = eval { $sidef->compile_code($code, 'Perl') };
- my $slept = 0;
- if ($@) {
- warn "[ERROR] Can't parse the script `$script_name`: $@";
- push @fails, $script_name;
- sleep 2;
- $slept = 1;
- }
- else {
- local $SIG{INT} = sub {
- die "Stopped by user...";
- };
- if (defined $args{C}) {
- say "$script_name syntax OK";
- next;
- }
- $sidef->execute_perl($deparsed);
- }
- if (not($slept) and $@) {
- warn "[ERROR] Error encountered on script `$script_name`: $@";
- push @fails, $script_name;
- sleep(2) if @argv;
- }
- }
- if (@fails) {
- say "\n";
- say "-" x 80;
- say ":: The following scripts failed";
- say "-" x 80;
- say "$_" for @fails;
- }
- }
- # Default
- else {
- my $script_name = '-';
- $args{E} = $args{e} if exists($args{e});
- my $code = exists($args{E})
- ? do {
- defined($args{E}) || die "No code specified for -E.\n";
- $script_name = '-E';
- require Encode;
- Encode::decode_utf8($args{E});
- }
- : defined($ARGV[0]) ? do {
- $script_name = shift @ARGV;
- if ($script_name eq '-') {
- local $/;
- <STDIN>;
- }
- else {
- read_script($script_name);
- }
- }
- : (-t STDIN) ? do { code_interactive(); exit 0; }
- : do { local $/; <STDIN> };
- $code // exit 2;
- my $sidef = Sidef->new(opt => \%args,
- name => $script_name);
- # Dump the AST
- if (defined $args{D}) {
- dump_ast($sidef->parse_code($code));
- }
- # Deparse code
- elsif (defined($args{r}) or defined($args{R})) {
- my $deparsed = $sidef->compile_code($code, $args{R});
- if (defined($args{R}) and $args{R} eq 'Perl') {
- require File::Basename;
- my $header =
- "\nuse lib (" . q{"}
- . quotemeta(File::Basename::dirname($INC{"Sidef.pm"})) . q{"}
- . ");\n\n"
- . "use Sidef;\n\n"
- . "binmode(STDIN, ':utf8');\n"
- . "binmode(STDOUT, ':utf8');\n"
- . "binmode(STDERR, ':utf8') if \$^P == 0;\n";
- $deparsed = $header . $deparsed;
- }
- output($deparsed);
- }
- # Compile the code to a Perl program
- elsif (defined $args{c}) {
- compile_to_perl(code => $sidef->compile_code($code, 'Perl'));
- }
- # Check the syntax
- elsif (defined $args{C}) {
- eval { $sidef->parse_code($code) };
- die $@ if $@;
- say "$script_name syntax OK";
- }
- # Execute the code
- else {
- $sidef->execute_code($code);
- die $@ if $@;
- }
- }
- #
- ## Subroutines
- #
- sub HELP_MESSAGE {
- #<<<
- my %switches = (
- '-i file' => 'execute a program in interactive mode',
- '-c' => 'compile the code into a Perl program',
- '-C' => 'check syntax only',
- '-D' => 'dump the syntax tree of a program',
- '-o file' => 'file where to dump the output',
- '-O level' => ['perform code optimizations before execution',
- 'valid levels: [0], 1, 2'],
- '-P int' => 'set the precision of floating-point numbers (default: ' . int($Sidef::Types::Number::Number::PREC / 4) . ')',
- '-M mode' => ['set the rounding mode of floating-point numbers',
- 'valid modes: [near], zero, inf, +inf, -inf, faith'],
- '-N options' => ['modify class-variables inside the Number class',
- "valid format: 'VERBOSE=1; USE_YAFU=1; USE_PRIMECOUNT=1'"],
- '-k' => 'keep track of potentially incorrect parser interpretations',
- '-E program' => 'one line of program',
- '-H' => 'interactive help',
- '-s' => 'save compiled code in a database to reduce boot-time',
- '-v' => 'print version number and exit',
- '-t' => 'treat all command-line arguments as scripts',
- '-r' => 'parse and deparse a Sidef program',
- '-R lang' => ['parse and deparse a Sidef program into a given language',
- 'valid values: sidef, perl'],
- '-w' => 'enable warnings with stack backtrace',
- '-W' => 'make warnings fatal (with stack backtrace)',
- );
- #>>>
- require File::Basename;
- my $basename = File::Basename::basename($0);
- print <<"USAGE";
- Usage: $basename [switches] [--] [programfile] [arguments]
- USAGE
- require List::Util;
- my $max_width = List::Util::max(map { length } keys %switches);
- $max_width += 4;
- foreach my $key (sort { lc($a) cmp lc($b) or lc($b) cmp lc($a) or $b cmp $a } keys %switches) {
- if (ref $switches{$key} eq 'ARRAY') {
- printf " %-${max_width}s%s\n", $key, $switches{$key}[0];
- foreach my $i (1 .. $#{$switches{$key}}) {
- printf " %-${max_width}s%s\n", '', $switches{$key}[$i];
- }
- }
- else {
- printf " %-${max_width}s%s\n", $key, $switches{$key};
- }
- }
- print <<"END";
- Run '$basename' for entering the interactive mode.
- END
- }
- sub VERSION_MESSAGE {
- print "$name $version\n";
- }
- sub read_script {
- my ($script_name) = @_;
- open my $fh, '<:utf8', $script_name
- or die qq{Can't open sidef script "$script_name": $!\n};
- local $/;
- <$fh>;
- }
- sub help_interactive {
- my ($term) = @_;
- require File::Spec;
- require File::Basename;
- require Encode;
- require Term::ReadLine;
- $term //= Term::ReadLine->new("$name $version -- help interactive mode");
- print <<"HELP";
- Welcome to $name $version! This is the interactive help utility.
- Enter the name of any object, keyword, or topic to get help on writing
- $name programs and using $name modules. To quit this help utility, just
- type "quit".
- HELP
- my $sidef = Sidef->new(
- name => '-H',
- opt => {i => 1, %args},
- parser_opt => {interactive => 1},
- );
- {
- my $line = Encode::decode_utf8(
- $term->readline('help> ')
- // do { print "\n"; return }
- );
- my $ccode = eval { $sidef->compile_code($line, 'Perl') };
- if ($@) {
- # Valid keywords for 'exit'
- if ($line eq 'quit' or $line eq 'q' or $line eq 'exit') {
- return;
- }
- # Otherwise, a syntax error
- warn $@;
- redo;
- }
- my @refs = (map { ref($_) } $sidef->execute_perl($ccode));
- foreach my $ref (@refs) {
- $ref eq '' && do { warn "Not an object!\n"; next };
- my $name = $ref =~ s{::}{/}gr;
- my $file = $INC{$name . '.pm'};
- my $pod;
- foreach my $dir (@INC) {
- if (-e (my $f = File::Spec->catfile($dir, $name . '.pod'))) {
- $pod = $f;
- last;
- }
- }
- if (defined($pod)) {
- system 'perldoc', $pod;
- $? && system 'man', $ref;
- }
- else {
- system 'man', $ref;
- $? && system 'perldoc', $ref;
- }
- }
- redo;
- }
- }
- sub create_completion_tree {
- scalar {
- table => {},
- special_key => "\0",
- };
- }
- sub add_tree_entry {
- my ($tree, $key, $value) = @_;
- my $ref = $tree->{table};
- foreach my $item (@$key) {
- $ref = $ref->{$item} //= {};
- undef $ref->{$tree->{special_key}}{$value};
- }
- $tree;
- }
- sub search_tree {
- my ($tree, $prefix) = @_;
- my $ref = $tree->{table};
- foreach my $item (@$prefix) {
- if (exists $ref->{$item}) {
- $ref = $ref->{$item};
- }
- else {
- return;
- }
- }
- sort keys %{$ref->{$tree->{special_key}} // {}};
- }
- sub add_class_methods_to_completion {
- my ($tree) = @_;
- my $modules_count = scalar(keys %INC);
- state %seen;
- state $included_modules = $modules_count - 1;
- if ($modules_count == $included_modules) {
- return 1;
- }
- foreach my $module (keys %INC) {
- next if $seen{$module}++;
- my $class = $module =~ s{\.pm\z}{}r =~ s{\W+}{::}gr;
- $class =~ /^Sidef::Types::/ or next;
- foreach my $method_name (keys %{(eval { $class->methods }) // {}}) {
- add_tree_entry($tree, [split(//, $method_name)], $method_name);
- }
- }
- $included_modules = $modules_count;
- return 1;
- }
- sub add_words_to_completion {
- my ($tree, $string) = @_;
- while ($string =~ /(\w+)/g) {
- my $word = $1;
- if (length($word) <= 50) {
- add_tree_entry($tree, [split(//, $word)], $word);
- }
- }
- return 1;
- }
- sub code_interactive {
- require Encode;
- require File::Spec;
- require Term::ReadLine;
- my $term = Term::ReadLine->new("$name $version -- interactive mode");
- my $sidef;
- my $init_sidef = sub {
- $sidef = Sidef->new(
- name => '-i',
- opt => {i => 1, %args},
- parser_opt => {interactive => 1},
- );
- $sidef->execute_code(''); # warm-up
- };
- $init_sidef->();
- my ($copy_array, $copy_hash);
- $copy_array = sub {
- my ($array) = @_;
- my @copy;
- foreach my $item (@$array) {
- if (ref($item) eq 'ARRAY') {
- push @copy, __SUB__->($item);
- }
- elsif (ref($item) eq 'HASH') {
- push @copy, $copy_hash->($item);
- }
- else {
- push @copy, $item;
- }
- }
- \@copy;
- };
- $copy_hash = sub {
- my ($hash) = @_;
- my %copy;
- foreach my $key (keys %$hash) {
- my $value = $hash->{$key};
- if (ref($value) eq 'ARRAY') {
- $copy{$key} = $copy_array->($value);
- }
- elsif (ref($value) eq 'HASH') {
- $copy{$key} = __SUB__->($value);
- }
- else {
- $copy{$key} = $value;
- }
- }
- \%copy;
- };
- require Time::HiRes;
- print <<"EOT" if 0;
- ** ** **** * ********* *********
- * * ** * * **** ** ** ** ** ** ** **
- ** ** **** *** ********* * * *
- ** ** ** **** * * ****** ******
- * * * * * * * * * **** ** ** ** ** ** **
- ** ** ** **** ****** ****** * *
- ** ** **** * * * ********* ***
- * * ** * * **** ** ** ** ** ** ** **
- ** ** **** ********* ********* *
- EOT
- print <<"EOT";
- Sidef $version, running on \u$^O, using Perl $^V.
- Type "help", "copyright" or "license" for more information.
- EOT
- my $valid_lines = '';
- my ($vars, $ref_vars_refs);
- my $completion_tree;
- my $history_support = $term->can('ReadHistory') && $term->can('Attribs');
- my $history_file = File::Spec->catfile($sidef->get_sidef_config_dir(), 'sidef_history.txt');
- if ($history_support) {
- if (not -e $history_file) {
- open my $fh, '>', $history_file;
- }
- $completion_tree = create_completion_tree();
- my $attr = $term->Attribs;
- $attr->{basic_quote_characters} = q{};
- add_class_methods_to_completion($completion_tree);
- my @results;
- $attr->{completion_entry_function} = sub {
- my ($prefix, $state) = @_;
- my $root = '';
- if ($prefix !~ /^\w+\z/ and $prefix =~ /^(.*)\b(\w+)\z/) {
- $root = $1;
- $prefix = $2;
- }
- if ($state == 0) {
- @results = search_tree($completion_tree, [split(//, $prefix)]);
- }
- @results || return undef;
- $root . shift(@results);
- };
- $term->ReadHistory($history_file);
- }
- my $tΔ = 0;
- my @values;
- my $FH = undef;
- if (@ARGV) {
- my $file = shift(@ARGV);
- open $FH, '<:utf8', $file
- or die "Can't open file <<$file>> for reading: $!\n";
- }
- MAINLOOP: {
- my $line = '';
- LINE: {
- if (defined($FH) and !eof($FH)) {
- chomp(my $curr_line = <$FH>);
- if ($line eq '' and $curr_line =~ /^\s*__(?:END|DATA)__\s*\z/) {
- $curr_line .= "\n" . do { local $/; <$FH> };
- }
- if ($history_support and $curr_line ne '' and $line eq '') {
- $term->addhistory($curr_line =~ s/\R/\r/gr);
- }
- $line .= $curr_line;
- }
- else {
- $line .= Encode::decode_utf8($term->readline($line eq '' ? '> ' : ' ') // return);
- }
- if ($line eq 'help') {
- help_interactive($term);
- redo MAINLOOP;
- }
- elsif ($line eq '##') {
- say " *** last result computed in $tΔ seconds";
- redo MAINLOOP;
- }
- elsif ($line =~ /^#+\h*load\h+(.+)/) {
- my $file = unpack('A*', $1);
- open $FH, '<:utf8', $file or do {
- warn "Can't open file <<$file>> for reading: $!\n";
- redo MAINLOOP;
- };
- redo MAINLOOP;
- }
- elsif ($line =~ /^#+\h*exec\h+(.+)/) {
- my $file = unpack('A*', $1);
- $init_sidef->();
- open my $fh, '<:utf8', $file or do {
- warn "Can't open file <<$file>> for reading: $!\n";
- redo MAINLOOP;
- };
- $line = do { local $/; <$fh> };
- close $fh;
- }
- elsif ($line =~ /^#+\h*save\h+(.+)/) {
- my $file = unpack('A*', $1);
- open my $fh, '>:utf8', $file or do {
- warn "Can't open file <<$file>> for writing: $!\n";
- redo MAINLOOP;
- };
- print $fh $valid_lines;
- close $fh;
- say "** Created file: $file";
- }
- elsif ($line eq 'copyright') {
- print <<'EOT';
- Copyright © 2013-2024 Daniel Șuteu, Ioana Fălcușan
- All Rights Reserved.
- EOT
- redo MAINLOOP;
- }
- elsif ($line eq 'license') {
- print <<'EOT';
- This program is free software; you can redistribute it
- and/or modify it under the terms of the Artistic License (2.0).
- For more details, see the full text in the LICENSE file.
- This program is distributed in the hope that it will be
- useful, but without any warranty; without even the implied
- warranty of merchantability or fitness for a particular purpose.
- For more information, see:
- https://github.com/trizen/sidef
- https://www.perlfoundation.org/artistic-license-20.html
- EOT
- redo MAINLOOP;
- }
- }
- # Replace top-level variables and constants with globals
- if (not defined($args{r}) and not defined($args{R})) {
- $line =~ s/^\h*(?:var|define|const|static)\b/global/;
- }
- $vars = $copy_hash->($sidef->{parser}{vars});
- $ref_vars_refs = $copy_hash->($sidef->{parser}{ref_vars_refs});
- $line =~ s{#(-?[1-9][0-9]*)\b}{(abs($1) <= scalar(@values)) ? ('(' . $values[($1 < 0) ? $1 : $1-1]->{value} . ')') : "#$1"}ge;
- # Last character was '\': read the next line
- if ($line =~ /\\\s*\z/) {
- $line .= "\n";
- goto LINE;
- }
- my $ccode = eval { $sidef->compile_code($line, $args{r} ? 'Sidef' : ($args{R} || 'Perl')) };
- if ($@) {
- # Valid keywords for 'exit'
- if ($line eq 'q' or $line eq 'exit' or $line eq 'quit') {
- return;
- }
- # Reset the parser
- if ($line eq 'reset') {
- $init_sidef->();
- undef $vars;
- undef $ref_vars_refs;
- @values = ();
- redo;
- }
- # Restore parser variables
- if (defined($vars) and defined($ref_vars_refs)) {
- %{$sidef->{parser}{vars}} = %$vars;
- %{$sidef->{parser}{ref_vars_refs}} = %$ref_vars_refs;
- }
- # Give up if the previous line is blank,
- # or when it's impossible to recover from an error
- if (
- $@ =~ /is not declared in the current scope/i
- or $@ =~ /invalid \S+ declaration/i
- or $@ =~ /attempt to (?:use|call|delete) /i
- or $@ =~ /not declared in the current scope/i
- or $@ =~ /expected a block after/i
- or $@ =~ /unexpected end-of-statement/i
- or (
- $@ =~ /unbalanced|string terminator|delimiter/
- ? $line =~ /\R\R\z/
- : $line =~ /\R\z/
- )
- ) {
- warn $@;
- redo;
- }
- $line .= "\n";
- goto LINE;
- }
- else {
- $valid_lines .= "$line\n"; # store valid lines
- }
- if ($history_support) {
- if ($line =~ /\R/) {
- $term->addhistory($line =~ s/\R/\r/gr);
- }
- $term->append_history(1, $history_file);
- }
- if (defined($args{r}) or defined($args{R})) {
- output($ccode);
- }
- elsif ($line =~ /\S/ and not $line =~ /^\s*#.*$/) {
- my $t0 = eval { [Time::HiRes::gettimeofday()] };
- my @results = $sidef->execute_perl($ccode);
- if ($@) {
- print $@;
- }
- elsif ($history_support) {
- add_words_to_completion($completion_tree, $line);
- }
- $tΔ = eval { Time::HiRes::tv_interval($t0) };
- # use overload;
- # overload::StrVal($_) ? "$_" : $_->dump;
- my $dump = join(
- ', ',
- map {
- (ref($_) ? UNIVERSAL::can($_, 'dump') ? $_->dump : $_ : ($_ // 'nil'))
- . ((ref($_) eq 'Sidef::Types::Number::Number' and ref($$_) eq 'Math::MPFR' and Math::MPFR::Rmpfr_number_p($$_)) ? 'f' : '')
- } @results
- );
- $dump = "($dump)" if @results > 1;
- push @values,
- {
- type => ((scalar(@results) == 1) ? 'scalar' : 'list'),
- value => $dump,
- };
- say "#" . scalar(@values) . " = $dump";
- if ($history_support) {
- add_class_methods_to_completion($completion_tree);
- }
- }
- redo;
- }
- }
- sub _get_loaded_modules {
- my @modules;
- foreach my $key (sort { length($a) <=> length($b) || $a cmp $b } keys %INC) {
- if ($key =~ /^(Sidef\b.*)\.pm\z/) {
- push @modules, $1 =~ s{/}{::}gr;
- }
- }
- return @modules;
- }
- sub output {
- my ($content) = @_;
- my $out_fh = \*STDOUT;
- if (defined $args{o}) {
- open $out_fh, '>:utf8', $args{o}
- or die "Can't open file '$args{o}' for write: $!\n";
- }
- print {$out_fh} $content;
- return $out_fh;
- }
- sub dump_ast {
- my ($ast) = @_;
- eval { require Data::Dump };
- if ($@) {
- die qq{** "Data::Dump" is not installed!\n};
- }
- else {
- my $out_fh = output('');
- my $requirify = sub {
- join('', map { "require '" . (s{::}{/}gr) . ".pm';\n" } @_);
- };
- print {$out_fh} $requirify->(_get_loaded_modules());
- print {$out_fh} Data::Dump::pp($ast) . "\n";
- }
- }
- sub compile_to_perl {
- my (%opt) = @_;
- require File::Spec;
- require File::Basename;
- my $path = File::Spec->catdir(File::Basename::dirname($INC{'Sidef.pm'}), 'Sidef');
- my $package_content = <<"HEAD";
- #!$^X
- eval 'exec $^X -S \$0 \${1+"\$@"}'
- if 0; # not running under some shell
- use utf8;
- binmode STDIN, ":utf8";
- binmode STDOUT, ":utf8";
- binmode STDERR, ":utf8" if \$^P == 0; # to work under Devel::* modules
- my %REQ;
- my %MODULE;
- HEAD
- $package_content .= "BEGIN { %MODULE = (\n";
- require File::Find;
- File::Find::find(
- {
- no_chdir => 1,
- wanted => sub {
- if (/\.pm\z/ and -f) {
- local $/;
- open my $fh, '<:utf8', $_
- or die "Can't open file `$_` for reading: $!";
- my $token = tr/A-Za-z0-9/_/cr;
- my $content = <$fh>;
- if ($content =~ /^package\h+([\w:]+)/) {
- $package_content .= qq{'${1}' => };
- }
- else {
- die qq{ERROR: can't get the package name from file `$_`};
- }
- $package_content .= qq{<<'${token}',\n};
- $package_content .= $content;
- $package_content .= "\n$token\n";
- close $fh;
- }
- }
- } => ($path, $INC{'Sidef.pm'})
- );
- $package_content .= <<'FOOT';
- );
- sub __load_sidef_module__ {
- my ($name) = @_;
- if (not exists $REQ{$name}) {
- my $module = $name =~ s{::}{/}gr . '.pm';
- if (exists $MODULE{$name} and not exists $INC{$module}) {
- # Load the Sidef used modules
- $MODULE{$name} =~ s{^\h*
- use \h+ (?:
- parent \s+ qw\((.*?)\)
- | (Sidef::[\w:]+)
- )
- }{
- join(
- ";\n" => map{
- exists($REQ{$_})
- ? ()
- : "BEGIN{ main::__load_sidef_module__('${_}') }" } split(' ', $+)
- ) . (defined($1) ? "\nuse parent qw(-norequire $1);\n" : '')
- }gxmse;
- $INC{$module} = 1;
- eval($MODULE{$name});
- die "[FATAL ERROR] Can't load `$module`: $@" if $@;
- }
- else {
- require $module;
- }
- $REQ{$name} = 1;
- }
- return 1;
- }
- FOOT
- my $requirify = sub {
- join('', map { "__load_sidef_module__('${_}');\n" } grep { $_ ne 'Sidef::Optimizer' } @_);
- };
- $package_content .= $requirify->(_get_loaded_modules(), 'Sidef::Module::OO', 'Sidef::Module::Func');
- my @used_pkgs;
- while ($opt{code} =~ /^use (Sidef::\S+);$/gm) {
- push @used_pkgs, $1;
- }
- $package_content .= $requirify->(@used_pkgs) if @used_pkgs;
- $package_content .= "}\n\n";
- my $out_fh = output('');
- print {$out_fh} $package_content;
- print {$out_fh} $opt{code};
- }
- __END__
- =encoding utf8
- =head1 NAME
- ** ** **** * ********* *********
- * * ** * * **** ** ** ** ** ** ** **
- ** ** **** *** ********* * * *
- ** ** ** **** * * ****** ******
- * * * * * * * * * **** ** ** ** ** ** **
- ** ** ** **** ****** ****** * *
- ** ** **** * * * ********* ***
- * * ** * * **** ** ** ** ** ** ** **
- ** ** **** ********* ********* *
- =cut
- =head1 SYNOPSIS
- Usage: sidef [switches] [--] [programfile] [arguments]
- -c compile the code into a Perl program
- -C check syntax only
- -D dump the syntax tree of a program
- -E program one line of program
- -H interactive help
- -i file execute a program in interactive mode
- -k keep track of potentially incorrect parser interpretations
- -M mode set the rounding mode of floating-point numbers
- valid modes: [near], zero, inf, +inf, -inf, faith
- -N options modify class-variables inside the Number class
- valid format: 'VERBOSE=1; USE_YAFU=1; USE_PRIMECOUNT=1'
- -o file file where to dump the output
- -O level perform code optimizations before execution
- valid levels: [0], 1, 2
- -P int set the precision of floating-point numbers (default: 48)
- -r parse and deparse a Sidef program
- -R lang parse and deparse a Sidef program into a given language
- valid values: sidef, perl
- -s save compiled code in a database to reduce boot-time
- -t treat all command-line arguments as scripts
- -v print version number and exit
- -w enable warnings with stack backtrace
- -W make warnings fatal (with stack backtrace)
- Run 'sidef' for entering the interactive mode.
- =head1 HELLO WORLD
- A Sidef script can be written in any text editor and, by convention, it has the C<.sf> extension.
- The content of a simple I<Hello World> program looks like this:
- say "Hello, 世界"
- If we save the content in a new file called C<hello.sf>, we can execute the code by running:
- sidef hello.sf
- =head1 ONE LINE OF PROGRAM
- The C<-E code> command will execute the code specified as a command-line argument:
- sidef -E "say 'hello world'"
- Outputs:
- hello world
- =head1 ITERACTIVE MODE
- The interactive mode (a.k.a. REPL) is available by simply executing the C<sidef> command, or by specifying the C<-i> command-line switch:
- $ sidef -i
- Sidef 24.05, running on Linux, using Perl v5.38.2.
- Type "help", "copyright" or "license" for more information.
- > n = 41
- #1 = 41
- > n**2 + n - 1
- #2 = 1721
- > is_prime(#2)
- #3 = true
- >
- =head1 SPECIAL REPL COMMANDS
- The REPL supports the following special commands:
- =over 4
- =item * Display the duration it took to execute the previous command:
- > ##
- =item * Refer to a previous output value, using the C<#n> syntax (a negative value for C<n> is also supported):
- > 3+4
- #1 = 7
- > sqrt(#1)
- =item * Load a Sidef file inside the REPL, line by line:
- > # load filename.sf
- =item * Execute a Sidef file inside the REPL:
- > # exec filename.sf
- =item * Save the code from the REPL inside a file:
- > # save filename.sf
- =item * Reset the REPL:
- > reset
- =item * Close the REPL:
- > quit
- =back
- =head1 OPTIMIZATION
- The C<-O level> command-line option controls the level of optimization before the execution begins.
- Currently, there are three levels of optimization available:
- 0 -- Does nothing. (default)
- 1 -- Does constant folding on the AST. (recommended)
- 2 -- Does constant folding, after which it deparses the AST into Sidef code, parses the code again and does more constant folding on the new AST.
- In the end, the code is translated to Perl and is ready to be executed. In the translation process, several other optimizations are also performed.
- =head1 NUMBER OPTIONS
- The C<-N> option can be used for changing the class-variables in the Number class:
- sidef -N 'PREC = 192' # precision for floating-point numbers
- sidef -N 'ROUND = 0' # rounding mode for floating-point numbers
- sidef -N 'VERBOSE = false' # true to enable verbose/debug mode
- sidef -N 'USE_YAFU = false' # true to use YAFU for factoring large integers
- sidef -N 'USE_PFGW = false' # true to use PFGW64 as a primality pretest for large enough n
- sidef -N 'USE_PARI_GP = false' # true to use PARI/GP in several methods
- sidef -N 'USE_FACTORDB = false' # true to use factordb.com for factoring large integers
- sidef -N 'USE_PRIMESUM = false' # true to use Kim Walisch's primesum in prime_sum(n)
- sidef -N 'USE_PRIMECOUNT = false' # true to use Kim Walisch's primecount in prime_count(n)
- sidef -N 'USE_CONJECTURES = false' # true to use conjectured methods for better performance
- sidef -N 'SPECIAL_FACTORS = true' # true to try to find factors of special form in factor(n)
- Multiple options can be separated with C<;>, as in:
- sidef -N 'VERBOSE = true; USE_FACTORDB = true' -E 'say factor(2**256 + 1)'
- The C<-P> option can be used for changing the precision of floating-point numbers:
- sidef -P 1024 -E 'say sqrt(2)'
- The C<-M> option can be used for changing the rounding-mode for floating-point numbers:
- sidef -M 'near' # round to nearest (default)
- sidef -M 'zero' # round towards zero
- sidef -M 'inf' # round away from zero
- sidef -M '+inf' # round towards +Infinity
- sidef -M '-inf' # round towards -Infinity
- sidef -M 'faith' # faithful rounding
- =head1 PARSER WARNINGS
- Sidef provides the C<-k> option which will keep track of all the possible incorrect parser interpretations.
- For example, if we declare the following function, but we misspell its name when we call it, Sidef will interpret it as a method call, which is probably not what we want:
- func foo(n) { say n }
- fo(42) # will get interpreted as `42.fo`
- When the command-line option C<-k> is specified, the following warning is produced:
- [INFO] `fo` is parsed as a prefix method-call at script.sf line 2
- =head1 DEPARSING
- Deparsing is the reverse process of parsing, which translates the AST back into code. Currently, Sidef supports deparsing into two languages with the C<-R lang> command-line switch:
- =over 4
- =item -R perl
- Deparses the AST into valid Perl code.
- =item -R sidef
- Deparses the AST into valid Sidef code.
- =back
- Example:
- sidef -Rperl script.sf | perl
- The C<-Rsidef> switch (or simply C<-r>) is useful for verifying how the code is parsed:
- sidef -r -E '1 + 2/3'
- outputs:
- (1)->+((2)->/(3));
- =head1 DUMPING THE AST
- The C<-D> command-line option dumps the abstract syntax tree (AST) of a given Sidef program:
- sidef -D script.sf # will dump the AST of script.sf
- =head1 PRECOMPILATION
- Sidef supports experimental precompilation by saving compiled code inside a database, which is updated automatically and sanitized periodically.
- This method reduces significantly the boot-time of very large Sidef scripts, and it works as following:
- =over 4
- =item * it checks the database with the MD5 of the code
- =item * if the MD5 exists inside the database, it returns the executable code
- =back
- otherwise:
- =over 4
- =item * parses the code and generates the executable code
- =item * stores the executable code inside the database with the MD5 of the code
- =back
- Next time when the same code is executed, Sidef will simply retrieve the executable code from the database, without generating it again:
- sidef -s script.sf # may load slow the first time
- sidef -s script.sf # will load much faster the second time
- =head1 COMPILATION
- A Sidef script can be compiled to a stand-alone Perl program by using the C<-c> command-line option:
- sidef -o out.pl -c script.sf
- The above command will compile the file C<script.sf> into the Perl script C<out.pl>, which will include the entire implementation code of Sidef.
- Currently, Sidef code that contains C<eval()> cannot be compiled correctly to Perl, as it requires some parse-time information for run-time evaluation, which is lost in the compilation process.
- =head1 WWW
- You can find more info about Sidef, by clicking on the following links:
- =over 2
- =item * GitHub: L<https://github.com/trizen/sidef>
- =item * Gitbook: L<https://trizen.gitbook.io/sidef-lang/>
- =item * Tutorial: L<https://notabug.org/trizen/sidef/wiki>
- =item * RosettaCode: L<https://rosettacode.org/wiki/Sidef>
- =back
- =head1 LICENSE AND COPYRIGHT
- Copyright (C) 2013-2024 Daniel Șuteu, Ioana Fălcușan
- This program is free software; you can redistribute it and/or modify it
- under the terms of the B<Artistic License (2.0)>. You may obtain a copy
- of the full license at:
- L<https://www.perlfoundation.org/artistic-license-20.html>
- Any use, modification, and distribution of the Standard or Modified
- Versions is governed by this Artistic License. By using, modifying or
- distributing the Package, you accept this license. Do not use, modify,
- or distribute the Package, if you do not accept this license.
- If your Modified Version has been derived from a Modified Version made
- by someone other than you, you are nevertheless required to ensure that
- your Modified Version complies with the requirements of this license.
- This license does not grant you the right to use any trademark, service
- mark, tradename, or logo of the Copyright Holder.
- This license includes the non-exclusive, worldwide, free-of-charge
- patent license to make, have made, use, offer to sell, sell, import and
- otherwise transfer the Package with respect to any patent claims
- licensable by the Copyright Holder that are necessarily infringed by the
- Package. If you institute patent litigation (including a cross-claim or
- counterclaim) against any party alleging that the Package constitutes
- direct or contributory patent infringement, then this Artistic License
- to you shall terminate on the date that such litigation is filed.
- Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
- AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
- THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
- PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
- YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
- CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
- CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
- EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- =cut
|