path: root/test/ragel.d/trans-ocaml.lm

int rw_ocaml_factor( Factor: indep::factor )
{
	switch Factor
	case [`first_token_char] {
		send Out
			"( Char.code data.\[ts.contents\] )"
	}
	case [tk_ident `[ expr `]] {
		send Out
			"[$Factor.tk_ident]\[ [rw_ocaml_expr(Factor.expr)] \]
	}
	case [ `fentry `( E: expr `)] {
		send Out
			"fentry( [E] )"
	}
	case [tk_ident `( expr `)] {
		send Out
			"[$Factor.tk_ident]( [rw_ocaml_expr(Factor.expr)] )
	}
	case [`< type `> `( expr `)] {
		send Out
			"( [rw_ocaml_expr(Factor.expr)] )
	}
	case [`( expr `)] {
		send Out
			"( [rw_ocaml_expr(Factor.expr)] )
	}
	case ['true'] {
		send Out 'true'
	}
	case ['false'] {
		send Out 'false'
	}
	case "'0'" {
		send Out
			"( Char.code '0' )"
	}
	case "'a'" {
		send Out
			"( Char.code 'a' )"
	}
	case [`fc] {
		send Out
			"fc"
	}
	case [tk_ident] {
		send Out
			"[Factor.tk_ident].contents"
	}
	case [`buffer]
	{
		send Out
			"String.sub buffer 0 blen.contents"
	}
	case [`blen]
	{
		send Out
			"blen.contents"
	}
	default {
		send Out
			[Factor]
	}
}

void rw_ocaml_type( Type: indep::type )
{
	if match Type [`int]
	{
		send Out "int"
	}
	elsif match Type [`bool]
	{
		send Out "bool"
	}
	elsif match Type [`char]
	{
		send Out "char"
	}
	elsif match Type [`ptr]
	{
		send Out "char *"
	}
	elsif match Type [`byte]
	{
		send Out "unsigned char"
	}
}

void rw_ocaml_abs_expr( Expr: indep::abs_expr )
{
	if ( Expr.Op ) {
		send Out
			"[rw_ocaml_abs_expr(Expr.E1)] [$Expr.Op] [rw_ocaml_abs_expr( Expr.E2 )]"
	}
	else {
		rw_ocaml_factor( Expr.factor )
	}
}

void rw_ocaml_expr( Expr: indep::expr )
{
	AbsExpr: indep::abs_expr = indep::abs_comparative( Expr.comparative )
	rw_ocaml_abs_expr( AbsExpr )
}

void rw_ocaml_opt_array( OptArr: indep::opt_arr )
{
	if OptArr.expr {
		send Out "\[[rw_ocaml_expr( OptArr.expr )]\]"
	}
}

int rw_ocaml_var_decl( VarDecl: indep::var_decl )
{
	OptArr: indep::opt_arr = VarDecl.opt_arr
	if OptArr.expr {
		send Out
			"let [$VarDecl.tk_ident] = Array.make 32 0
	}
	else if match VarDecl.type [`bool] {
		send Out 
			"let [VarDecl.tk_ident] = ref false
	}
	else {
		send Out
			"let [VarDecl.tk_ident] = ref 0
	}
}

void rw_ocaml_opt_sub( OptSub: indep::opt_sub )
{
	if ( OptSub.expr )
		send Out "\[[rw_ocaml_expr(OptSub.expr)]\]"
}

int rw_ocaml_expr_stmt( ExprStmt: indep::expr_stmt )
{
	if match ExprStmt [tk_ident opt_sub `= expr `;]
	{
		if match ExprStmt.opt_sub [] {
			send Out
				"[$ExprStmt.tk_ident rw_ocaml_opt_sub(ExprStmt.opt_sub)] := [rw_ocaml_expr(ExprStmt.expr)];
		}
		else {
			send Out
				"Array.set [$ExprStmt.tk_ident] [rw_ocaml_expr(ExprStmt.opt_sub.expr)] [rw_ocaml_expr(ExprStmt.expr)];

		}
	}
	else if match ExprStmt [expr `;]
	{
		send Out
			"[rw_ocaml_expr(ExprStmt.expr)];
	}
}

int rw_ocaml_if_stmt( IfStmt: indep::if_stmt )
{
	send Out
		"if [rw_ocaml_expr( IfStmt.expr )] then
		"begin
		"	[rw_ocaml_stmt_list( IfStmt._repeat_stmt )]
		"end 

	if ( IfStmt.opt_else._repeat_stmt ) {
		send Out
			"else
			"begin
			"	[rw_ocaml_stmt_list( IfStmt.opt_else._repeat_stmt )]
			"end
	}
	send Out
		";
}

int rw_ocaml_print_stmt( Stmt: indep::print_stmt )
{
	if match Stmt [`print_int expr `;] {
		send Out
			"print_int( [rw_ocaml_expr(Stmt.expr)] );
	}
	else if match Stmt [`print_buf `;]
	{
		send Out
			"print_string( String.sub buffer 0 blen.contents );
	}
	else if match Stmt [`print_str expr `;]
	{
		send Out
			"print_string( [rw_ocaml_expr( Stmt.expr )] );
	}
	else if match Stmt [`print_token `;]
	{
		send Out
			"for i = ts.contents to te.contents - 1 do print_char data.\[i\] done; "
	}
}

void rw_ocaml_buf_stmt( BufStmt: indep::buf_stmt )
{
	switch BufStmt
	case [`buf_clear `( `) `;] {
		send Out
			"begin
			"	blen := 0;
			"end
	}
	case [`buf_append `( `) `;] {
		send Out
			"	begin
			"	Bytes.set buffer blen.contents data.\[p.contents\];
			"	blen := blen.contents + 1;
			"	end
	}
}

int rw_ocaml_ragel_stmt( Stmt: indep::ragel_stmt )
{
	switch Stmt
	case [`fnext `* E: expr `;] {
		send Out
			"fnext *[rw_ocaml_expr(E)];
	}
	case [`fncall `* E: expr `;] {
		send Out
			"fncall *[rw_ocaml_expr(E)];
	}
	default {
		send Out
			[Stmt]
	}
}

int rw_ocaml_stmt( Stmt: indep::stmt )
{
	if match Stmt [var_decl]
		rw_ocaml_var_decl( Stmt.var_decl )
	else if match Stmt [expr_stmt]
		rw_ocaml_expr_stmt( Stmt.expr_stmt )
	else if match Stmt [if_stmt]
		rw_ocaml_if_stmt( Stmt.if_stmt )
	else if match Stmt [print_stmt]
		rw_ocaml_print_stmt( Stmt.print_stmt )
	else if match Stmt [buf_stmt]
		rw_ocaml_buf_stmt( Stmt.buf_stmt )
	else if	match Stmt [ragel_stmt]
		rw_ocaml_ragel_stmt( Stmt.ragel_stmt )
}

void rw_ocaml_stmt_list( StmtList: indep::stmt* )
{
	for Stmt: indep::stmt in repeat( StmtList )
		rw_ocaml_stmt( Stmt )
}

int rw_ocaml_action_block( ActionBlock: indep::action_block )
{
	Out = new parser<out_code::lines>()
	if match ActionBlock [`{ stmt* `}] {
		send Out
			"{[rw_ocaml_stmt_list( ActionBlock._repeat_stmt )]}
	}
	else if match ActionBlock [`{ expr `}] {
		send Out
			"{[rw_ocaml_expr( ActionBlock.expr )]}
	}
	send Out [] eos
}

void rw_ocaml( Output: stream )
{
	send Output
		"(*
		" * @LANG: ocaml
		" * @GENERATED: true

	if ProhibitGenflags {
		send Output
			" * @PROHIBIT_GENFLAGS:[ProhibitGenflags]
	}

	send Output
		" *)
		"

	Init: indep::stmt* = RagelTree.Init
	for Stmt: indep::stmt in Init {
		if match Stmt [Decl: var_decl] {
			Out = new parser<out_code::lines>()
			rw_ocaml_var_decl( Decl )
			send Out [] eos
			send Output [Out->tree]
		}
	}

	Section: indep::section = RagelTree.section
	for Action: ragel::action_block in Section {
		# Reparse as lang-independent code.
		parse IndepActionBlock: indep::action_block[$Action]
		if ( !IndepActionBlock ) {
			print( "error parsing indep action block: ", error, '\n', Action )
			exit(1)
		}

		rw_ocaml_action_block( IndepActionBlock )

		# Reparse back to ragel action block.
		Action = parse ragel::action_block[$Out->tree]
		if ( !Action ) {
			print( "error parsing ragel action block: ", error, '\n', $Out->tree )
			exit(1)
		}
	}

	send Output
		"
		"[Section]
		"
		"
		"%% write data;
		"
		"let exec data = 
		"  let buffer = Bytes.create(1024) in 
		"  let blen :int ref = ref 0 in
		"  let cs = ref 0 in
		"  let p = ref 0 in
		"  let pe = ref (String.length data) in
		"  let nfa_len = ref 0 in
		"  let nfa_count = ref 0 in
		"  let nfa_bp_state = Array.make 20 0 in
		"  let nfa_bp_p = Array.make 20 0 in

	if NeedsEof {
		send Output
			"	let eof = pe in
	}


	for Stmt: indep::stmt in Init {
		if match Stmt [ExprStmt: expr_stmt] {
			Out = new parser<out_code::lines>()
			rw_ocaml_expr_stmt( ExprStmt )
			send Out [] eos
			send Output [Out->tree]
		}
	}

	send Output
		"	%% write init;
		"	%% write exec;
		"	if !cs >= [MachineName.mn_word]_first_final then
		"		print_string \"ACCEPT\\n\"
		"	else
		"		print_string \"FAIL\\n\"
		";;
		"

	send Output
		"let () =

	for InputString: indep::input_string in RagelTree {
		send Output 
			"	exec [^InputString];
	}

	send Output
		"  ()
		";;
		"
}