flatteneed test directory

1 files changed, 362 insertions, 0 deletions

diff --git a/test/trans.d/trans-ocaml.lm b/test/trans.d/trans-ocaml.lm
new file mode 100644
index 00000000..39bffb74
--- /dev/null
+++ b/test/trans.d/trans-ocaml.lm
@@ -0,0 +1,362 @@
+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 '1'
+	}
+	case ['false'] {
+		send Out '0'
+	}
+	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 "int"
+	}
+	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 )
+{
+	if match VarDecl.opt_arr [] {
+		send Out
+			"let [$VarDecl.tk_ident] = ref 0
+	}
+	else {
+		send Out
+			"let [$VarDecl.tk_ident] = Array.make 32 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 E1: expr `, E2: expr `;]
+	{
+		send Out
+			"for i = 0 to [rw_ocaml_expr(E2)] - 1 do print_char (Char.chr [E1].(i)) done; "
+	}
+	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
+			"	String.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 = String.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
+
+	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.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
+		"  ()
+		";;
+		"
+}