#ifndef WYRM_DFA_H
#define WYRM_DFA_H

	//	wyrm-dfa.dna - Copyright (C) 2004 SM Ryan.  All rights reserved.

	#include "wyrmwif.h"
	#include "wyrm-io.h"
	
	<DFA defines>
	<Character finite transducer defines>
	<Channel reader transducer defines>
	<String source transducer declares>

	int Wyrmdfa_Init(Intr intr);
	int Wyrmdfa_SafeInit(Intr intr);

#endif

		

static const char COPYRIGHT[] =
		"wyrm-dfa.dna - Copyright (C) 2004 SM Ryan.  All rights reserved.";

#include "wyrm-dfa.h"

<String source transducer implementation>
<Package>

		

#ifndef DEBUG_DFA
	#undef dstate
	#define dstate(x)
	#undef dtransition
	#define dtransition(x)
#endif
#ifndef dstate
	#define dstate(x) puts("state: " x);
#endif
#ifndef dtransition
	#define dtransition(x) puts("  on: " x);
#endif

#define dfa(initial,Symbol,getsymbol,cookie) \
	{ \
		int v_final; Symbol symbol; \
		Symbol (*v_getsymbol)(ClientData) = (Symbol (*)(ClientData))(getsymbol); \
		ClientData v_cookie = (cookie); \
		goto s_##initial; \
		for (;;) {
	#define state(name) \
			s_##name: symbol = v_getsymbol(v_cookie); e_##name: dstate(#name)
		#define is(value) \
				if (symbol==value) {dtransition("is " #value)
		#define in(ll,ul) \
				if (ll<=symbol && symbol<=ul) {dtransition("in " #ll ".." #ul)
		#define any \
				{dtransition("any")
		#define move(state) \
				goto s_##state;}
		#define emove(state) \
				goto e_##state;}
		#define final(value) \
				v_final = (value); break;}
	#define etats \
				v_final = -1; break;
#define afd(var) \
		} \
		var = v_final; \
	}

		

#define transducer(initial,getsymbol,cookie) \
	{ \
		Tcl_DString v_string; char v_r[1]; Tcl_DStringInit(&v_string); \
		dfa(initial,int,getsymbol,cookie)
	#define shift(state) \
			*v_r = symbol; Tcl_DStringAppend(&v_string,v_r,1); move(state)
	#define append(string) \
			Tcl_DStringAppend(&v_string,string,-1)
#define endtransducer(var,stringvar) \
		afd(var) \
		(stringvar) = Tcl_Alloc(Tcl_DStringLength(&v_string)+1); \
		strcpy(stringvar,Tcl_DStringValue(&v_string)); \
		Tcl_DStringFree(&v_string); \
	}

		

#define channeldfa(initial,channel) transducer(initial,cgetc,channel)

		

#define stringdfa(initial,object) \
	{ \
		WyrmDfaString v_strobj; v_strobj.o = incr(object); \
		v_strobj.s = Tcl_GetStringFromObj(v_strobj.o,&v_strobj.n); \
		transducer(initial,wyrm_dfaString,&v_strobj)
#define endstring(var,stringvar) \
		endtransducer(var,stringvar) \
		decr(v_strobj.o); \
	}

typedef struct {int n; chars s; Obj o;} WyrmDfaString;
int wyrm_dfaString(ClientData data);

		

int wyrm_dfaString(ClientData data) {
	WyrmDfaString *st = data;
	if (st->s && st->n>0) {
		int ch = 0xFF & st->s[0]; st->s += 1; st->n -= 1; return ch;
	}else {
		return EOF;
	}
}

		

#ifdef TESTING
	#include <ctype.h>
	
	static int Ndfa; static Obj *Pdfa;
	static int Qdfa(ClientData clientData) {
		if (Ndfa<=0) {
			return -1;
		}
		int x = -1;
		Tcl_GetIntFromObj(0,*Pdfa,&x);
		Pdfa++; Ndfa--;
		return x;
	}

	static int qdfacommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
		int machine;
		if (Tcl_GetIntFromObj(intr,P[1],&machine)!=TCL_OK) return TCL_ERROR;
		switch (machine) {
			case 1: {
				int fs; Ndfa = N-2; Pdfa = P+2;
				dfa(even,int,Qdfa,0)
					state(even)
						is(0) move(even)
						is(1) move(odd)
						is(2) emove(two)
						is(-1) final(2)
					etats
					state(odd)
						is(0) move(odd)
						is(1) move(even)
						is(-1) final(1)
					etats
					state(two)
						is(0) move(two)
						in(1,4) emove(three)
						is(5) final(3)
					etats
					state(three)
						is(1) move(two)
						is(2) move(four)
						any move(two)
					etats
					state(four)
						is(3) emove(two)
					etats
				afd(fs)
				Tcl_SetObjResult(intr,Tcl_NewIntObj(fs));
			}	return TCL_OK;
			case 2: {
				int fs; chars st; Obj E[2]; Ndfa = N-2; Pdfa = P+2;
				transducer(start,Qdfa,0)
					state(start)
						is(65) shift(trailer)
						is(32) move(start)
					etats
					state(trailer)
						is(65) shift(trailer)
						is(97) symbol -= 32; shift(trailer)
						is(48) shift(trailer)
						is(1) append("/"); move(trailer)
						is(32) move(trailer)
						is(0) final(0)
					etats
				endtransducer(fs,st)
				E[0] = Tcl_NewIntObj(fs);
				E[1] = Tcl_NewStringObj(st,-1);
				Tcl_SetObjResult(intr,Tcl_NewListObj(2,E));
				dispose(st);
			}	return TCL_OK;
			case 3: {
				int mood; Tcl_Channel channel = Tcl_GetChannel(intr,Tcl_GetString(P[2]),&mood);
				int fs; chars st; Obj E[2];
				channeldfa(prefix,channel)
					state(prefix)
						is('+') append(" PRE"); shift(prefix)
						is('-') append(" PRE"); shift(prefix)
						any emove(primary)
					etats
					state(primary)
						in('a','z') append(" "); shift(infix)
						in('A','Z') append(" "); shift(infix)
						in('0','9') append(" "); shift(number)
					etats
					state(number)
						in('0','9') shift(number)
						any emove(infix)
					etats
					state(infix)
						is('+') append(" IN"); shift(prefix)
						is('-') append(" IN"); shift(prefix)
						is('*') append(" IN"); shift(prefix)
						is('/') append(" IN"); shift(prefix)
						is('.') append(" END"); final(1)
						is(EOF) append(" END"); final(0)
					etats
				endtransducer(fs,st)
				E[0] = Tcl_NewIntObj(fs);
				E[1] = Tcl_NewStringObj(st,-1);
				Tcl_SetObjResult(intr,Tcl_NewListObj(2,E));
				dispose(st);
			}	return TCL_OK;
			case 4: {
				int fs; chars st; Obj E[2]; int ec;
				stringdfa(init,P[2])
					state(init)
						is('+') ec = 1; shift(tao)
						is('-') ec = 1; shift(tao)
						is('/') ec = 2; shift(tao)
						is('*') ec = 2; shift(tao)
						is(':') ec = 2; shift(tao)
						is('=') ec = 2; shift(tao)
						in('a','z') shift(tag)
						in('A','Z') symbol = tolower(symbol); shift(tag)
						is('_') shift(tag)
						in('0','9') shift(integer)
						is('\"') move(string)
						is(' ') move(init)
						is('#') move(comment)
					etats
					state(tao)
						is('/') shift(tao)
						is('*') shift(tao)
						is(':') shift(tao)
						is('=') shift(tao)
						any final(ec)
					etats
					state(tag)
						in('a','z') shift(tag)
						in('A','Z') symbol = tolower(symbol); shift(tag)
						is('_') shift(tag)
						in('0','9') shift(tag)
						any final(3)
					etats
					state(integer)
						is('_') move(integer)
						in('0','9') shift(integer)
						any final(4)
					etats
					state(string)
						is('\"') move(quote)
						is(EOF) final(5)
						any shift(string)
					etats
					state(quote)
						is('\"')shift(string)
						any final(5)
					etats
					state(comment)
						is('#') move(init)
						is(EOF) final(6)
						any move(comment)
					etats
				endstring(fs,st)
				E[0] = Tcl_NewIntObj(fs);
				E[1] = Tcl_NewStringObj(st,-1);
				Tcl_SetObjResult(intr,Tcl_NewListObj(2,E));
				dispose(st);
			}	return TCL_OK;
		}
		Tcl_Panic("you can't get here from there");
	}
#endif

int Wyrmdfa_Init(Intr intr) {
	Tcl_PkgRequire(intr,"wyrmwif","1",0);
	Tcl_PkgProvide(intr,"wyrmdfa",VERSION);
	#ifdef TESTING
		Tcl_CreateObjCommand(intr,"::wyrm::qdfa",qdfacommand,0,0);
		return Tcl_VarEval(intr,"namespace eval ::wyrm {namespace export qdfa}",0);
	#else
		return TCL_OK;
	#endif
}

int Wyrmdfa_SafeInit(Intr intr) {
	return Wyrmdfa_Init(intr);
}