flashコンパイラ

ocaml

また性懲りもなく、美しい日本のMLコンパイラのソースを眺めてしまった。
で、ようやく、慣れてきたらしいので、四則演算の結果をswfで出力するだけの
何の役にも立たないコンパイラが出来上がりました。


ようやく、意味解析とか、そこら辺の領域にやってきたぞと、いった感じです。


syntax.ml

type t =
  | Int of int
  | Add of t * t
  | Sub of t * t
  | Mul of t * t
  | Div of t * t

parser.ml

%{
open Syntax
%}

%token <int> INT
%token MINUS
%token PLUS
%token AST
%token SLASH
%token EOF
%token LPAREN
%token RPAREN

%left PLUS MINUS
%left AST SLASH

%type <Syntax.t> exp
%start exp

%%
exp:
| LPAREN exp RPAREN { $2 }
| INT               { Int($1) }
| exp PLUS  exp { Add($1, $3) }
| exp MINUS exp { Sub($1, $3) }
| exp AST   exp { Mul($1, $3) }
| exp SLASH exp { Div($1, $3) }

lexer.mll

{
open Parser
}

let space = [' ' '\t' '\n' '\r']
let digit = ['0'-'9']

rule token = parse
| space+ { token lexbuf }
| '-'? digit+ { INT(int_of_string (Lexing.lexeme lexbuf)) }
| '(' { LPAREN }
| ')' { RPAREN }
| '-' { MINUS }
| '+' { PLUS }
| "*" { AST }
| "/" { SLASH }
| eof { EOF }
| _
    { failwith
	(Printf.sprintf "unknown token %s near characters %d-%d"
	   (Lexing.lexeme lexbuf)
	   (Lexing.lexeme_start lexbuf)
	   (Lexing.lexeme_end lexbuf)) }

test.ml

open Syntax
open Parser
open Lexer

open Swf
open SwfParser
open SwfZip

let read_all filename =
  let f = open_in filename in      (* ファイルオープン *)
  let len = in_channel_length f in (* ファイルの長さを取得 *)
  let buf = String.create len in   (* バッファの文字列を作成 *)
  really_input f buf 0 len;        (* バッファにデータをすべて読み込む *)
  close_in f;                      (* ファイルをクローズ *)
  buf                              (* 取得した文字列を返す *)

let argv = Sys.argv;;

let endprg () =
    print_string "usage: o src.txt out.swf\n";
    exit(0);;

if (Array.length(argv) < 2) then endprg ()
  else ();;
let out = argv.(2);;

let prg = read_all argv.(1);;


(* タグ生成 *)
let tag ?(ext=false) d = {
	tid = 0;
	textended = ext;
	tdata = d;
	}

(* 領域データ生成 *)
let bounds x y w h = {
		rect_nbits = if (max w h) >= 820 then 16 else 15;
		left = x;
		top = y;
		right = w * 20;
		bottom = h * 20;
	}

let w = 640
let h = 480
let fps = 40.0
let bgcolor = ref 0xffffff


let header = {
		h_version = 8;
		h_size = bounds 0 0 w h;
		h_frame_count = 1;
		h_fps = to_float16 fps;
		h_compressed = false;
	}
;;

let ass : Swf.action DynArray.t = DynArray.create();;
let a1 = (Parser.exp Lexer.token (Lexing.from_string prg));;

let rec calc = function
| Int(i) -> DynArray.add ass (APush [PInt (Int32.of_int i)])
| Add(i,j) -> calc(i); calc(j); DynArray.add ass AAdd;
| Sub(i,j) -> calc(i); calc(j); DynArray.add ass ASubtract;
| Mul(i,j) -> calc(i); calc(j); DynArray.add ass AMultiply;
| Div(i,j) -> calc(i); calc(j); DynArray.add ass ADivide;;

DynArray.add ass (AStringPool ["tf"; "createTextField"; "text"; prg ^ " = "]);;

DynArray.add ass (APush [
	(PInt (Int32.of_int 480));
	(PInt (Int32.of_int 640));
	(PInt (Int32.of_int 0));
	(PInt (Int32.of_int 0));
	(PInt (Int32.of_int 0));
	(PStack 0); (* tf *)
	(PInt (Int32.of_int 6));
	(PStack 1); (* createTextField *)
	]);;
DynArray.add ass (ACall);;
DynArray.add ass (APop);;

DynArray.add ass (APush [
	(PStack 0); (* tf *)
	]);;
DynArray.add ass (AEval);;
DynArray.add ass (APush [
	(PStack 2); (* text *)
	(PStack 3); (* prg *)
	]);;
calc a1;;
DynArray.add ass (AStringAdd);;
DynArray.add ass (AObjSet);;

let data = [
	tag (TSetBgColor { cr = 0xFF; cg =  0xFF; cb =  0xFF });
	tag (TDoAction ass);
	tag (TShowFrame)];;

SwfParser.init SwfZip.inflate SwfZip.deflate;;
Swf.warnings := true;;
let ch = IO.output_channel (open_out_bin out);;
Swf.write ch (header, data);;
IO.close_out ch;;
print_string out;;

ビルドはこんなかんじ

ocamlyacc parser.mly
del parser.mli
ocamllex lexer.mll
ocamlopt -o test.exe -I .. -I ../extc -I ../swflib ../extLib.cmxa ../extc/extc.cmxa ../swflib/swflib.cmxa syntax.ml parser.ml lexer.ml test.ml
del *.cm* *.o

mtascとかコンパイルできればコンパイルできると思います。

test test.txt test.swf
とかやりますと、
test.txt

((1+2)*3+4*2)/2

なんてあると、

((1+2)*3+4*2)/2 = 8.5

と出るだけです。