1. Yoshihiro Imai
  2. primitive language

Commits

yoshihiro503  committed 262b377

gencode.ml

  • Participants
  • Parent commits 03a3070
  • Branches default

Comments (0)

Files changed (4)

File compile.sh

View file
-ocamlc -o prim util.ml syntax.ml lexer.ml parser.ml main.ml
+ocamlc -o prim util.ml syntax.ml lexer.ml parser.ml gencode.ml main.ml
 rm -f *.cm[io]

File gencode.ml

View file
+(*type rel_op = [`Neq | `Lt | `Le | `Eq | `Gt | `Ge ]
+type 'expr relation =
+  | RNq of 'expr * 'expr
+  | REq of 'expr * 'expr
+type 'expr statement =
+| SAssign of ident * 'expr
+| SIf of (rel_op * 'expr * 'expr) * 'expr statement list * 'expr statement list
+| SWhile of (rel_op * 'expr * 'expr) * 'expr statement list
+| SCall of ident * literal *)
+open Util
+open Syntax
+
+let gen_decls out decls =
+  let gen_data ty v_name = match ty with
+  | INT ->    out @@ "\t" ^ v_name ^ "\tdd 0"
+  | STRING -> out @@ "\t" ^ v_name ^ "\tdb 255 dup(0)"
+  in
+  out ".data";
+  List.iter (fun (v_names, ty) -> List.iter (gen_data ty) v_names) decls
+    
+let gen_codes out statements =
+  let gen_state = function
+    | SAssign (v_name, expr) ->
+	out "\tpop eax";
+	out @@ "\tmov " ^ v_name ^ " eax"
+(*| SIf of (rel_op * 'expr * 'expr) * )'expr statement list * 'expr statement list*)
+(*| SWhile of (rel_op * 'expr * 'expr) * 'expr statement list*)
+    | SCall (f_name, arg) ->
+	begin match f_name, arg with
+	| "ReadInt", Ident v ->
+	    out @@ "\tinvoke InputInteger, NEAR32 PTR " ^ v
+	| "WriteInt", Ident v ->
+	    out @@ "\tinvoke OutputInteger, " ^ v
+	| "WriteInt", Number s ->
+	    out @@ "\tinvoke OutputInteger, " ^ s
+	| "WriteStr", Ident v ->
+	    out @@ "\tinvoke OutputString, NEAR32 PTR " ^ v
+	| "WriteStr", String s ->
+	    out @@ "\tinvoke OutputString, NEAR32 PTR " ^ s
+	| _ -> failwith @@ "gen_codes: call " ^ f_name end
+    | _ -> ()
+  in
+  out ".code";
+  out "";
+  out "_start:";
+  List.iter gen_state statements;
+  out "\tinvoke PauseProgram";
+  out "\tinvoke ExitProcess,0";
+  out "end _start"
+
+
+let gen (Pg (module_name, decls, statements)) =
+  let out = print_endline in
+  out "; ml out.asm /c /coff";
+  out "; link /Subsystem:console out.obj kernel32.lib iolib.lib";
+  out ".586";
+  out ".model flat,stdcall";
+  out "INCLUDE iolib.inc";
+  out "";
+  gen_decls out decls;
+  out "";
+  gen_codes out statements;
+  out "";
+  out "END"
+
+
+
+
+
+
+  

File main.ml

View file
 open Parser
-
 let main =
   try
     let file = Sys.argv.(1) in
-    Parser.parse_file file
+    let ast = Parser.parse_file file in
+    Gencode.gen ast
   with err -> prerr_endline (Printexc.to_string err)

File parser.ml

View file
 let parse_file filename =
   let ts = Lexer.token filename in
   match parse_module ts with
-  | Inl (m, []) -> print_endline "parse success"
-  | Inl (m, l) -> print_endline ("rest: " ^ slist stoken l)
-  | Inr msg -> print_endline ("parse err: " ^ msg)
+  | Inl (m, []) -> m
+  | Inl (m, l) -> prerr_endline ("rest: " ^ slist stoken l); m
+  | Inr msg -> failwith ("parse err: " ^ msg)