in reply to Re^6: parse lisp style config
in thread parse lisp style config

thanks for emphasize it, I did overlook 'my sub ..', I did not know it is valid, I tried it, but for recursion subs it complains not defined.

Replies are listed 'Best First'.
Re^8: parse lisp style config
by hippo (Archbishop) on Nov 29, 2024 at 09:46 UTC

    You haven't shown your code but it's a fair guess that you haven't used __SUB__ like the documentation tells you to do:

    my sub baz { __SUB__->(); # calls itself }

    🦛

      package MyPairList; use strict; use warnings; use feature 'state'; use Data::Dumper; use List::Util qw(all none); use Exporter 'import'; our @EXPORT = qw(pair_list_parse); sub pair_list_parse { my $string = shift; my sub get_tokens { my $string = shift; my @tokens = $string =~ /([()]|[^()\s]+)/g; } my @tokens = get_tokens $string; my sub parse_list { state @tokens = @_; my @list; while (my $token = shift @tokens) { if ($token eq '(') { push @list, __SUB__->(); } elsif ($token eq ')') { return \@list; } else { push @list, $token; } } return \@list; } my $list = parse_list @tokens; my sub parse_nested_list { my ($list) = @_; my %hash; if (none {ref $_} @$list) { if (@$list == 1) { return $list->[0]; } elsif (@$list == 2) { return { $list->[0] => $list->[1] }; } else { return $list } } elsif (all {ref $_} @$list) { return [ map { __SUB__->($_) } @$list ]; } else { my ($key, $ref, @remain) = @$list; die 'wrong key ', Dumper $key if ref $key; die 'wrong value ', Dumper $ref unless ref $ref; die 'redundant value', Dumper \@remain if @remain; $hash{$key} = __SUB__->($ref); } return \%hash; } return parse_nested_list($list) } 1;
      Last time I just add my to two subs do recusion, and die with 'undeined sub', now I replace it with __SUB__, still 'Undefined subroutine &MyPairList::__SUB__ called at /usr/local/bin/MyPairList.pm line 23, <> line 1.' It did not work.

        You have this:

        my @tokens = get_tokens $string; my sub parse_list { state @tokens = @_; my @list; while (my $token = shift @tokens) { if ($token eq '(') { push @list, __SUB__->(); } elsif ($token eq ')') { return \@list; } else { push @list, $token; } } return \@list; } my $list = parse_list @tokens;

        Sometimes you pass tokens to it. Sometimes you don't. That's weird and confusing. Fixed:

        my @tokens = get_tokens $string; my sub parse_list { my @list; while (my $token = shift @tokens) { if ($token eq '(') { push @list, __SUB__->(); } elsif ($token eq ')') { return \@list; } else { push @list, $token; } } return \@list; } my $list = parse_list;

        The lack of error checking is disturbing. Fixed:

        my @tokens = get_tokens $string; my sub parse_list { my @list; while ( @tokens && $tokens[0] ne ")" ) { my $token = shift( @tokens ); if ( $token eq "(" ) { push @list, __SUB__->(); die( "Missing `)`" ) if !@token; my $token = shift( @tokens ); die( "Missing `)`" ) if $token ne ")"; } else { push @list, $token; } } return \@list; }; my $list = parse_list(); die( "Unexpected `$tokens[0]`" ) if @tokens;

        Without recursion:

        my @tokens = get_tokens $string; my sub parse_list { my @stack; push @stack, [ ]; while ( @tokens ) { my $token = shift( @tokens ) { if ( $token eq "(" ) { my $sublist = [ ]; push @{ $stack[ -1 ] }, $sublist; push @stack, $sublist; } elsif ( $token eq ")" ) { die( "Unexpected `)` ) if @stack == 1; pop( @stack ); } else { push @{ $stack[ -1 ] }, $token; } } die( "Missing `)` ) if @stack > 1; return $stack[ 0 ]; } my $list = parse_list(); die( "Unexpected `$tokens[0]`" ) if @tokens;