#!/usr/bin/perl
use v5.35.0;

my @list;
while (<>) {
	chomp;
	last if /^$/;
	push @list, split /,\s*/;
}
@list = sort @list;

my $total = 0;
while (<>) {
	chomp;
	$total += ways_to_make($_);
}
say $total;



sub ways_to_make($s) {
	return 1 if $s eq '';

	state %memo;
	return $memo{$s} if exists $memo{$s};

	my $ways = 0;
	$ways += ways_to_make(substr $s, length) for prefixes($s);

	return $memo{$s} = $ways;
}



# Return all prefixes of $s that exist in @list

sub prefixes($s) {
	my @prefixes;
	my $range_start = 0;
	my $range_limit = @list;
	for (my $i = 0; $i < length($s); ) {
		my $key = substr($s, $i, 1);
		my $search_limit = $range_limit;
		$range_limit = $range_start;
		while ($range_limit < $search_limit) {
			my $h = ($range_limit + $search_limit) >> 1;
			if (substr($list[$h], $i, 1) gt $key) {
				$search_limit = $h;
			} else {
				$range_limit = $h + 1;
			}
		}
		while ($range_start < $search_limit) {
			my $h = ($range_start + $search_limit) >> 1;
			if (substr($list[$h], $i, 1) lt $key) {
				$range_start = $h + 1;
			} else {
				$search_limit = $h;
			}
		}
		last unless $range_start < $range_limit;
		my $candidate = $list[$range_start];
		push @prefixes, $candidate if length $candidate == ++$i;
	}
	return @prefixes;
}