directory

2 files changed, 201 insertions, 0 deletions

diff --git a/challenge-100/adam-russell/ch-1.dat b/challenge-100/adam-russell/ch-1.dat
new file mode 100644
index 0000000000..a32a4347a4
--- /dev/null
+++ b/challenge-100/adam-russell/ch-1.dat
@@ -0,0 +1 @@
+1234567890
diff --git a/challenge-100/duncan-c-white/perl/mkTypes b/challenge-100/duncan-c-white/perl/mkTypes
new file mode 100644
index 0000000000..c15c733c43
--- /dev/null
+++ b/challenge-100/duncan-c-white/perl/mkTypes
@@ -0,0 +1,200 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use lib qw(/homes/dcw/lib/perl5/DCW);
+use Datadec;
+
+my $posexpr = q(
+PosExpr = I( int n )	"$1"
+	or N( string name ) "$1"
+	or NO( string name, char op, int n ) "$1$2$3"
+);
+
+my $extra = q!
+
+my $debug = 0;
+sub setdebug { my($d) = @_; $debug = $d; }
+
+#
+# my($pe,$leftover) = parse($input);
+#	Parse $input, a string starting with a position expression,
+#	delivering the position expression in $pe and the leftover
+#	input in $leftover.  Die screaming if no well formed pos expr
+#	can be found at the start of $input.
+#	A position expression is either \d+ or name or name '+'|'-' \d+
+#	The internal form of a posexpr is ['I', int const] or ['N', name]
+#	or ['NO', name, +-, offset]
+#
+sub parse ($)
+{
+	my( $input ) = @_;
+	if( $input =~ s/^(\d+)\s*// )
+	{
+		return ( PosExpr->I($1), $input );
+	}
+	$input =~ s/^(\w+)\s*// ||
+		die "bad input in pos expr $input, name expected\n";
+	my $name = $1;
+	if( $input =~ s/^([\+-])\s*(\d+)\s*// )
+	{
+		return ( PosExpr->NO($name,$1,$2), $input );
+	}
+	return ( PosExpr->N($name), $input );
+}
+
+#
+# my $pos = $pe->eval($poshash);
+#	Evaluate the given PosExpr $pe, using %$poshash
+#	for name lookup.  Returns the actual position (a number).
+#
+sub eval ($$)
+{
+	my( $self, $poshash ) = @_;
+	if( $self->kind eq 'I' )
+	{
+		return $self->I;
+	} elsif( $self->kind eq 'N' )
+	{
+		my $name = $self->N;
+		die "error in PosExpr::eval($self): ".
+		    "no such name $name in poshash ". Dumper($poshash)
+			unless exists $poshash->{$name};
+		return $poshash->{$name};
+	} else    # if( $self->kind eq 'NO' )
+	{
+		my ($name, $op, $n) = $self->NO;
+		die "error in PosExpr::eval($self): ".
+		    "no such name $name in poshash ". Dumper($poshash)
+			unless exists $poshash->{$name};
+		die "error in PosExpr::eval($self): bad op $op\n" unless
+			$op eq '+' || $op eq '-';
+		$n = - $n if $op eq '-';
+		return $poshash->{$name} + $n;
+	}
+}
+
+
+
+!;
+
+open( my $fh, '>', "PosExpr.pm" ) || die;
+say $fh gen_datatype( $posexpr, $extra );
+
+close($fh);
+
+my $api = q(
+API = F( string lit, string name )	"F '$1' -> $2"
+    or L( string lit, string name )	"L '$1' -> $2"
+    or M( string lit, posexpr atorafter, string name )	"M '$1' $2 -> $3"
+    or T( posexpr pe1, string op, posexpr pe2 )		"T $1$2$3"
+    or C( int mn, posexpr pe1, posexpr pe2)		"C $1 $2 $3"
+);
+
+$extra = q%
+
+my $debug = 0;
+sub setdebug { my($d) = @_; $debug = $d; }
+
+#
+# my @api = parse( $input );
+#	Parse $input, a string containing a comma-separated sequence
+#	of Abstract Pattern Instructions, return the list of apis.
+#	Die screaming if parsing fails.
+#	For example, matching the pattern a*e is represented by the
+#	following api string:
+#	F'a'->pa,L'e'->plast,Tplast>pa-1,C0 pa+1 plast-1
+#	The individual api forms are:
+#		F'str'->name
+#		L'str'->name
+#		M'str' posexpr->name
+#		Tposexpr ('>'|'=') posexpr
+#		C\d+ posexpr [posexpr]
+#	where posexpr = \d+ or name or name '+'|'-' \d+
+#
+sub parse ($)
+{
+	my( $input ) = @_;
+	my @result;
+	while( $input )
+	{
+		# F'str'->name
+		if( $input =~ s/^F\s*// )
+		{
+			$input =~ s/^'([^']+)'\s*->\s*(\w+)// ||
+				die "bad input $input in F..\n";
+			my $api = API->F($1, $2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# L'str'->name
+		elsif( $input =~ s/^L\s*// )
+		{
+			$input =~ s/^'([^']+)'\s*->\s*(\w+)// ||
+				die "bad input $input in L..\n";
+			my $api = API->L($1, $2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# M'str' posexpr->name
+		elsif( $input =~ s/^M\s*// )
+		{
+			$input =~ s/^'([^']+)'\s+// ||
+				die "bad input $input in M..\n";
+			my $str = $1;
+			(my $pe,$input) = PosExpr::parse($input);
+			die "bad input $input in M$str $pe...\n"
+				unless $input =~ s/^\s*->\s*(\w+)//;
+			my $pname = $1;
+			my $api = API->M($str, $pe, $pname);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# Tposexpr ('>'|'=') posexpr
+		elsif( $input =~ s/^T\s*// )
+		{
+			(my $pe,$input) = PosExpr::parse($input);
+			$input =~ s/^(>|=)// ||
+				die "bad input $input in T$pe, > or = expected\n";
+			my $op = $1;
+			(my $pe2,$input) = PosExpr::parse($input);
+			my $api = API->T($pe, $op, $pe2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		# C\d+ posexpr [posexpr]
+		elsif( $input =~ s/^C\s*// )
+		{
+			$input =~ s/^(\d+)\s*// ||
+				die "bad input $input in C.. integer expected\n";
+			my $mn = $1;
+			(my $pe,$input) = PosExpr::parse($input);
+			$input =~ s/^\s*//;
+
+			# second posexpr is optional:
+			# present if next ch is not ','
+			my $pe2 = $pe;
+			if( $input ne '' && $input !~ /^,/ )
+			{
+				($pe2,$input) = PosExpr::parse($input);
+			}
+			my $api = API->C($mn, $pe, $pe2);
+			say "debug: parsed api $api, rest input $input"
+				if $debug;
+			push @result, $api;
+		}
+		$input =~ s/^\s*,\s*//;
+	}
+	die "bad input $input, non empty but not F|L|M|T|C..\n" if $input;
+	return @result;
+}
+%;
+
+
+open( $fh, '>', "API.pm" ) || die;
+say $fh gen_datatype( $api, $extra );
+close($fh);