Fix sample indices

Fix sample indices

/*
 Copyright (c) 2017 Tuukka Norri
 This code is licensed under MIT license (see LICENSE for details).
 */

#include <vcf2multialign/util.hh>
#include <vcf2multialign/vcf_reader.hh>

%% machine vcf_parser;
%% write data;

// We would like to post-process strings that have been read and then pass
// them to the variant object with a simple function call at the call site.
// Solution: Templates can have member function pointers as parameters but of a specific type.
#define HANDLE_STRING_END(FN, ...)	caller <decltype(FN)>::handle_string_end <FN>(*this, ##__VA_ARGS__)
#define HANDLE_INTEGER_END(FN, ...)	caller <decltype(FN)>::handle_integer_end <FN>(*this, ##__VA_ARGS__)

namespace vcf2multialign { namespace detail {

	template <typename t_enum>
	constexpr typename std::underlying_type <t_enum>::type to_underlying(t_enum e)
	{
		return static_cast <typename std::underlying_type <t_enum>::type>(e);
	}

	// Split a t_string into string_views.
	template <bool t_emplace_back, typename t_string, typename t_invalid_pos>
	size_t read_fields(
		t_string const &string,
		t_invalid_pos const invalid_pos,
		char const *string_start,
		char const *sep,
		size_t const count,
		std::vector <std::string_view> &res
	)
	{
		char const *string_ptr(string_start);

		if (t_emplace_back)
			res.clear();
		else
			res.resize(count);

		typename t_string::size_type sep_pos(0);
		size_t i(0);
		bool should_break(false);
		while (i < count)
		{
			sep_pos = string.find(sep, sep_pos);
			if (invalid_pos == sep_pos)
			{
				should_break = true;
				sep_pos = string.size();
			}

			if (t_emplace_back)
				res.emplace_back(string_ptr, sep_pos - (string_ptr - string_start));
			else
			{
				std::string_view sv(string_ptr, sep_pos - (string_ptr - string_start));
				res[i] = std::move(sv);
			}

			++i;
			++sep_pos;
			string_ptr = string_start + sep_pos;

			if (should_break)
				break;
		}
		return i;
	}

	// Split a string into string_views.
	template <bool t_emplace_back>
	size_t read_fields(
		std::string const &string,
		char const *sep,
		size_t const count,
		std::vector <std::string_view> &res
	)
	{
		return read_fields <t_emplace_back>(string, std::string::npos, string.c_str(), sep, count, res);
	}

	template <bool t_emplace_back>
	size_t read_fields(
		std::string_view const &sv,
		char const *sep,
		size_t const count,
		std::vector <std::string_view> &res
	)
	{
		return read_fields <t_emplace_back>(sv, std::string_view::npos, static_cast <char const *>(sv.data()), sep, count, res);
	}
}}

namespace vcf2multialign {

	template <typename t_fnt>
	struct vcf_reader::caller
	{
		template <t_fnt t_fn, typename ... t_args>
		static void handle_string_end(vcf_reader &r, t_args ... args)
		{
			std::string_view sv(r.m_start, r.m_fsm.p - r.m_start);
			(r.m_current_variant.*(t_fn))(sv, std::forward <t_args>(args)...);
		}

		template <t_fnt t_fn, typename ... t_args>
		static void handle_integer_end(vcf_reader &r, t_args ... args)
		{
			(r.m_current_variant.*(t_fn))(r.m_integer, std::forward <t_args>(args)...);
		}
	};

	template <int t_continue, int t_break>
	int vcf_reader::check_max_field(vcf_field const field, int const target, callback_fn const &cb)
	{
		if (field <= m_max_parsed_field)
			return target;

		skip_to_next_nl();
		if (!cb(m_current_variant))
			return t_break;

		return t_continue;
	}

	void vcf_reader::skip_to_next_nl()
	{
		std::string_view sv(m_fsm.p, m_fsm.pe - m_fsm.p);
		auto const pos(sv.find('\n'));
		always_assert(std::string_view::npos != pos, "Unable to find the next newline");
		m_fsm.p += pos;
	}

	// Seek to the beginning of the records.
	void vcf_reader::reset()
	{
		m_stream->clear();
		m_stream->seekg(m_first_variant_offset);
		m_lineno = m_last_header_lineno;
		m_len = 0;
		m_pos = 0;
	}

	// Return the 1-based number of the given sample.
	size_t vcf_reader::sample_no(std::string const &sample_name) const
	{
		auto const it(m_sample_names.find(sample_name));
		if (it == m_sample_names.cend())
			return 0;
		return it->second;
	}

	void vcf_reader::read_header()
	{
		// For now, just skip lines that begin with "##".
		std::string line;
		while (std::getline(*m_stream, line))
		{
			++m_lineno;
			if (! ('#' == line[0] && '#' == line[1]))
				break;

			// FIXME: header handling goes here.
		}

		// Check for column headers.
		{
			auto const prefix(std::string("#CHROM"));
			auto const res(mismatch(line.cbegin(), line.cend(), prefix.cbegin(), prefix.cend()));
			if (prefix.cend() != res.second)
			{
				std::cerr << "Expected the next line to start with '#CHROM', instead got: '" << line << "'" << std::endl;
				exit(1);
			}
		}

		// Read sample names.
		std::vector <std::string_view> header_names;
		detail::read_fields <true>(line, "\t", -1, header_names);
		std::size_t i(1);
		for (auto it(header_names.cbegin() + detail::to_underlying(vcf_field::ALL)), end(header_names.cend()); it != end; ++it)
		{
			std::string str(*it);
			auto const res(m_sample_names.emplace(std::move(str), i));
			always_assert(res.second, "Duplicate sample name");
			++i;
		}

		// stream now points to the first variant.
		m_first_variant_offset = m_stream->tellg();
		m_last_header_lineno = m_lineno;

		// Instantiate a variant.
		transient_variant var(sample_count());
		using std::swap;
		swap(m_current_variant, var);
	}

	void vcf_reader::fill_buffer()
	{
		// Copy the remainder to the beginning.
		if (m_pos + 1 < m_len)
		{
			char *data_start(m_buffer.data());
			char const *start(data_start + m_pos + 1);
			char const *end(data_start + m_len);
			std::copy(start, end, data_start);
			m_len -= m_pos + 1;
		}
		else
		{
			m_len = 0;
		}

		// Read until there's at least one newline in the buffer.
		while (true)
		{
			char *data_start(m_buffer.data());
			char *data(data_start + m_len);

			std::size_t space(m_buffer.size() - m_len);
			m_stream->read(data, space);
			std::size_t const read_len(m_stream->gcount());
			m_len += read_len;

			if (m_stream->eof())
			{
				m_pos = m_len;
				m_fsm.p = data_start;
				m_fsm.pe = data_start + m_len;
				m_fsm.eof = m_fsm.pe;
				return;
			}

			// Try to find the last newline in the new part.
			std::string_view sv(data, read_len);
			m_pos = sv.rfind('\n');
			if (std::string_view::npos != m_pos)
			{
				m_pos += (data - data_start);
				m_fsm.p = data_start;
				m_fsm.pe = m_fsm.p + m_pos + 1;
				return;
			}

			m_buffer.resize(2 * m_buffer.size());
		}
	}

	bool vcf_reader::parse(callback_fn &&callback)
	{
		return parse(callback);
	}

	bool vcf_reader::parse(callback_fn const &cb)
	{
		typedef variant_tpl <std::string_view> vc;
		bool retval(true);
		int cs(0);
		// FIXME: add throwing EOF actions?
		%%{
			variable p		m_fsm.p;
			variable pe		m_fsm.pe;
			variable eof	m_fsm.eof;

			action start_string {
				m_start = fpc;
			}

			action start_integer {
				m_integer = 0;
			}

			action update_integer {
				// Shift and add the current number.
				m_integer *= 10;
				m_integer += fc - '0';
			}

			action end_sample_field {
				// Check that the current field is followed by another field, another sample or a new record.
				switch (fc)
				{
					case ':':
						fgoto sample_rec_f;

					case '\t':
					{
						always_assert(m_format.size() == m_format_idx, "Not all fields present in the sample");
						m_format_idx = 0;
						fgoto sample_rec_f;
					}

					case '\n':
					{
						always_assert(m_format.size() == m_format_idx, "Not all fields present in the sample");

						if(!cb(m_current_variant))
						{
							fhold;
							fbreak;
						}

						fgoto main;
					}

					default:
						fail("Unexpected character");
				}
			}

			action error {
				fail("Unexpected character");
			}

			tab			= '\t';

			id_string	= '<' alnum+ '>';

			chrom_id	= (alnum+)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_chrom_id); };

			pos			= (digit+)
				>(start_integer)
				$(update_integer)
				%{ HANDLE_INTEGER_END(&vc::set_pos); };

			id_part		= (alnum+)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_id, m_idx++); };
			id_rec		= (id_part (';' id_part)*) >{ m_idx = 0; };

			ref			= ([ACGTN]+)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_ref); };

			# FIXME: add breakends.
			simple_alt	= ([ACGTN]+);
			complex_alt	= ([*]+) %{ m_alt_is_complex = true; };
			alt_part	= (simple_alt | complex_alt)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_alt, m_idx++, m_alt_is_complex); };
			alt			= (alt_part (',' alt_part)*) >{ m_idx = 0; };

			qual		= (digit+)
				>(start_integer)
				$(update_integer)
				%{ HANDLE_INTEGER_END(&vc::set_qual); };

			# FIXME: add actions.
			filter_pass	= 'PASS';
			filter_part	= alnum+;
			filter		= (filter_pass | (filter_part (';' filter_part)*));

			# FIXME: add actions.
			info_key	= (alnum | '_') +;
			info_str	= (alnum | [_.]) +;
			info_val	= info_str (',' info_str)*;
			info_part	= info_key ('=' info_val)?;
			info		= (info_part (';' info_part)*);

			# FIXME: handle other formats.
			format_gt	= ('GT') @{ m_format.emplace_back(format_field::GT); };
			format_dp	= ('DP') @{ m_format.emplace_back(format_field::DP); };
			format_gq	= ('GQ') @{ m_format.emplace_back(format_field::GQ); };
			format_ps	= ('PS') @{ m_format.emplace_back(format_field::PS); };
			format_pq	= ('PQ') @{ m_format.emplace_back(format_field::PQ); };
			format_mq	= ('MQ') @{ m_format.emplace_back(format_field::MQ); };
			format_part	= format_gt | format_dp | format_gq | format_ps | format_pq | format_mq;
			format		= ((format_part (':' format_part)*) >{ m_format.clear(); });

			# Genotype field in sample.
			sample_gt_null_allele	= '.'
				%{
					m_integer = NULL_ALLELE;
					HANDLE_INTEGER_END(&vc::set_gt, m_sample_idx, m_idx++, m_gt_is_phased);
				};

			sample_gt_allele_idx	= (digit+)
				>(start_integer)
				$(update_integer)
				%{
					HANDLE_INTEGER_END(&vc::set_gt, m_sample_idx, m_idx++, m_gt_is_phased);
					m_gt_is_phased = false;
				};

			sample_gt_part			= (sample_gt_null_allele | sample_gt_allele_idx);
			sample_gt_p				= sample_gt_part ('|' ${ m_gt_is_phased = true; } sample_gt_part)+;
			sample_gt_up			= sample_gt_part ('/' sample_gt_part)+;
			sample_gt				= (sample_gt_part | sample_gt_p | sample_gt_up)
				>{
					m_idx = 0;
				};

			# FIXME: add actions.
			sample_dp		= (digit+);
			sample_gq		= (digit+);
			sample_ps		= (digit+);
			sample_pq		= (digit+);
			sample_mq		= (digit+);

			sep				= '\t';		# Field separator
			ssep			= [\t\n:];	# Sample separator

			# Handle a newline and continue.
			main_nl := '\n' %{ fgoto main; };
			break_nl := '\n' %{ fbreak; };

			# Line start.
			# Apparently main has to be able to read a character, so use fhold.
			# Allow EOF, though, with '?'.
			main := any?
				${
					fhold;

					m_idx = 0;
					m_format_idx = 0;
					m_sample_idx = 0;
					m_alt_is_complex = false;
					++m_lineno;
					m_current_variant.reset();
					m_current_variant.set_lineno(m_lineno);

					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::CHROM, fentry(chrom_id_f), cb);
				}
				$err(error)
				$eof{ retval = false; };

			# #CHROM
			chrom_id_f :=
				(chrom_id sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::POS, fentry(pos_f), cb);
				}
				$err(error);

			# POS
			pos_f :=
				(pos sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::ID, fentry(id_f), cb);
				}
				$err(error);

			# ID
			id_f :=
				(id_rec sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::REF, fentry(ref_f), cb);
				}
				$err(error);

			# REF
			ref_f :=
				(ref sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::ALT, fentry(alt_f), cb);
				}
				$err(error);

			# ALT
			alt_f :=
				(alt sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::QUAL, fentry(qual_f), cb);
				}
				$err(error);

			# QUAL
			qual_f :=
				(qual sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::FILTER, fentry(filter_f), cb);
				}
				$err(error);

			# FILTER
			filter_f :=
				(filter sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::INFO, fentry(info_f), cb);
				}
				$err(error);

			# INFO
			info_f :=
				(info sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::FORMAT, fentry(format_f), cb);
				}
				$err(error);

			# FORMAT
			# FIXME: try to skip parsing the field and compare to the existing format?
			format_f :=
				(format sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::ALL, fentry(sample_rec_f), cb);
				}
				$err(error);

			# Sample fields
			sample_gt_f := ((sample_gt) ssep @(end_sample_field)) $err(error);
			sample_dp_f := ((sample_dp) ssep @(end_sample_field)) $err(error);
			sample_gq_f := ((sample_gq) ssep @(end_sample_field)) $err(error);
			sample_ps_f := ((sample_ps) ssep @(end_sample_field)) $err(error);
			sample_pq_f := ((sample_pq) ssep @(end_sample_field)) $err(error);
			sample_mq_f := ((sample_mq) ssep @(end_sample_field)) $err(error);

			# Sample record
			sample_rec_f := "" >to{
				always_assert(m_format_idx < m_format.size(), "Format does not match the sample");

				// Sample index 0 is reserved for the reference.
				++m_sample_idx;

				// Parse according to the format field.
				auto const idx(m_format_idx);
				++m_format_idx;
				auto const field(m_format[idx]);
				switch (field)
				{
					case format_field::GT:
						fgoto sample_gt_f;

					case format_field::DP:
						fgoto sample_dp_f;

					case format_field::GQ:
						fgoto sample_gq_f;

					case format_field::PS:
						fgoto sample_ps_f;

					case format_field::PQ:
						fgoto sample_pq_f;

					case format_field::MQ:
						fgoto sample_mq_f;

					default:
						fail("Unexpected format value");
				}
			};

			dummy := any
				@{
					// Dummy action,
					// make sure that all the machines are instantiated.
					if (false)
					{
						fgoto chrom_id_f;
						fgoto pos_f;
						fgoto id_f;
						fgoto ref_f;
						fgoto alt_f;
						fgoto qual_f;
						fgoto filter_f;
						fgoto info_f;
						fgoto format_f;
						fgoto sample_rec_f;

						fgoto sample_gt_f;
						fgoto sample_dp_f;
						fgoto sample_gq_f;
						fgoto sample_ps_f;
						fgoto sample_pq_f;
						fgoto sample_mq_f;
					}
				};

			write init;
			write exec;
		}%%

		return retval;
	}
}

/*
 Copyright (c) 2017 Tuukka Norri
 This code is licensed under MIT license (see LICENSE for details).
 */

#include <vcf2multialign/util.hh>
#include <vcf2multialign/vcf_reader.hh>

%% machine vcf_parser;
%% write data;

// We would like to post-process strings that have been read and then pass
// them to the variant object with a simple function call at the call site.
// Solution: Templates can have member function pointers as parameters but of a specific type.
#define HANDLE_STRING_END(FN, ...)	caller <decltype(FN)>::handle_string_end <FN>(*this, ##__VA_ARGS__)
#define HANDLE_INTEGER_END(FN, ...)	caller <decltype(FN)>::handle_integer_end <FN>(*this, ##__VA_ARGS__)

namespace vcf2multialign { namespace detail {

	template <typename t_enum>
	constexpr typename std::underlying_type <t_enum>::type to_underlying(t_enum e)
	{
		return static_cast <typename std::underlying_type <t_enum>::type>(e);
	}

	// Split a t_string into string_views.
	template <bool t_emplace_back, typename t_string, typename t_invalid_pos>
	size_t read_fields(
		t_string const &string,
		t_invalid_pos const invalid_pos,
		char const *string_start,
		char const *sep,
		size_t const count,
		std::vector <std::string_view> &res
	)
	{
		char const *string_ptr(string_start);

		if (t_emplace_back)
			res.clear();
		else
			res.resize(count);

		typename t_string::size_type sep_pos(0);
		size_t i(0);
		bool should_break(false);
		while (i < count)
		{
			sep_pos = string.find(sep, sep_pos);
			if (invalid_pos == sep_pos)
			{
				should_break = true;
				sep_pos = string.size();
			}

			if (t_emplace_back)
				res.emplace_back(string_ptr, sep_pos - (string_ptr - string_start));
			else
			{
				std::string_view sv(string_ptr, sep_pos - (string_ptr - string_start));
				res[i] = std::move(sv);
			}

			++i;
			++sep_pos;
			string_ptr = string_start + sep_pos;

			if (should_break)
				break;
		}
		return i;
	}

	// Split a string into string_views.
	template <bool t_emplace_back>
	size_t read_fields(
		std::string const &string,
		char const *sep,
		size_t const count,
		std::vector <std::string_view> &res
	)
	{
		return read_fields <t_emplace_back>(string, std::string::npos, string.c_str(), sep, count, res);
	}

	template <bool t_emplace_back>
	size_t read_fields(
		std::string_view const &sv,
		char const *sep,
		size_t const count,
		std::vector <std::string_view> &res
	)
	{
		return read_fields <t_emplace_back>(sv, std::string_view::npos, static_cast <char const *>(sv.data()), sep, count, res);
	}
}}

namespace vcf2multialign {

	template <typename t_fnt>
	struct vcf_reader::caller
	{
		template <t_fnt t_fn, typename ... t_args>
		static void handle_string_end(vcf_reader &r, t_args ... args)
		{
			std::string_view sv(r.m_start, r.m_fsm.p - r.m_start);
			(r.m_current_variant.*(t_fn))(sv, std::forward <t_args>(args)...);
		}

		template <t_fnt t_fn, typename ... t_args>
		static void handle_integer_end(vcf_reader &r, t_args ... args)
		{
			(r.m_current_variant.*(t_fn))(r.m_integer, std::forward <t_args>(args)...);
		}
	};

	template <int t_continue, int t_break>
	int vcf_reader::check_max_field(vcf_field const field, int const target, callback_fn const &cb)
	{
		if (field <= m_max_parsed_field)
			return target;

		skip_to_next_nl();
		if (!cb(m_current_variant))
			return t_break;

		return t_continue;
	}

	void vcf_reader::skip_to_next_nl()
	{
		std::string_view sv(m_fsm.p, m_fsm.pe - m_fsm.p);
		auto const pos(sv.find('\n'));
		always_assert(std::string_view::npos != pos, "Unable to find the next newline");
		m_fsm.p += pos;
	}

	// Seek to the beginning of the records.
	void vcf_reader::reset()
	{
		m_stream->clear();
		m_stream->seekg(m_first_variant_offset);
		m_lineno = m_last_header_lineno;
		m_len = 0;
		m_pos = 0;
	}

	// Return the 1-based number of the given sample.
	size_t vcf_reader::sample_no(std::string const &sample_name) const
	{
		auto const it(m_sample_names.find(sample_name));
		if (it == m_sample_names.cend())
			return 0;
		return it->second;
	}

	void vcf_reader::read_header()
	{
		// For now, just skip lines that begin with "##".
		std::string line;
		while (std::getline(*m_stream, line))
		{
			++m_lineno;
			if (! ('#' == line[0] && '#' == line[1]))
				break;

			// FIXME: header handling goes here.
		}

		// Check for column headers.
		{
			auto const prefix(std::string("#CHROM"));
			auto const res(mismatch(line.cbegin(), line.cend(), prefix.cbegin(), prefix.cend()));
			if (prefix.cend() != res.second)
			{
				std::cerr << "Expected the next line to start with '#CHROM', instead got: '" << line << "'" << std::endl;
				exit(1);
			}
		}

		// Read sample names.
		std::vector <std::string_view> header_names;
		detail::read_fields <true>(line, "\t", -1, header_names);
		std::size_t i(1);
		for (auto it(header_names.cbegin() + detail::to_underlying(vcf_field::ALL)), end(header_names.cend()); it != end; ++it)
		{
			std::string str(*it);
			auto const res(m_sample_names.emplace(std::move(str), i));
			always_assert(res.second, "Duplicate sample name");
			++i;
		}

		// stream now points to the first variant.
		m_first_variant_offset = m_stream->tellg();
		m_last_header_lineno = m_lineno;

		// Instantiate a variant.
		transient_variant var(sample_count());
		using std::swap;
		swap(m_current_variant, var);
	}

	void vcf_reader::fill_buffer()
	{
		// Copy the remainder to the beginning.
		if (m_pos + 1 < m_len)
		{
			char *data_start(m_buffer.data());
			char const *start(data_start + m_pos + 1);
			char const *end(data_start + m_len);
			std::copy(start, end, data_start);
			m_len -= m_pos + 1;
		}
		else
		{
			m_len = 0;
		}

		// Read until there's at least one newline in the buffer.
		while (true)
		{
			char *data_start(m_buffer.data());
			char *data(data_start + m_len);

			std::size_t space(m_buffer.size() - m_len);
			m_stream->read(data, space);
			std::size_t const read_len(m_stream->gcount());
			m_len += read_len;

			if (m_stream->eof())
			{
				m_pos = m_len;
				m_fsm.p = data_start;
				m_fsm.pe = data_start + m_len;
				m_fsm.eof = m_fsm.pe;
				return;
			}

			// Try to find the last newline in the new part.
			std::string_view sv(data, read_len);
			m_pos = sv.rfind('\n');
			if (std::string_view::npos != m_pos)
			{
				m_pos += (data - data_start);
				m_fsm.p = data_start;
				m_fsm.pe = m_fsm.p + m_pos + 1;
				return;
			}

			m_buffer.resize(2 * m_buffer.size());
		}
	}

	bool vcf_reader::parse(callback_fn &&callback)
	{
		return parse(callback);
	}

	bool vcf_reader::parse(callback_fn const &cb)
	{
		typedef variant_tpl <std::string_view> vc;
		bool retval(true);
		int cs(0);
		// FIXME: add throwing EOF actions?
		%%{
			variable p		m_fsm.p;
			variable pe		m_fsm.pe;
			variable eof	m_fsm.eof;

			action start_string {
				m_start = fpc;
			}

			action start_integer {
				m_integer = 0;
			}

			action update_integer {
				// Shift and add the current number.
				m_integer *= 10;
				m_integer += fc - '0';
			}

			action end_sample_field {
				// Check that the current field is followed by another field, another sample or a new record.
				switch (fc)
				{
					case ':':
						fgoto sample_rec_f;

					case '\t':
					{
						always_assert(m_format.size() == m_format_idx, "Not all fields present in the sample");
						m_format_idx = 0;
						fgoto sample_rec_f;
					}

					case '\n':
					{
						always_assert(m_format.size() == m_format_idx, "Not all fields present in the sample");

						if(!cb(m_current_variant))
						{
							fhold;
							fbreak;
						}

						fgoto main;
					}

					default:
						fail("Unexpected character");
				}
			}

			action error {
				fail("Unexpected character");
			}

			tab			= '\t';

			id_string	= '<' alnum+ '>';

			chrom_id	= (alnum+)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_chrom_id); };

			pos			= (digit+)
				>(start_integer)
				$(update_integer)
				%{ HANDLE_INTEGER_END(&vc::set_pos); };

			id_part		= (alnum+)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_id, m_idx++); };
			id_rec		= (id_part (';' id_part)*) >{ m_idx = 0; };

			ref			= ([ACGTN]+)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_ref); };

			# FIXME: add breakends.
			simple_alt	= ([ACGTN]+);
			complex_alt	= ([*]+) %{ m_alt_is_complex = true; };
			alt_part	= (simple_alt | complex_alt)
				>(start_string)
				%{ HANDLE_STRING_END(&vc::set_alt, m_idx++, m_alt_is_complex); };
			alt			= (alt_part (',' alt_part)*) >{ m_idx = 0; };

			qual		= (digit+)
				>(start_integer)
				$(update_integer)
				%{ HANDLE_INTEGER_END(&vc::set_qual); };

			# FIXME: add actions.
			filter_pass	= 'PASS';
			filter_part	= alnum+;
			filter		= (filter_pass | (filter_part (';' filter_part)*));

			# FIXME: add actions.
			info_key	= (alnum | '_') +;
			info_str	= (alnum | [_.]) +;
			info_val	= info_str (',' info_str)*;
			info_part	= info_key ('=' info_val)?;
			info		= (info_part (';' info_part)*);

			# FIXME: handle other formats.
			format_gt	= ('GT') @{ m_format.emplace_back(format_field::GT); };
			format_dp	= ('DP') @{ m_format.emplace_back(format_field::DP); };
			format_gq	= ('GQ') @{ m_format.emplace_back(format_field::GQ); };
			format_ps	= ('PS') @{ m_format.emplace_back(format_field::PS); };
			format_pq	= ('PQ') @{ m_format.emplace_back(format_field::PQ); };
			format_mq	= ('MQ') @{ m_format.emplace_back(format_field::MQ); };
			format_part	= format_gt | format_dp | format_gq | format_ps | format_pq | format_mq;
			format		= ((format_part (':' format_part)*) >{ m_format.clear(); });

			# Genotype field in sample.
			sample_gt_null_allele	= '.'
				%{
					m_integer = NULL_ALLELE;
					HANDLE_INTEGER_END(&vc::set_gt, m_sample_idx - 1, m_idx++, m_gt_is_phased);
				};

			sample_gt_allele_idx	= (digit+)
				>(start_integer)
				$(update_integer)
				%{
					HANDLE_INTEGER_END(&vc::set_gt, m_sample_idx - 1, m_idx++, m_gt_is_phased);
					m_gt_is_phased = false;
				};

			sample_gt_part			= (sample_gt_null_allele | sample_gt_allele_idx);
			sample_gt_p				= sample_gt_part ('|' ${ m_gt_is_phased = true; } sample_gt_part)+;
			sample_gt_up			= sample_gt_part ('/' sample_gt_part)+;
			sample_gt				= (sample_gt_part | sample_gt_p | sample_gt_up)
				>{
					m_idx = 0;
				};

			# FIXME: add actions.
			sample_dp		= (digit+);
			sample_gq		= (digit+);
			sample_ps		= (digit+);
			sample_pq		= (digit+);
			sample_mq		= (digit+);

			sep				= '\t';		# Field separator
			ssep			= [\t\n:];	# Sample separator

			# Handle a newline and continue.
			main_nl := '\n' %{ fgoto main; };
			break_nl := '\n' %{ fbreak; };

			# Line start.
			# Apparently main has to be able to read a character, so use fhold.
			# Allow EOF, though, with '?'.
			main := any?
				${
					fhold;

					m_idx = 0;
					m_format_idx = 0;
					m_sample_idx = 0;
					m_alt_is_complex = false;
					++m_lineno;
					m_current_variant.reset();
					m_current_variant.set_lineno(m_lineno);

					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::CHROM, fentry(chrom_id_f), cb);
				}
				$err(error)
				$eof{ retval = false; };

			# #CHROM
			chrom_id_f :=
				(chrom_id sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::POS, fentry(pos_f), cb);
				}
				$err(error);

			# POS
			pos_f :=
				(pos sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::ID, fentry(id_f), cb);
				}
				$err(error);

			# ID
			id_f :=
				(id_rec sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::REF, fentry(ref_f), cb);
				}
				$err(error);

			# REF
			ref_f :=
				(ref sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::ALT, fentry(alt_f), cb);
				}
				$err(error);

			# ALT
			alt_f :=
				(alt sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::QUAL, fentry(qual_f), cb);
				}
				$err(error);

			# QUAL
			qual_f :=
				(qual sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::FILTER, fentry(filter_f), cb);
				}
				$err(error);

			# FILTER
			filter_f :=
				(filter sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::INFO, fentry(info_f), cb);
				}
				$err(error);

			# INFO
			info_f :=
				(info sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::FORMAT, fentry(format_f), cb);
				}
				$err(error);

			# FORMAT
			# FIXME: try to skip parsing the field and compare to the existing format?
			format_f :=
				(format sep)
				@{
					fgoto *check_max_field <fentry(main_nl), fentry(break_nl)>(vcf_field::ALL, fentry(sample_rec_f), cb);
				}
				$err(error);

			# Sample fields
			sample_gt_f := ((sample_gt) ssep @(end_sample_field)) $err(error);
			sample_dp_f := ((sample_dp) ssep @(end_sample_field)) $err(error);
			sample_gq_f := ((sample_gq) ssep @(end_sample_field)) $err(error);
			sample_ps_f := ((sample_ps) ssep @(end_sample_field)) $err(error);
			sample_pq_f := ((sample_pq) ssep @(end_sample_field)) $err(error);
			sample_mq_f := ((sample_mq) ssep @(end_sample_field)) $err(error);

			# Sample record
			sample_rec_f := "" >to{
				always_assert(m_format_idx < m_format.size(), "Format does not match the sample");

				++m_sample_idx;

				// Parse according to the format field.
				auto const idx(m_format_idx);
				++m_format_idx;
				auto const field(m_format[idx]);
				switch (field)
				{
					case format_field::GT:
						fgoto sample_gt_f;

					case format_field::DP:
						fgoto sample_dp_f;

					case format_field::GQ:
						fgoto sample_gq_f;

					case format_field::PS:
						fgoto sample_ps_f;

					case format_field::PQ:
						fgoto sample_pq_f;

					case format_field::MQ:
						fgoto sample_mq_f;

					default:
						fail("Unexpected format value");
				}
			};

			dummy := any
				@{
					// Dummy action,
					// make sure that all the machines are instantiated.
					if (false)
					{
						fgoto chrom_id_f;
						fgoto pos_f;
						fgoto id_f;
						fgoto ref_f;
						fgoto alt_f;
						fgoto qual_f;
						fgoto filter_f;
						fgoto info_f;
						fgoto format_f;
						fgoto sample_rec_f;

						fgoto sample_gt_f;
						fgoto sample_dp_f;
						fgoto sample_gq_f;
						fgoto sample_ps_f;
						fgoto sample_pq_f;
						fgoto sample_mq_f;
					}
				};

			write init;
			write exec;
		}%%

		return retval;
	}
}


Add different escaping for pre and notextile blocks.

/*
 * superredcloth_scan.rl
 *
 * $Author: why $
 * $Date$
 *
 * Copyright (C) 2007 why the lucky stiff
 */
#define superredcloth_scan_c

#include <ruby.h>
#include "superredcloth.h"

VALUE super_ParseError, super_RedCloth, super_HTML;

%%{

  machine superredcloth_scan;
  include superredcloth_common "ext/superredcloth_scan/superredcloth_common.rl";

  action extend { extend = rb_hash_aref(regs, ID2SYM(rb_intern("type"))); }

  # blocks
  notextile_tag_start = "<notextile>" ;
  notextile_tag_end = "</notextile>" ;
  notextile_line = " " (( default+ ) -- CRLF) CRLF ;
  notextile_block_start = ( "notextile" >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  pre_tag_start = "
]* ">" (space* "")? ;
  pre_tag_end = ("" space*)? "
" ;
  pre_block_start = ( "pre" >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  bc_start = ( "bc" >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  bq_start = ( "bq" >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  btype = ( "p" | "h1" | "h2" | "h3" | "h4" | "h5" | "h6" | "div" ) ;
  block_start = ( btype >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  next_block_start = ( btype A C :> "." ) ;
  double_return = CRLF{2,} ;
  block_end = ( double_return | EOF );
  extended_block_end = double_return . next_block_start >A @{ p = reg - 1; } ;
  ftype = ( "fn" >A %{ STORE(type) } digit+ >A %{ STORE(id) } ) ;
  footnote_start = ( ftype A C :> dotspace ) ;
  ul = "*" %{nest++; list_type = "ul";};
  ol = "#" %{nest++; list_type = "ol";};
  list_start  = ( ( ul | ol )+ N A C :> " "+ ) >{nest = 0;} ;
  blank_line = CRLF;

  # html blocks
  BlockTagName = Name* - ("pre" | "notextile" | "a" | "applet" | "basefont" | "bdo" | "br" | "font" | "iframe" | "img" | "map" | "object" | "param" | "q" | "script" | "span" | "sub" | "sup" | "abbr" | "acronym" | "cite" | "code" | "del" | "dfn" | "em" | "ins" | "kbd" | "samp" | "strong" | "var" | "b" | "big" | "i" | "s" | "small" | "strike" | "tt" | "u");
  block_start_tag = "<" BlockTagName space+ AttrSet* (AttrEnd)? ">" | "<" BlockTagName ">";
  block_empty_tag = "<" BlockTagName space+ AttrSet* (AttrEnd)? "/>" | "<" BlockTagName "/>" ;
  block_end_tag = "</" BlockTagName space* ">" ;
  html_start = indent (block_start_tag | block_empty_tag) indent ;
  html_end = indent block_end_tag indent CRLF* ;
  standalone_html = indent (block_start_tag | block_empty_tag | block_end_tag) indent CRLF+;

  # tables
  para = ( default+ ) -- CRLF ;
  btext = para ( CRLF{2} )? ;
  tddef = ( D? S A C :> dotspace ) ;
  td = ( tddef? btext >A %T :> "|" >{PASS(table, text, td);} ) >X ;
  trdef = ( A C :> dotspace ) ;
  tr = ( trdef? "|" %{INLINE(table, tr_open);} td+ ) >X %{INLINE(table, tr_close);} ;
  trows = ( tr (CRLF >X tr)* ) ;
  tdef = ( "table" >X A C :> dotspace CRLF ) ;
  table = ( tdef? trows >{INLINE(table, table_open);} ) >{ reg = NULL; } ;

  pre_tag := |*
    pre_tag_end         { CAT(block); DONE(block); fgoto main; };
    default => esc_pre;
  *|;

  pre_block := |*
    EOF                { ADD_BLOCKCODE(); fgoto main; };
    extended_block_end { ADD_BLOCKCODE(); fgoto main; };
    double_return      { if (NIL_P(extend)) { ADD_BLOCKCODE(); fgoto main; } else { ADD_EXTENDED_BLOCKCODE(); } };
    default => esc_pre;
  *|;

  notextile_tag := |*
    notextile_tag_end   { DONE(block); fgoto main; };
    default => cat;
  *|;

  notextile_block := |*
    EOF                { DONE(block); fgoto main; };
    extended_block_end { DONE(block); fgoto main; };
    double_return      { if (NIL_P(extend)) { DONE(block); fgoto main; } else { DONE(block); } };
    default => cat;
  *|;

  html := |*
    html_end        { CAT(block); ADD_BLOCK(); fgoto main; };
    default => cat;
  *|;

  bc := |*
    EOF                { ADD_BLOCKCODE(); INLINE(html, bc_close); plain_block = rb_str_new2("p"); fgoto main; };
    extended_block_end { ADD_BLOCKCODE(); INLINE(html, bc_close); plain_block = rb_str_new2("p"); fgoto main; };
    double_return      { if (NIL_P(extend)) { ADD_BLOCKCODE(); INLINE(html, bc_close); plain_block = rb_str_new2("p"); fgoto main; } else { ADD_EXTENDED_BLOCKCODE(); } };
    default => esc_pre;
  *|;

  bq := |*
    EOF                { ADD_BLOCK(); INLINE(html, bq_close); fgoto main; };
    extended_block_end { ADD_BLOCK(); INLINE(html, bq_close); fgoto main; };
    double_return      { if (NIL_P(extend)) { ADD_BLOCK(); INLINE(html, bq_close); fgoto main; } else { ADD_EXTENDED_BLOCK(); } };
    default => cat;
  *|;

  block := |*
    EOF                { ADD_BLOCK(); fgoto main; };
    extended_block_end { ADD_BLOCK(); fgoto main; };
    double_return      { if (NIL_P(extend)) { ADD_BLOCK(); fgoto main; } else { ADD_EXTENDED_BLOCK(); } };
    default => cat;
  *|;

  footnote := |*
    block_end       { ADD_BLOCK(); fgoto main; };
    default => cat;
  *|;

  list := |*
    CRLF list_start { ADD_BLOCK(); LIST_ITEM(); };
    block_end       { ADD_BLOCK(); nest = 0; LIST_CLOSE(); fgoto main; };
    default => cat;
  *|;

  main := |*
    notextile_line  { CAT(block); DONE(block); };
    notextile_tag_start { ASET(type, notextile); fgoto notextile_tag; };
    notextile_block_start { fgoto notextile_block; };
    pre_tag_start       { ASET(type, notextile); CAT(block); fgoto pre_tag; };
    pre_block_start { fgoto pre_block; };
    standalone_html { CAT(block); DONE(block); };
    html_start      { ASET(type, notextile); CAT(block); fgoto html; };
    bc_start        { INLINE(html, bc_open); ASET(type, code); plain_block = rb_str_new2("code"); fgoto bc; };
    bq_start        { INLINE(html, bq_open); ASET(type, p); fgoto bq; };
    block_start     { fgoto block; };
    footnote_start  { fgoto footnote; };
    list_start      { list_layout = rb_ary_new(); LIST_ITEM(); fgoto list; };
    table           { INLINE(table, table_close); DONE(table); fgoto block; };
    blank_line => cat;
    default
    {
      regs = rb_hash_new();
      rb_hash_aset(regs, ID2SYM(rb_intern("type")), plain_block);
      CAT(block);
      fgoto block;
    };
    EOF;
  *|;

}%%

%% write data nofinal;

VALUE
superredcloth_transform(rb_formatter, p, pe)
  VALUE rb_formatter;
  char *p, *pe;
{
  int cs, act, nest;
  char *tokstart = NULL, *tokend = NULL, *reg = NULL;
  VALUE html = rb_str_new2("");
  VALUE table = rb_str_new2("");
  VALUE block = rb_str_new2("");
  VALUE regs = rb_hash_new();
  VALUE list_layout = Qnil;
  char *list_type = NULL;
  VALUE list_index = rb_ary_new();
  int list_continue = 0;
  VALUE plain_block = rb_str_new2("p");
  VALUE extend = Qnil;
  char listm[10] = "";

  %% write init;

  %% write exec;

  if (RSTRING(block)->len > 0)
  {
    ADD_BLOCK();
  }

  return html;
}

VALUE
superredcloth_transform2(formatter, str)
  VALUE formatter, str;
{
  rb_str_cat2(str, "\n");
  StringValue(str);
  return superredcloth_transform(formatter, RSTRING(str)->ptr, RSTRING(str)->ptr + RSTRING(str)->len + 1);
}

static VALUE
superredcloth_to_html(self)
  VALUE self;
{
  char *pe, *p;
  int len = 0;

  return superredcloth_transform2(super_HTML, self);
}

static VALUE
superredcloth_to(self, formatter)
  VALUE self, formatter;
{
  char *pe, *p;
  int len = 0;

  return superredcloth_transform2(formatter, self);
}

void Init_superredcloth_scan()
{
  super_RedCloth = rb_define_class("SuperRedCloth", rb_cString);
  rb_define_method(super_RedCloth, "to_html", superredcloth_to_html, 0);
  rb_define_method(super_RedCloth, "to", superredcloth_to, 1);
  super_ParseError = rb_define_class_under(super_RedCloth, "ParseError", rb_eException);
  super_HTML = rb_define_module_under(super_RedCloth, "HTML");
}

/*
 * superredcloth_scan.rl
 *
 * $Author: why $
 * $Date$
 *
 * Copyright (C) 2007 why the lucky stiff
 */
#define superredcloth_scan_c

#include <ruby.h>
#include "superredcloth.h"

VALUE super_ParseError, super_RedCloth, super_HTML;

%%{

  machine superredcloth_scan;
  include superredcloth_common "ext/superredcloth_scan/superredcloth_common.rl";

  action extend { extend = rb_hash_aref(regs, ID2SYM(rb_intern("type"))); }

  # blocks
  notextile_start = "<notextile>" ;
  notextile_end = "</notextile>" ;
  notextile_line = " " (( default+ ) -- CRLF) CRLF ;
  pre_start = "
]* ">" (space* "")? ;
  pre_end = ("" space*)? "
" ;
  bc_start = ( "bc" >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  bq_start = ( "bq" >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  btype = ( "p" | "h1" | "h2" | "h3" | "h4" | "h5" | "h6" | "pre" | "notextile" | "div" ) ;
  block_start = ( btype >A %{ STORE(type) } A C :> "." ( "." %extend | "" ) " "+ ) ;
  next_block_start = ( btype A C :> "." ) ;
  double_return = CRLF{2,} ;
  block_end = ( double_return | EOF );
  extended_block_end = double_return . next_block_start >A @{ p = reg - 1; } ;
  ftype = ( "fn" >A %{ STORE(type) } digit+ >A %{ STORE(id) } ) ;
  footnote_start = ( ftype A C :> dotspace ) ;
  ul = "*" %{nest++; list_type = "ul";};
  ol = "#" %{nest++; list_type = "ol";};
  list_start  = ( ( ul | ol )+ N A C :> " "+ ) >{nest = 0;} ;
  blank_line = CRLF;

  # html blocks
  BlockTagName = Name* - ("pre" | "notextile" | "a" | "applet" | "basefont" | "bdo" | "br" | "font" | "iframe" | "img" | "map" | "object" | "param" | "q" | "script" | "span" | "sub" | "sup" | "abbr" | "acronym" | "cite" | "code" | "del" | "dfn" | "em" | "ins" | "kbd" | "samp" | "strong" | "var" | "b" | "big" | "i" | "s" | "small" | "strike" | "tt" | "u");
  block_start_tag = "<" BlockTagName space+ AttrSet* (AttrEnd)? ">" | "<" BlockTagName ">";
  block_empty_tag = "<" BlockTagName space+ AttrSet* (AttrEnd)? "/>" | "<" BlockTagName "/>" ;
  block_end_tag = "</" BlockTagName space* ">" ;
  html_start = indent (block_start_tag | block_empty_tag) indent ;
  html_end = indent block_end_tag indent CRLF* ;
  standalone_html = indent (block_start_tag | block_empty_tag | block_end_tag) indent CRLF+;

  # tables
  para = ( default+ ) -- CRLF ;
  btext = para ( CRLF{2} )? ;
  tddef = ( D? S A C :> dotspace ) ;
  td = ( tddef? btext >A %T :> "|" >{PASS(table, text, td);} ) >X ;
  trdef = ( A C :> dotspace ) ;
  tr = ( trdef? "|" %{INLINE(table, tr_open);} td+ ) >X %{INLINE(table, tr_close);} ;
  trows = ( tr (CRLF >X tr)* ) ;
  tdef = ( "table" >X A C :> dotspace CRLF ) ;
  table = ( tdef? trows >{INLINE(table, table_open);} ) >{ reg = NULL; } ;

  pre := |*
    pre_end         { CAT(block); DONE(block); fgoto main; };
    default => esc_pre;
  *|;

  notextile := |*
    notextile_end   { DONE(block); fgoto main; };
    default => cat;
  *|;

  html := |*
    html_end        { CAT(block); ADD_BLOCK(); fgoto main; };
    default => cat;
  *|;

  bc := |*
    EOF                { ADD_BLOCKCODE(); INLINE(html, bc_close); plain_block = rb_str_new2("p"); fgoto main; };
    extended_block_end { ADD_BLOCKCODE(); INLINE(html, bc_close); plain_block = rb_str_new2("p"); fgoto main; };
    double_return      { if (NIL_P(extend)) { ADD_BLOCKCODE(); INLINE(html, bc_close); plain_block = rb_str_new2("p"); fgoto main; } else { ADD_EXTENDED_BLOCKCODE(); } };
    default => esc_pre;
  *|;

  bq := |*
    EOF                { ADD_BLOCK(); INLINE(html, bq_close); fgoto main; };
    extended_block_end { ADD_BLOCK(); INLINE(html, bq_close); fgoto main; };
    double_return      { if (NIL_P(extend)) { ADD_BLOCK(); INLINE(html, bq_close); fgoto main; } else { ADD_EXTENDED_BLOCK(); } };
    default => cat;
  *|;

  block := |*
    EOF                { ADD_BLOCK(); fgoto main; };
    extended_block_end { ADD_BLOCK(); fgoto main; };
    double_return      { if (NIL_P(extend)) { ADD_BLOCK(); fgoto main; } else { ADD_EXTENDED_BLOCK(); } };
    default => cat;
  *|;

  footnote := |*
    block_end       { ADD_BLOCK(); fgoto main; };
    default => cat;
  *|;

  list := |*
    CRLF list_start { ADD_BLOCK(); LIST_ITEM(); };
    block_end       { ADD_BLOCK(); nest = 0; LIST_CLOSE(); fgoto main; };
    default => cat;
  *|;

  main := |*
    notextile_line  { CAT(block); DONE(block); };
    notextile_start { ASET(type, notextile); fgoto notextile; };
    pre_start       { ASET(type, notextile); CAT(block); fgoto pre; };
    standalone_html { CAT(block); DONE(block); };
    html_start      { ASET(type, notextile); CAT(block); fgoto html; };
    bc_start        { INLINE(html, bc_open); ASET(type, code); plain_block = rb_str_new2("code"); fgoto bc; };
    bq_start        { INLINE(html, bq_open); ASET(type, p); fgoto bq; };
    block_start     { fgoto block; };
    footnote_start  { fgoto footnote; };
    list_start      { list_layout = rb_ary_new(); LIST_ITEM(); fgoto list; };
    table           { INLINE(table, table_close); DONE(table); fgoto block; };
    blank_line => cat;
    default
    {
      regs = rb_hash_new();
      rb_hash_aset(regs, ID2SYM(rb_intern("type")), plain_block);
      CAT(block);
      fgoto block;
    };
    EOF;
  *|;

}%%

%% write data nofinal;

VALUE
superredcloth_transform(rb_formatter, p, pe)
  VALUE rb_formatter;
  char *p, *pe;
{
  int cs, act, nest;
  char *tokstart = NULL, *tokend = NULL, *reg = NULL;
  VALUE html = rb_str_new2("");
  VALUE table = rb_str_new2("");
  VALUE block = rb_str_new2("");
  VALUE regs = rb_hash_new();
  VALUE list_layout = Qnil;
  char *list_type = NULL;
  VALUE list_index = rb_ary_new();
  int list_continue = 0;
  VALUE plain_block = rb_str_new2("p");
  VALUE extend = Qnil;
  char listm[10] = "";

  %% write init;

  %% write exec;

  if (RSTRING(block)->len > 0)
  {
    ADD_BLOCK();
  }

  return html;
}

VALUE
superredcloth_transform2(formatter, str)
  VALUE formatter, str;
{
  rb_str_cat2(str, "\n");
  StringValue(str);
  return superredcloth_transform(formatter, RSTRING(str)->ptr, RSTRING(str)->ptr + RSTRING(str)->len + 1);
}

static VALUE
superredcloth_to_html(self)
  VALUE self;
{
  char *pe, *p;
  int len = 0;

  return superredcloth_transform2(super_HTML, self);
}

static VALUE
superredcloth_to(self, formatter)
  VALUE self, formatter;
{
  char *pe, *p;
  int len = 0;

  return superredcloth_transform2(formatter, self);
}

void Init_superredcloth_scan()
{
  super_RedCloth = rb_define_class("SuperRedCloth", rb_cString);
  rb_define_method(super_RedCloth, "to_html", superredcloth_to_html, 0);
  rb_define_method(super_RedCloth, "to", superredcloth_to, 1);
  super_ParseError = rb_define_class_under(super_RedCloth, "ParseError", rb_eException);
  super_HTML = rb_define_module_under(super_RedCloth, "HTML");
}


Removed the ugly hack for dealing with set closure ambiguity

%%{
  machine re_scanner;
  include re_property "property.rl";

  dot                   = '.';
  backslash             = '\\';
  alternation           = '|';
  beginning_of_line     = '^';
  end_of_line           = '$';

  range_open            = '{';
  range_close           = '}';
  curlies               = range_open | range_close;

  group_open            = '(';
  group_close           = ')';
  parantheses           = group_open | group_close;

  set_open              = '[';
  set_close             = ']';
  brackets              = set_open | set_close;

  class_name_posix      = 'alnum' | 'alpha' | 'blank' |
                          'cntrl' | 'digit' | 'graph' |
                          'lower' | 'print' | 'punct' |
                          'space' | 'upper' | 'xdigit' |
                          'word'  | 'ascii';

  class_posix           = '[:' . class_name_posix . ':]';

  char_type             = [dDhHsSwW];

  line_anchor           = beginning_of_line | end_of_line;
  anchor_char           = [AbBzZG];

  escaped_ascii         = [abefnrstv];
  octal_sequence        = [0-7]{1,3};

  hex_sequence          = 'x' . xdigit{1,2};
  wide_hex_sequence     = 'x' . '{' . xdigit{1,8} . '}';

  codepoint_single      = 'u' . xdigit{4};
  codepoint_list        = 'u{' . (xdigit{4} . space?)+'}';
  codepoint_sequence    = codepoint_single | codepoint_list;

  control_sequence      = ('c' | 'C-') . alpha;
  meta_sequence         = 'M-' . ((backslash . control_sequence) | alpha);

  zero_or_one           = '?' | '??' | '?+';
  zero_or_more          = '*' | '*?' | '*+';
  one_or_more           = '+' | '+?' | '++';

  quantifier_greedy     = '?'  | '*'  | '+';
  quantifier_reluctant  = '??' | '*?' | '+?';
  quantifier_possessive = '?+' | '*+' | '++';
  quantifier_mode       = '?'  | '+';

  quantifier_range      = range_open . (digit+)? . ','? . (digit+)? .
                          range_close . quantifier_mode?;

  quantifier_range_bre  = backslash . range_open . (digit+)? . ','? . (digit+)? .
                          backslash . range_close;

  quantifiers           = quantifier_greedy | quantifier_reluctant |
                          quantifier_possessive | quantifier_range;

  group_comment         = '?#' . [^)]+ . group_close;

  group_atomic          = '?>';
  group_passive         = '?:';

  assertion_lookahead   = '?=';
  assertion_nlookahead  = '?!';
  assertion_lookbehind  = '?<=';
  assertion_nlookbehind = '?<!';

  group_options         = '?' . ([mix]{1,3})? . '-'? . ([mix]{1,3})?;

  group_ref             = [gk];
  group_name            = alpha . (alnum+)?;
  group_named           = ('?<' . group_name . '>') | ("?'" . group_name . "'");
  group_name_ref        = group_ref . (('<' . group_name . '>') | ("'" . group_name . "'"));

  group_number          = '-'? . [1-9] . ([0-9]+)?;
  group_number_ref      = group_ref . (('<' . group_number . '>') | ("'" . group_number . "'"));

  group_type            = group_atomic | group_passive | group_named;

  assertion_type        = assertion_lookahead  | assertion_nlookahead |
                          assertion_lookbehind | assertion_nlookbehind;

  # characters that 'break' a literal
  meta_char             = dot | backslash | alternation |
                          curlies | parantheses | brackets |
                          line_anchor | quantifier_greedy;

  ascii_print           = ((0x20..0x7e) - meta_char)+;
  ascii_nonprint        = (0x01..0x1f | 0x7f)+;

  utf8_2_byte           = (0xc2..0xdf 0x80..0xbf)+;
  utf8_3_byte           = (0xe0..0xef 0x80..0xbf 0x80..0xbf)+;
  utf8_4_byte           = (0xf0..0xf4 0x80..0xbf 0x80..0xbf 0x80..0xbf)+;
  utf8_byte_sequence    = utf8_2_byte | utf8_3_byte | utf8_4_byte;

  non_literal_escape    = char_type | anchor_char | escaped_ascii |
                          group_ref | [xucCM];

  # EOF error, used where it can be detected
  action premature_end_error { raise "Premature end of pattern" }

  # group (nesting) and set open/close actions
  action group_opened { group_depth += 1; in_group = true }
  action group_closed { group_depth -= 1; in_group = group_depth > 0 ? true : false }

  action set_opened { set_depth += 1; in_set = true }
  action set_closed { set_depth -= 1; in_set = set_depth > 0 ? true : false }

  # Character set scanner, continues consuming characters until it meets the
  # closing bracket of the set.
  # --------------------------------------------------------------------------
  character_set := |*
    ']' %set_closed {
      self.emit(:set, :close, data[ts..te-1].pack('c*'), ts, te)
      fret;
    };

    '-]' %set_closed { # special case, emits two tokens
      self.emit(:set, :member, data[ts..te-2].pack('c*'), ts, te)
      self.emit(:set, :close,  data[ts+1..te-1].pack('c*'), ts, te)
      fret;
    };

    '^' {
      text = data[ts..te-1].pack('c*')
      if @tokens.last[1] == :open
        self.emit(:set, :negate, text, ts, te)
      else
        self.emit(:set, :member, text, ts, te)
      end
    };

    alnum . '-' . alnum {
      self.emit(:set, :range, data[ts..te-1].pack('c*'), ts, te)
    };

    '&&' {
      self.emit(:set, :intersection, data[ts..te-1].pack('c*'), ts, te)
    };

    '\\' {
      fcall set_escape_sequence;
    };

    class_posix @err(premature_end_error) {
      case text = data[ts..te-1].pack('c*')
      when '[:alnum:]';  self.emit(:set, :class_alnum,  text, ts, te)
      when '[:alpha:]';  self.emit(:set, :class_alpha,  text, ts, te)
      when '[:ascii:]';  self.emit(:set, :class_ascii,  text, ts, te)
      when '[:blank:]';  self.emit(:set, :class_blank,  text, ts, te)
      when '[:cntrl:]';  self.emit(:set, :class_cntrl,  text, ts, te)
      when '[:digit:]';  self.emit(:set, :class_digit,  text, ts, te)
      when '[:graph:]';  self.emit(:set, :class_graph,  text, ts, te)
      when '[:lower:]';  self.emit(:set, :class_lower,  text, ts, te)
      when '[:print:]';  self.emit(:set, :class_print,  text, ts, te)
      when '[:punct:]';  self.emit(:set, :class_punct,  text, ts, te)
      when '[:space:]';  self.emit(:set, :class_space,  text, ts, te)
      when '[:upper:]';  self.emit(:set, :class_upper,  text, ts, te)
      when '[:word:]';   self.emit(:set, :class_word,   text, ts, te)
      when '[:xdigit:]'; self.emit(:set, :class_xdigit, text, ts, te)
      else raise "Unsupported character posixe class at #{text} (char #{ts})"
      end
    };

    # exclude the closing bracket as a cleaner workaround for dealing with the
    # ambiguity caused upon exit from the unicode properties machine
    meta_char -- ']' {
     self.emit(:set, :member, data[ts..te-1].pack('c*'), ts, te)
    };

    any            |
    ascii_nonprint |
    utf8_2_byte    |
    utf8_3_byte    |
    utf8_4_byte    {
      self.emit(:set, :member, data[ts..te-1].pack('c*'), ts, te)
    };
  *|;

  # set escapes scanner
  # --------------------------------------------------------------------------
  set_escape_sequence := |*
    'b' {
      self.emit(:set, :backspace, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    char_type {
      case text = data[ts-1..te-1].pack('c*')
      when '\d'; self.emit(:set, :type_digit,     text, ts-1, te)
      when '\D'; self.emit(:set, :type_nondigit,  text, ts-1, te)
      when '\h'; self.emit(:set, :type_hex,       text, ts-1, te)
      when '\H'; self.emit(:set, :type_nonhex,    text, ts-1, te)
      when '\s'; self.emit(:set, :type_space,     text, ts-1, te)
      when '\S'; self.emit(:set, :type_nonspace,  text, ts-1, te)
      when '\w'; self.emit(:set, :type_word,      text, ts-1, te)
      when '\W'; self.emit(:set, :type_nonword,   text, ts-1, te)
      end
      fret;
    };

    hex_sequence . '-\\' . hex_sequence {
      self.emit(:set, :range_hex, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    hex_sequence {
      self.emit(:set, :member_hex, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    meta_char | [\\\]\-\,] {
      self.emit(:set, :escape, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    property_char > (escaped_set_alpha, 2) {
      fhold;
      fnext character_set;
      fcall unicode_property;
      fret;
    };

    # special case exclusion of escaped dash, could be cleaner.
    (ascii_print - char_type -- [\-}]) > (escaped_set_alpha, 1) |
    ascii_nonprint            |
    utf8_2_byte               |
    utf8_3_byte               |
    utf8_4_byte               {
      self.emit(:set, :escape, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };
  *|;

  # escape sequence scanner
  # --------------------------------------------------------------------------
  escape_sequence := |*
    [1-9] {
      text = data[ts-1..te-1].pack('c*')
      self.emit(:backref, :digit, text, ts-1, te)
      fret;
    };

    octal_sequence {
      self.emit(:escape, :octal, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    meta_char {
      case text = data[ts-1..te-1].pack('c*')
      when '\.';  self.emit(:escape, :dot,               text, ts-1, te)
      when '\|';  self.emit(:escape, :alternation,       text, ts-1, te)
      when '\^';  self.emit(:escape, :beginning_of_line, text, ts-1, te)
      when '\$';  self.emit(:escape, :end_of_line,       text, ts-1, te)
      when '\?';  self.emit(:escape, :zero_or_one,       text, ts-1, te)
      when '\*';  self.emit(:escape, :zero_or_more,      text, ts-1, te)
      when '\+';  self.emit(:escape, :one_or_more,       text, ts-1, te)
      when '\(';  self.emit(:escape, :group_open,        text, ts-1, te)
      when '\)';  self.emit(:escape, :group_close,       text, ts-1, te)
      when '\{';  self.emit(:escape, :interval_open,     text, ts-1, te)
      when '\}';  self.emit(:escape, :interval_close,    text, ts-1, te)
      when '\[';  self.emit(:escape, :set_open,          text, ts-1, te)
      when '\]';  self.emit(:escape, :set_close,         text, ts-1, te)
      when "\\\\";
        self.emit(:escape, :backslash, text, ts-1, te)
      end
      fret;
    };

    escaped_ascii > (escaped_alpha, 7) {
      # \b is emitted as backspace only when inside a character set, otherwise
      # it is a word boundary anchor. A syntax might "normalize" it if needed.
      case text = data[ts-1..te-1].pack('c*')
      when '\a'; self.emit(:escape, :bell,           text, ts-1, te)
      when '\e'; self.emit(:escape, :escape,         text, ts-1, te)
      when '\f'; self.emit(:escape, :form_feed,      text, ts-1, te)
      when '\n'; self.emit(:escape, :newline,        text, ts-1, te)
      when '\r'; self.emit(:escape, :carriage,       text, ts-1, te)
      when '\s'; self.emit(:escape, :space,          text, ts-1, te)
      when '\t'; self.emit(:escape, :tab,            text, ts-1, te)
      when '\v'; self.emit(:escape, :vertical_tab,   text, ts-1, te)
      end
      fret;
    };

    codepoint_sequence > (escaped_alpha, 6) {
      text = data[ts-1..te-1].pack('c*')
      if text[2].chr == '{'
        self.emit(:escape, :codepoint_list, text, ts-1, te)
      else
        self.emit(:escape, :codepoint,      text, ts-1, te)
      end
      fret;
    };

    hex_sequence > (escaped_alpha, 5) {
      self.emit(:escape, :hex, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    wide_hex_sequence > (escaped_alpha, 5) {
      self.emit(:escape, :hex_wide, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    control_sequence > (escaped_alpha, 4) {
      self.emit(:escape, :control, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    meta_sequence > (backslashed, 3) {
      self.emit(:escape, :meta_sequence, data[ts-1..te-1].pack('c*'), ts-1, te)
    };

    property_char > (escaped_alpha, 2) {
      fhold; fcall unicode_property; fret;
    };

    (any -- non_literal_escape) > (escaped_alpha, 1)  {
      self.emit(:escape, :literal, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };
  *|;

  # Main scanner
  # --------------------------------------------------------------------------
  main := |*

    # Meta characters
    # ------------------------------------------------------------------------
    dot {
      self.emit(:meta, :dot, data[ts..te-1].pack('c*'), ts, te)
    };

    alternation {
      self.emit(:meta, :alternation, data[ts..te-1].pack('c*'), ts, te)
    };

    # Anchors
    # ------------------------------------------------------------------------
    beginning_of_line {
      self.emit(:anchor, :beginning_of_line, data[ts..te-1].pack('c*'), ts, te)
    };

    end_of_line {
      self.emit(:anchor, :end_of_line, data[ts..te-1].pack('c*'), ts, te)
    };

    backslash . anchor_char > (backslashed, 3) {
      case text = data[ts..te-1].pack('c*')
      when '\\A'; self.emit(:anchor, :bos,                text, ts, te)
      when '\\z'; self.emit(:anchor, :eos,                text, ts, te)
      when '\\Z'; self.emit(:anchor, :eos_ob_eol,         text, ts, te)
      when '\\b'; self.emit(:anchor, :word_boundary,      text, ts, te)
      when '\\B'; self.emit(:anchor, :nonword_boundary,   text, ts, te)
      else raise "Unsupported anchor at #{text} (char #{ts})"
      end
    };

    # Character types
    #   \d, \D    digit, non-digit
    #   \h, \H    hex, non-hex
    #   \s, \S    space, non-space
    #   \w, \W    word, non-word
    # ------------------------------------------------------------------------
    backslash . char_type > (backslashed, 2) {
      case text = data[ts..te-1].pack('c*')
      when '\\d'; self.emit(:type, :digit,      text, ts, te)
      when '\\D'; self.emit(:type, :nondigit,   text, ts, te)
      when '\\h'; self.emit(:type, :hex,        text, ts, te)
      when '\\H'; self.emit(:type, :nonhex,     text, ts, te)
      when '\\s'; self.emit(:type, :space,      text, ts, te)
      when '\\S'; self.emit(:type, :nonspace,   text, ts, te)
      when '\\w'; self.emit(:type, :word,       text, ts, te)
      when '\\W'; self.emit(:type, :nonword,    text, ts, te)
      end
    };

    # Character sets
    # ------------------------------------------------------------------------
    set_open %set_opened  {
      self.emit(:set, :open, data[ts..te-1].pack('c*'), ts, te)
      fcall character_set;
    };

    # (?#...) comments: parsed as a single expression, without introducing a
    # new nesting level. Comments may not include parentheses, escaped or not.
    # special case for close, action performed on all transitions to get the
    # correct closing count.
    # ------------------------------------------------------------------------
    group_open . group_comment $group_closed {
      self.emit(:group, :comment, data[ts..te-1].pack('c*'), ts, te)
    };

    # Expression options:
    #   (?imx-imx)          option on/off
    #                         i: ignore case
    #                         m: multi-line (dot(.) match newline)
    #                         x: extended form
    #
    #   (?imx-imx:subexp)   option on/off for subexp
    # ------------------------------------------------------------------------
    group_open . group_options >group_opened {
      # special handling to resolve ambiguity with passive groups
      if data[te]
        c = data[te].chr
        if c == ':' # include the ':'
          self.emit(:group, :options, data[ts..te].pack('c*'), ts, te+1)
          p += 1
        elsif c == ')' # just options by themselves
          self.emit(:group, :options, data[ts..te-1].pack('c*'), ts, te)
        else
          raise "Unexpected '#{c}' in options sequene, expected ':' or ')'"
        end
      else
        raise "Premature end of pattern" unless data[te]
      end
    };

    # Assertions
    #   (?=subexp)          look-ahead
    #   (?!subexp)          negative look-ahead
    #   (?<=subexp)         look-behind
    #   (?<!subexp)         negative look-behind
    # ------------------------------------------------------------------------
    group_open . assertion_type >group_opened {
      case text =  data[ts..te-1].pack('c*')
      when '(?=';  self.emit(:assertion, :lookahead,    text, ts, te)
      when '(?!';  self.emit(:assertion, :nlookahead,   text, ts, te)
      when '(?<='; self.emit(:assertion, :lookbehind,   text, ts, te)
      when '(?<!'; self.emit(:assertion, :nlookbehind,  text, ts, te)
      end
    };

    # Groups
    #   (?:subexp)          passive (non-captured) group
    #   (?>subexp)          atomic group, don't backtrack in subexp.
    #   (?<name>subexp)     named group
    #   (?'name'subexp)     named group (single quoted version)
    #   (subexp)            captured group
    # ------------------------------------------------------------------------
    group_open . group_type >group_opened {
      case text =  data[ts..te-1].pack('c*')
      when '(?:';  self.emit(:group, :passive,      text, ts, te)
      when '(?>';  self.emit(:group, :atomic,       text, ts, te)

      when /\(\?<\w+>/
        self.emit(:group, :named,     text, ts, te)
      when /\(\?'\w+'/
        self.emit(:group, :named_sq,  text, ts, te)
      end
    };

    group_open @group_opened {
      text =  data[ts..te-1].pack('c*')
      self.emit(:group, :capture, text, ts, te)
    };

    group_close @group_closed {
      self.emit(:group, :close, data[ts..te-1].pack('c*'), ts, te)
    };

    # Group back-reference, named and numbered
    # ------------------------------------------------------------------------
    backslash . (group_name_ref | group_number_ref) > (backslashed, 4) {
      case text = data[ts..te-1].pack('c*')
      when /\\([gk])<[^\d-](\w+)?>/ # angle-brackets
        if $1 == 'k'
          self.emit(:backref, :name_ref_ab,  text, ts, te)
        else
          self.emit(:backref, :name_call_ab,  text, ts, te)
        end

      when /\\([gk])'[^\d-](\w+)?'/ #single quotes
        if $1 == 'k'
          self.emit(:backref, :name_ref_sq,  text, ts, te)
        else
          self.emit(:backref, :name_call_sq,  text, ts, te)
        end

      when /\\([gk])<\d+>/ # angle-brackets
        if $1 == 'k'
          self.emit(:backref, :number_ref_ab,  text, ts, te)
        else
          self.emit(:backref, :number_call_ab,  text, ts, te)
        end

      when /\\([gk])'\d+'/ # single quotes
        if $1 == 'k'
          self.emit(:backref, :number_ref_sq,  text, ts, te)
        else
          self.emit(:backref, :number_call_sq,  text, ts, te)
        end

      when /\\([gk])<-\d+>/ # angle-brackets
        if $1 == 'k'
          self.emit(:backref, :number_rel_ref_ab,  text, ts, te)
        else
          self.emit(:backref, :number_rel_call_ab,  text, ts, te)
        end

      when /\\([gk])'-\d+'/ # single quotes
        if $1 == 'k'
          self.emit(:backref, :number_rel_ref_sq,  text, ts, te)
        else
          self.emit(:backref, :number_rel_call_sq,  text, ts, te)
        end
      end
    };

    # Quantifiers
    # ------------------------------------------------------------------------
    zero_or_one {
      case text =  data[ts..te-1].pack('c*')
      when '?' ;  self.emit(:quantifier, :zero_or_one,            text, ts, te)
      when '??';  self.emit(:quantifier, :zero_or_one_reluctant,  text, ts, te)
      when '?+';  self.emit(:quantifier, :zero_or_one_possessive, text, ts, te)
      end
    };

    zero_or_more {
      case text =  data[ts..te-1].pack('c*')
      when '*' ;  self.emit(:quantifier, :zero_or_more,            text, ts, te)
      when '*?';  self.emit(:quantifier, :zero_or_more_reluctant,  text, ts, te)
      when '*+';  self.emit(:quantifier, :zero_or_more_possessive, text, ts, te)
      end
    };

    one_or_more {
      case text =  data[ts..te-1].pack('c*')
      when '+' ;  self.emit(:quantifier, :one_or_more,            text, ts, te)
      when '+?';  self.emit(:quantifier, :one_or_more_reluctant,  text, ts, te)
      when '++';  self.emit(:quantifier, :one_or_more_possessive, text, ts, te)
      end
    };

    quantifier_range  @err(premature_end_error) {
      self.emit(:quantifier, :interval, data[ts..te-1].pack('c*'), ts, te)
    };

    # BRE version
    quantifier_range_bre  @err(premature_end_error) {
      self.emit(:quantifier, :interval_bre, data[ts..te-1].pack('c*'), ts, te)
    };

    # Escaped sequences
    # ------------------------------------------------------------------------
    backslash > (backslashed, 1) {
      fcall escape_sequence;
    };

    # Literal: any run of ASCII (pritable or non-printable), and/or UTF-8,
    # except meta characters.
    # ------------------------------------------------------------------------
    ascii_print+    |
    ascii_nonprint+ |
    utf8_2_byte+    |
    utf8_3_byte+    |
    utf8_4_byte+    {
      self.append_literal(data, ts, te)
    };

  *|;
}%%

module Regexp::Scanner
  %% write data;

  # Scans the given regular expression text, or Regexp object and collects the
  # emitted token into an array that gets returned at the end. If a block is
  # given, it gets called for each emitted token.
  #
  # This method may raise errors if a syntax error is encountered.
  # --------------------------------------------------------------------------
  def self.scan(input, &block)
    top, stack = 0, []

    input = input.source if input.is_a?(Regexp)
    data  = input.unpack("c*") if input.is_a?(String)
    eof   = data.length

    @tokens = []
    @block  = block_given? ? block : nil

    in_group, group_depth = false, 0
    in_set,   set_depth   = false, 0

    %% write init;
    %% write exec;

    raise "Premature end of pattern (missing group closing paranthesis) "+
      "[#{in_group}:#{group_depth}]" if in_group
    raise "Premature end of pattern (missing set closing bracket) "+
      "[#{in_set}:#{set_depth}]" if in_set

    # when the entire expression is a literal run
    self.emit_literal if @literal

    @tokens
  end

  # appends one or more characters to the literal buffer, to be emitted later
  # by a call to emit_literal. contents a mix of ASCII and UTF-8
  def self.append_literal(data, ts, te)
    @literal ||= []
    @literal << [data[ts..te-1].pack('c*'), ts, te]
  end

  # emits the collected literal run collected by one or more calls to the
  # append_literal method
  def self.emit_literal
    ts, te = @literal.first[1], @literal.last[2]
    text = @literal.map {|t| t[0]}.join

    text.force_encoding('utf-8') if text.respond_to?(:force_encoding)

    self.emit(:literal, :literal, text, ts, te)
    @literal = nil
  end

  def self.emit(type, token, text, ts, te)
    #puts " > emit: #{type}:#{token} '#{text}' [#{ts}..#{te}]"

    if @literal and type != :literal
      self.emit_literal
    end

    if @block
      @block.call type, token, text, ts, te
    end

    @tokens << [type, token, text, ts, te]
  end

end # module Regexp::Scanner

%%{
  machine re_scanner;
  include re_property "property.rl";

  dot                   = '.';
  backslash             = '\\';
  alternation           = '|';
  beginning_of_line     = '^';
  end_of_line           = '$';

  range_open            = '{';
  range_close           = '}';
  curlies               = range_open | range_close;

  group_open            = '(';
  group_close           = ')';
  parantheses           = group_open | group_close;

  set_open              = '[';
  set_close             = ']';
  brackets              = set_open | set_close;

  class_name_posix      = 'alnum' | 'alpha' | 'blank' |
                          'cntrl' | 'digit' | 'graph' |
                          'lower' | 'print' | 'punct' |
                          'space' | 'upper' | 'xdigit' |
                          'word'  | 'ascii';

  class_posix           = '[:' . class_name_posix . ':]';

  char_type             = [dDhHsSwW];

  line_anchor           = beginning_of_line | end_of_line;
  anchor_char           = [AbBzZG];

  escaped_ascii         = [abefnrstv];
  octal_sequence        = [0-7]{1,3};

  hex_sequence          = 'x' . xdigit{1,2};
  wide_hex_sequence     = 'x' . '{' . xdigit{1,8} . '}';

  codepoint_single      = 'u' . xdigit{4};
  codepoint_list        = 'u{' . (xdigit{4} . space?)+'}';
  codepoint_sequence    = codepoint_single | codepoint_list;

  control_sequence      = ('c' | 'C-') . alpha;
  meta_sequence         = 'M-' . ((backslash . control_sequence) | alpha);

  zero_or_one           = '?' | '??' | '?+';
  zero_or_more          = '*' | '*?' | '*+';
  one_or_more           = '+' | '+?' | '++';

  quantifier_greedy     = '?'  | '*'  | '+';
  quantifier_reluctant  = '??' | '*?' | '+?';
  quantifier_possessive = '?+' | '*+' | '++';
  quantifier_mode       = '?'  | '+';

  quantifier_range      = range_open . (digit+)? . ','? . (digit+)? .
                          range_close . quantifier_mode?;

  quantifier_range_bre  = backslash . range_open . (digit+)? . ','? . (digit+)? .
                          backslash . range_close;

  quantifiers           = quantifier_greedy | quantifier_reluctant |
                          quantifier_possessive | quantifier_range;

  group_comment         = '?#' . [^)]+ . group_close;

  group_atomic          = '?>';
  group_passive         = '?:';

  assertion_lookahead   = '?=';
  assertion_nlookahead  = '?!';
  assertion_lookbehind  = '?<=';
  assertion_nlookbehind = '?<!';

  group_options         = '?' . ([mix]{1,3})? . '-'? . ([mix]{1,3})?;

  group_ref             = [gk];
  group_name            = alpha . (alnum+)?;
  group_named           = ('?<' . group_name . '>') | ("?'" . group_name . "'");
  group_name_ref        = group_ref . (('<' . group_name . '>') | ("'" . group_name . "'"));

  group_number          = '-'? . [1-9] . ([0-9]+)?;
  group_number_ref      = group_ref . (('<' . group_number . '>') | ("'" . group_number . "'"));

  group_type            = group_atomic | group_passive | group_named;

  assertion_type        = assertion_lookahead  | assertion_nlookahead |
                          assertion_lookbehind | assertion_nlookbehind;

  # characters that 'break' a literal
  meta_char             = dot | backslash | alternation |
                          curlies | parantheses | brackets |
                          line_anchor | quantifier_greedy;

  ascii_print           = ((0x20..0x7e) - meta_char)+;
  ascii_nonprint        = (0x01..0x1f | 0x7f)+;

  utf8_2_byte           = (0xc2..0xdf 0x80..0xbf)+;
  utf8_3_byte           = (0xe0..0xef 0x80..0xbf 0x80..0xbf)+;
  utf8_4_byte           = (0xf0..0xf4 0x80..0xbf 0x80..0xbf 0x80..0xbf)+;
  utf8_byte_sequence    = utf8_2_byte | utf8_3_byte | utf8_4_byte;

  non_literal_escape    = char_type | anchor_char | escaped_ascii |
                          group_ref | [xucCM];

  # EOF error, used where it can be detected
  action premature_end_error { raise "Premature end of pattern" }

  # group (nesting) and set open/close actions
  action group_opened { group_depth += 1; in_group = true }
  action group_closed { group_depth -= 1; in_group = group_depth > 0 ? true : false }

  action set_opened { set_depth += 1; in_set = true }
  action set_closed { set_depth -= 1; in_set = set_depth > 0 ? true : false }

  # Character set scanner, continues consuming characters until it meets the
  # closing bracket of the set.
  # --------------------------------------------------------------------------
  character_set := |*
    ']' %set_closed {
      self.emit(:set, :close, data[ts..te-1].pack('c*'), ts, te)
      fret;
    };

    '-]' %set_closed { # special case, emits two tokens
      self.emit(:set, :member, data[ts..te-2].pack('c*'), ts, te)
      self.emit(:set, :close,  data[ts+1..te-1].pack('c*'), ts, te)
      fret;
    };

    '^' {
      text = data[ts..te-1].pack('c*')
      if @tokens.last[1] == :open
        self.emit(:set, :negate, text, ts, te)
      else
        self.emit(:set, :member, text, ts, te)
      end
    };

    alnum . '-' . alnum { # TODO: add properties
      self.emit(:set, :range, data[ts..te-1].pack('c*'), ts, te)
    };

    '&&' {
      self.emit(:set, :intersection, data[ts..te-1].pack('c*'), ts, te)
    };

    '\\' {
      fcall set_escape_sequence;
    };

    class_posix @err(premature_end_error) {
      case text = data[ts..te-1].pack('c*')
      when '[:alnum:]';  self.emit(:set, :class_alnum,  text, ts, te)
      when '[:alpha:]';  self.emit(:set, :class_alpha,  text, ts, te)
      when '[:ascii:]';  self.emit(:set, :class_ascii,  text, ts, te)
      when '[:blank:]';  self.emit(:set, :class_blank,  text, ts, te)
      when '[:cntrl:]';  self.emit(:set, :class_cntrl,  text, ts, te)
      when '[:digit:]';  self.emit(:set, :class_digit,  text, ts, te)
      when '[:graph:]';  self.emit(:set, :class_graph,  text, ts, te)
      when '[:lower:]';  self.emit(:set, :class_lower,  text, ts, te)
      when '[:print:]';  self.emit(:set, :class_print,  text, ts, te)
      when '[:punct:]';  self.emit(:set, :class_punct,  text, ts, te)
      when '[:space:]';  self.emit(:set, :class_space,  text, ts, te)
      when '[:upper:]';  self.emit(:set, :class_upper,  text, ts, te)
      when '[:word:]';   self.emit(:set, :class_word,   text, ts, te)
      when '[:xdigit:]'; self.emit(:set, :class_xdigit, text, ts, te)
      else raise "Unsupported character posixe class at #{text} (char #{ts})"
      end
    };

    meta_char {
      # this is an ugly workaround. need to review/re-structure the
      # unicode properties machine, which causes this to misbehave.
      if in_set
        self.emit(:set, :member, data[ts..te-1].pack('c*'), ts, te)
      else
        fhold; fgoto main;
      end
    };

    any            |
    ascii_nonprint |
    utf8_2_byte    |
    utf8_3_byte    |
    utf8_4_byte    {
      self.emit(:set, :member, data[ts..te-1].pack('c*'), ts, te)
    };
  *|;

  # set escapes scanner
  # --------------------------------------------------------------------------
  set_escape_sequence := |*
    'b' {
      self.emit(:set, :backspace, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    char_type {
      case text = data[ts-1..te-1].pack('c*')
      when '\d'; self.emit(:set, :type_digit,     text, ts-1, te)
      when '\D'; self.emit(:set, :type_nondigit,  text, ts-1, te)
      when '\h'; self.emit(:set, :type_hex,       text, ts-1, te)
      when '\H'; self.emit(:set, :type_nonhex,    text, ts-1, te)
      when '\s'; self.emit(:set, :type_space,     text, ts-1, te)
      when '\S'; self.emit(:set, :type_nonspace,  text, ts-1, te)
      when '\w'; self.emit(:set, :type_word,      text, ts-1, te)
      when '\W'; self.emit(:set, :type_nonword,   text, ts-1, te)
      end
      fret;
    };

    hex_sequence . '-\\' . hex_sequence {
      self.emit(:set, :range_hex, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    hex_sequence {
      self.emit(:set, :member_hex, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    meta_char | [\\\]\-\,] {
      self.emit(:set, :escape, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    property_char > (escaped_set_alpha, 2) {
      fhold;
      fnext character_set;
      fcall unicode_property;
      fret;
    };

    # special case exclusion of escaped dash, could be cleaner.
    (ascii_print - char_type -- [\-}]) > (escaped_set_alpha, 1) |
    ascii_nonprint            |
    utf8_2_byte               |
    utf8_3_byte               |
    utf8_4_byte               {
      self.emit(:set, :escape, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };
  *|;

  # escape sequence scanner
  # --------------------------------------------------------------------------
  escape_sequence := |*
    [1-9] {
      text = data[ts-1..te-1].pack('c*')
      self.emit(:backref, :digit, text, ts-1, te)
      fret;
    };

    octal_sequence {
      self.emit(:escape, :octal, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    meta_char {
      case text = data[ts-1..te-1].pack('c*')
      when '\.';  self.emit(:escape, :dot,               text, ts-1, te)
      when '\|';  self.emit(:escape, :alternation,       text, ts-1, te)
      when '\^';  self.emit(:escape, :beginning_of_line, text, ts-1, te)
      when '\$';  self.emit(:escape, :end_of_line,       text, ts-1, te)
      when '\?';  self.emit(:escape, :zero_or_one,       text, ts-1, te)
      when '\*';  self.emit(:escape, :zero_or_more,      text, ts-1, te)
      when '\+';  self.emit(:escape, :one_or_more,       text, ts-1, te)
      when '\(';  self.emit(:escape, :group_open,        text, ts-1, te)
      when '\)';  self.emit(:escape, :group_close,       text, ts-1, te)
      when '\{';  self.emit(:escape, :interval_open,     text, ts-1, te)
      when '\}';  self.emit(:escape, :interval_close,    text, ts-1, te)
      when '\[';  self.emit(:escape, :set_open,          text, ts-1, te)
      when '\]';  self.emit(:escape, :set_close,         text, ts-1, te)
      when "\\\\";
        self.emit(:escape, :backslash, text, ts-1, te)
      end
      fret;
    };

    escaped_ascii > (escaped_alpha, 7) {
      # \b is emitted as backspace only when inside a character set, otherwise
      # it is a word boundary anchor. A syntax might "normalize" it if needed.
      case text = data[ts-1..te-1].pack('c*')
      when '\a'; self.emit(:escape, :bell,           text, ts-1, te)
      when '\e'; self.emit(:escape, :escape,         text, ts-1, te)
      when '\f'; self.emit(:escape, :form_feed,      text, ts-1, te)
      when '\n'; self.emit(:escape, :newline,        text, ts-1, te)
      when '\r'; self.emit(:escape, :carriage,       text, ts-1, te)
      when '\s'; self.emit(:escape, :space,          text, ts-1, te)
      when '\t'; self.emit(:escape, :tab,            text, ts-1, te)
      when '\v'; self.emit(:escape, :vertical_tab,   text, ts-1, te)
      end
      fret;
    };

    codepoint_sequence > (escaped_alpha, 6) {
      text = data[ts-1..te-1].pack('c*')
      if text[2].chr == '{'
        self.emit(:escape, :codepoint_list, text, ts-1, te)
      else
        self.emit(:escape, :codepoint,      text, ts-1, te)
      end
      fret;
    };

    hex_sequence > (escaped_alpha, 5) {
      self.emit(:escape, :hex, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    wide_hex_sequence > (escaped_alpha, 5) {
      self.emit(:escape, :hex_wide, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    control_sequence > (escaped_alpha, 4) {
      self.emit(:escape, :control, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };

    meta_sequence > (backslashed, 3) {
      self.emit(:escape, :meta_sequence, data[ts-1..te-1].pack('c*'), ts-1, te)
    };

    property_char > (escaped_alpha, 2) {
      fhold; fcall unicode_property; fret;
    };

    (any -- non_literal_escape) > (escaped_alpha, 1)  {
      self.emit(:escape, :literal, data[ts-1..te-1].pack('c*'), ts-1, te)
      fret;
    };
  *|;

  # Main scanner
  # --------------------------------------------------------------------------
  main := |*

    # Meta characters
    # ------------------------------------------------------------------------
    dot {
      self.emit(:meta, :dot, data[ts..te-1].pack('c*'), ts, te)
    };

    alternation {
      self.emit(:meta, :alternation, data[ts..te-1].pack('c*'), ts, te)
    };

    # Anchors
    # ------------------------------------------------------------------------
    beginning_of_line {
      self.emit(:anchor, :beginning_of_line, data[ts..te-1].pack('c*'), ts, te)
    };

    end_of_line {
      self.emit(:anchor, :end_of_line, data[ts..te-1].pack('c*'), ts, te)
    };

    backslash . anchor_char > (backslashed, 3) {
      case text = data[ts..te-1].pack('c*')
      when '\\A'; self.emit(:anchor, :bos,                text, ts, te)
      when '\\z'; self.emit(:anchor, :eos,                text, ts, te)
      when '\\Z'; self.emit(:anchor, :eos_ob_eol,         text, ts, te)
      when '\\b'; self.emit(:anchor, :word_boundary,      text, ts, te)
      when '\\B'; self.emit(:anchor, :nonword_boundary,   text, ts, te)
      else raise "Unsupported anchor at #{text} (char #{ts})"
      end
    };

    # Character types
    #   \d, \D    digit, non-digit
    #   \h, \H    hex, non-hex
    #   \s, \S    space, non-space
    #   \w, \W    word, non-word
    # ------------------------------------------------------------------------
    backslash . char_type > (backslashed, 2) {
      case text = data[ts..te-1].pack('c*')
      when '\\d'; self.emit(:type, :digit,      text, ts, te)
      when '\\D'; self.emit(:type, :nondigit,   text, ts, te)
      when '\\h'; self.emit(:type, :hex,        text, ts, te)
      when '\\H'; self.emit(:type, :nonhex,     text, ts, te)
      when '\\s'; self.emit(:type, :space,      text, ts, te)
      when '\\S'; self.emit(:type, :nonspace,   text, ts, te)
      when '\\w'; self.emit(:type, :word,       text, ts, te)
      when '\\W'; self.emit(:type, :nonword,    text, ts, te)
      end
    };

    # Character sets
    # ------------------------------------------------------------------------
    set_open %set_opened  {
      self.emit(:set, :open, data[ts..te-1].pack('c*'), ts, te)
      fcall character_set;
    };

    # (?#...) comments: parsed as a single expression, without introducing a
    # new nesting level. Comments may not include parentheses, escaped or not.
    # special case for close, action performed on all transitions to get the
    # correct closing count.
    # ------------------------------------------------------------------------
    group_open . group_comment $group_closed {
      self.emit(:group, :comment, data[ts..te-1].pack('c*'), ts, te)
    };

    # Expression options:
    #   (?imx-imx)          option on/off
    #                         i: ignore case
    #                         m: multi-line (dot(.) match newline)
    #                         x: extended form
    #
    #   (?imx-imx:subexp)   option on/off for subexp
    # ------------------------------------------------------------------------
    group_open . group_options >group_opened {
      # special handling to resolve ambiguity with passive groups
      if data[te]
        c = data[te].chr
        if c == ':' # include the ':'
          self.emit(:group, :options, data[ts..te].pack('c*'), ts, te+1)
          p += 1
        elsif c == ')' # just options by themselves
          self.emit(:group, :options, data[ts..te-1].pack('c*'), ts, te)
        else
          raise "Unexpected '#{c}' in options sequene, expected ':' or ')'"
        end
      else
        raise "Premature end of pattern" unless data[te]
      end
    };

    # Assertions
    #   (?=subexp)          look-ahead
    #   (?!subexp)          negative look-ahead
    #   (?<=subexp)         look-behind
    #   (?<!subexp)         negative look-behind
    # ------------------------------------------------------------------------
    group_open . assertion_type >group_opened {
      case text =  data[ts..te-1].pack('c*')
      when '(?=';  self.emit(:assertion, :lookahead,    text, ts, te)
      when '(?!';  self.emit(:assertion, :nlookahead,   text, ts, te)
      when '(?<='; self.emit(:assertion, :lookbehind,   text, ts, te)
      when '(?<!'; self.emit(:assertion, :nlookbehind,  text, ts, te)
      end
    };

    # Groups
    #   (?:subexp)          passive (non-captured) group
    #   (?>subexp)          atomic group, don't backtrack in subexp.
    #   (?<name>subexp)     named group
    #   (?'name'subexp)     named group (single quoted version)
    #   (subexp)            captured group
    # ------------------------------------------------------------------------
    group_open . group_type >group_opened {
      case text =  data[ts..te-1].pack('c*')
      when '(?:';  self.emit(:group, :passive,      text, ts, te)
      when '(?>';  self.emit(:group, :atomic,       text, ts, te)

      when /\(\?<\w+>/
        self.emit(:group, :named,     text, ts, te)
      when /\(\?'\w+'/
        self.emit(:group, :named_sq,  text, ts, te)
      end
    };

    group_open @group_opened {
      text =  data[ts..te-1].pack('c*')
      self.emit(:group, :capture, text, ts, te)
    };

    group_close @group_closed {
      self.emit(:group, :close, data[ts..te-1].pack('c*'), ts, te)
    };

    # Group back-reference, named and numbered
    # ------------------------------------------------------------------------
    backslash . (group_name_ref | group_number_ref) > (backslashed, 4) {
      case text = data[ts..te-1].pack('c*')
      when /\\([gk])<[^\d-](\w+)?>/ # angle-brackets
        if $1 == 'k'
          self.emit(:backref, :name_ref_ab,  text, ts, te)
        else
          self.emit(:backref, :name_call_ab,  text, ts, te)
        end

      when /\\([gk])'[^\d-](\w+)?'/ #single quotes
        if $1 == 'k'
          self.emit(:backref, :name_ref_sq,  text, ts, te)
        else
          self.emit(:backref, :name_call_sq,  text, ts, te)
        end

      when /\\([gk])<\d+>/ # angle-brackets
        if $1 == 'k'
          self.emit(:backref, :number_ref_ab,  text, ts, te)
        else
          self.emit(:backref, :number_call_ab,  text, ts, te)
        end

      when /\\([gk])'\d+'/ # single quotes
        if $1 == 'k'
          self.emit(:backref, :number_ref_sq,  text, ts, te)
        else
          self.emit(:backref, :number_call_sq,  text, ts, te)
        end

      when /\\([gk])<-\d+>/ # angle-brackets
        if $1 == 'k'
          self.emit(:backref, :number_rel_ref_ab,  text, ts, te)
        else
          self.emit(:backref, :number_rel_call_ab,  text, ts, te)
        end

      when /\\([gk])'-\d+'/ # single quotes
        if $1 == 'k'
          self.emit(:backref, :number_rel_ref_sq,  text, ts, te)
        else
          self.emit(:backref, :number_rel_call_sq,  text, ts, te)
        end
      end
    };

    # Quantifiers
    # ------------------------------------------------------------------------
    zero_or_one {
      case text =  data[ts..te-1].pack('c*')
      when '?' ;  self.emit(:quantifier, :zero_or_one,            text, ts, te)
      when '??';  self.emit(:quantifier, :zero_or_one_reluctant,  text, ts, te)
      when '?+';  self.emit(:quantifier, :zero_or_one_possessive, text, ts, te)
      end
    };

    zero_or_more {
      case text =  data[ts..te-1].pack('c*')
      when '*' ;  self.emit(:quantifier, :zero_or_more,            text, ts, te)
      when '*?';  self.emit(:quantifier, :zero_or_more_reluctant,  text, ts, te)
      when '*+';  self.emit(:quantifier, :zero_or_more_possessive, text, ts, te)
      end
    };

    one_or_more {
      case text =  data[ts..te-1].pack('c*')
      when '+' ;  self.emit(:quantifier, :one_or_more,            text, ts, te)
      when '+?';  self.emit(:quantifier, :one_or_more_reluctant,  text, ts, te)
      when '++';  self.emit(:quantifier, :one_or_more_possessive, text, ts, te)
      end
    };

    quantifier_range  @err(premature_end_error) {
      self.emit(:quantifier, :interval, data[ts..te-1].pack('c*'), ts, te)
    };

    # BRE version
    quantifier_range_bre  @err(premature_end_error) {
      self.emit(:quantifier, :interval_bre, data[ts..te-1].pack('c*'), ts, te)
    };

    # Escaped sequences
    # ------------------------------------------------------------------------
    backslash > (backslashed, 1) {
      fcall escape_sequence;
    };

    # Literal: any run of ASCII (pritable or non-printable), and/or UTF-8,
    # except meta characters.
    # ------------------------------------------------------------------------
    ascii_print+    |
    ascii_nonprint+ |
    utf8_2_byte+    |
    utf8_3_byte+    |
    utf8_4_byte+    {
      self.append_literal(data, ts, te)
    };

  *|;
}%%

module Regexp::Scanner
  %% write data;

  # Scans the given regular expression text, or Regexp object and collects the
  # emitted token into an array that gets returned at the end. If a block is
  # given, it gets called for each emitted token.
  #
  # This method may raise errors if a syntax error is encountered.
  # --------------------------------------------------------------------------
  def self.scan(input, &block)
    top, stack = 0, []

    input = input.source if input.is_a?(Regexp)
    data  = input.unpack("c*") if input.is_a?(String)
    eof   = data.length

    @tokens = []
    @block  = block_given? ? block : nil

    in_group, group_depth = false, 0
    in_set,   set_depth   = false, 0

    %% write init;
    %% write exec;

    raise "Premature end of pattern (missing group closing paranthesis) "+
      "[#{in_group}:#{group_depth}]" if in_group
    raise "Premature end of pattern (missing set closing bracket) "+
      "[#{in_set}:#{set_depth}]" if in_set

    # when the entire expression is a literal run
    self.emit_literal if @literal

    @tokens
  end

  # appends one or more characters to the literal buffer, to be emitted later
  # by a call to emit_literal. contents a mix of ASCII and UTF-8
  def self.append_literal(data, ts, te)
    @literal ||= []
    @literal << [data[ts..te-1].pack('c*'), ts, te]
  end

  # emits the collected literal run collected by one or more calls to the
  # append_literal method
  def self.emit_literal
    ts, te = @literal.first[1], @literal.last[2]
    text = @literal.map {|t| t[0]}.join

    text.force_encoding('utf-8') if text.respond_to?(:force_encoding)

    self.emit(:literal, :literal, text, ts, te)
    @literal = nil
  end

  def self.emit(type, token, text, ts, te)
    #puts " > emit: #{type}:#{token} '#{text}' [#{ts}..#{te}]"

    if @literal and type != :literal
      self.emit_literal
    end

    if @block
      @block.call type, token, text, ts, te
    end

    @tokens << [type, token, text, ts, te]
  end

end # module Regexp::Scanner


Don't save the PGTIOU until the proper end tag for a PGTIOU has been seen.

%%{
  machine parser;

  # Leaf tags
  # ---------

  code    = ( ( upper | '_' ) @buffer )+ %saveFailureCode;
  reason  = ( xmlContent @buffer )+ %saveFailureReason;
  pgtIou  = "<cas:proxyGrantingTicket>"
            ( ticketCharacter @buffer ){,256}
            "</cas:proxyGrantingTicket>" %savePgtIou;
  user    = "<cas:user>" ( xmlContent @buffer )+ %saveUsername "</cas:user>";

  # Non-leaf tags
  # -------------

  serviceResponseStart         = "<cas:serviceResponse xmlns:cas="
                                 quote
                                 "http://www.yale.edu/tp/cas"
                                 quote
                                 ">";
  serviceResponseEnd           = "</cas:serviceResponse>";

  authenticationFailureStart   = "<cas:authenticationFailure code="
                                 quote
                                 code
                                 quote
                                 ">";
  authenticationFailureEnd     = "</cas:authenticationFailure>";

  authenticationSuccessStart   = "<cas:authenticationSuccess>";
  authenticationSuccessEnd     = "</cas:authenticationSuccess>";

  # Top-level elements
  # ------------------

  ok_cas_st     = ( serviceResponseStart
                    space*
                    authenticationSuccessStart
                    space*
                    user
                    space*
                    pgtIou?
                    space*
                    authenticationSuccessEnd
                    space*
                    serviceResponseEnd ) @setAuthenticated;

  failed_cas_st = ( serviceResponseStart
                    space*
                    authenticationFailureStart
                    reason
                    authenticationFailureEnd
                    space*
                    serviceResponseEnd );

  cas_st        = ok_cas_st | failed_cas_st;
}%%

%%{
  machine parser;

  # Leaf tags
  # ---------

  code    = ( ( upper | '_' ) @buffer )+ %saveFailureCode;
  reason  = ( xmlContent @buffer )+ %saveFailureReason;
  pgtIou  = "<cas:proxyGrantingTicket>"
            ( ticketCharacter @buffer ){,256} %savePgtIou
            "</cas:proxyGrantingTicket>";
  user    = "<cas:user>" ( xmlContent @buffer )+ %saveUsername "</cas:user>";

  # Non-leaf tags
  # -------------

  serviceResponseStart         = "<cas:serviceResponse xmlns:cas="
                                 quote
                                 "http://www.yale.edu/tp/cas"
                                 quote
                                 ">";
  serviceResponseEnd           = "</cas:serviceResponse>";

  authenticationFailureStart   = "<cas:authenticationFailure code="
                                 quote
                                 code
                                 quote
                                 ">";
  authenticationFailureEnd     = "</cas:authenticationFailure>";

  authenticationSuccessStart   = "<cas:authenticationSuccess>";
  authenticationSuccessEnd     = "</cas:authenticationSuccess>";

  # Top-level elements
  # ------------------

  ok_cas_st     = ( serviceResponseStart
                    space*
                    authenticationSuccessStart
                    space*
                    user
                    space*
                    pgtIou?
                    space*
                    authenticationSuccessEnd
                    space*
                    serviceResponseEnd ) @setAuthenticated;

  failed_cas_st = ( serviceResponseStart
                    space*
                    authenticationFailureStart
                    reason
                    authenticationFailureEnd
                    space*
                    serviceResponseEnd );

  cas_st        = ok_cas_st | failed_cas_st;
}%%