Data commit

Task/S-expressions/Perl/s-expressions-1.pl

@@ -0,0 +1,55 @@
+#!/usr/bin/perl -w
+use strict;
+use warnings;
+
+sub sexpr
+{
+	my @stack = ([]);
+	local $_ = $_[0];
+
+	while (m{
+		\G    # start match right at the end of the previous one
+		\s*+  # skip whitespaces
+		# now try to match any of possible tokens in THIS order:
+		(?<lparen>\() |
+		(?<rparen>\)) |
+		(?<FLOAT>[0-9]*+\.[0-9]*+) |
+		(?<INT>[0-9]++) |
+		(?:"(?<STRING>([^\"\\]|\\.)*+)") |
+		(?<IDENTIFIER>[^\s()]++)
+		# Flags:
+		#  g = match the same string repeatedly
+		#  m = ^ and $ match at \n
+		#  s = dot and \s matches \n
+		#  x = allow comments within regex
+		}gmsx)
+	{
+		die "match error" if 0+(keys %+) != 1;
+
+		my $token = (keys %+)[0];
+		my $val = $+{$token};
+
+		if ($token eq 'lparen') {
+			my $a = [];
+			push @{$stack[$#stack]}, $a;
+			push @stack, $a;
+		} elsif ($token eq 'rparen') {
+			pop @stack;
+		} else {
+			push @{$stack[$#stack]}, bless \$val, $token;
+		}
+	}
+	return $stack[0]->[0];
+}
+
+sub quote
+{ (local $_ = $_[0]) =~ /[\s\"\(\)]/s ? do{s/\"/\\\"/gs; qq{"$_"}} : $_; }
+
+sub sexpr2txt
+{
+	qq{(@{[ map {
+		ref($_) eq '' ? quote($_) :
+		ref($_) eq 'STRING' ? quote($$_) :
+		ref($_) eq 'ARRAY' ? sexpr2txt($_) : $$_
+	} @{$_[0]} ]})}
+}

Task/S-expressions/Perl/s-expressions-2.pl

@@ -0,0 +1,13 @@
+my $s = sexpr(q{
+
+((data "quoted data" 123 4.5)
+ (data (!@# (4.5) "(more" "data)")))
+
+});
+
+# Dump structure
+use Data::Dumper;
+print Dumper $s;
+
+# Convert back
+print sexpr2txt($s)."\n";