Add .gitignore

.gitignore

@@ -0,0 +1,6 @@
+lexer.ml
+parser.cmi
+parser.ml
+
+*.cmo
+*.mli

Makefile

@@ -0,0 +1,54 @@
+all: comp
+
+# Compilation of Ocaml files
+# Attention: order of object files important 
+comp: lang.cmo parser.cmo lexer.cmo typing.cmo\
+      instrs.cmo gen.cmo interf.cmo comp.cmo
+	ocamlc -o comp $^
+
+# Compilation of .ml files
+lang.cmo: lang.ml
+	ocamlc -c $<
+
+typing.cmo: typing.ml lang.cmo
+	ocamlc -c $<
+
+instrs.cmo:  instrs.ml lang.cmo
+	ocamlc -c $<
+
+gen.cmo: gen.ml lang.cmo instrs.cmo typing.cmo
+	ocamlc -c $<
+
+interf.cmo: interf.ml lexer.cmo parser.cmo gen.cmo typing.cmo
+	ocamlc -c $<
+
+comp.cmo: comp.ml gen.cmo typing.cmo parser.cmo interf.cmo
+	ocamlc -c $<
+
+
+# ocaml lexer and parser
+
+# Comment in for your own lexer
+# lexer.ml: lexer.mll lang.cmo
+# 	ocamllex $<
+
+# Comment in for your own parser
+# parser.ml parser.mli: parser.mly lang.cmo
+# 	ocamlyacc $<
+
+lexer.cmo: lexer.ml parser.cmo
+	ocamlc -c $<
+parser.cmo: parser.ml parser.cmi lang.cmo
+	ocamlc -c $<
+
+
+#### Generic rules
+
+%.cmi: %.mli
+	ocamlc -c $<
+
+
+.PHONY: clean
+
+clean: 
+	rm -f lexer.ml parser.ml *.mli *.cmi *.cmo

Tests/rectangles.c

@@ -0,0 +1,44 @@
+/* Declaration of native Postscript procedures / functions */
+
+void newpath ();
+void moveto(float x, float y);
+void rlineto(float x, float y);
+void closepath();
+void stroke ();
+
+/* Function definition */
+
+void rectangle(float x, float y, float a, float b) {
+  newpath();
+  moveto(x, y);
+  rlineto(a, 0.);
+  rlineto(0., b);
+  rlineto(0. -. a, 0.);
+  rlineto(0., 0. -. b);
+  closepath();
+  stroke();
+}
+
+void square(float x, float y, float a) {
+  rectangle(x, y, a, a);
+}
+
+void fig1a(int d, float x, float y, float a) {
+  if (d != 0) {
+    square(x, y, a);
+    fig1a(d - 1, x, y, a /. 2.);
+  }
+}
+
+void fig1b(int d, float x, float y, float a) {
+  if (d != 0) {
+    square(x, y, a);
+    fig1b(d - 1, x +. a, y +. a, a /. 2.);
+  }
+}
+
+void main () {
+  fig1a(5, 200., 450., 100.);
+  fig1b(5, 100., 200., 100.);
+}
+

comp.ml

@@ -0,0 +1,11 @@
+(* Main function and target of compilation in Makefile *)
+
+let main () =
+  let help_message = "Run with:\n comp <input_filename> <output_filename>\n" in  
+  if (Array.length (Sys.argv)) != 3
+  then print_string help_message
+  else Interf.run_test Sys.argv.(1) Sys.argv.(2)
+;;
+
+main();;
+

gen.ml

@@ -0,0 +1,15 @@
+(* Compilation functions *)
+
+open Lang
+open Instrs
+open Typing
+
+(* ************************************************************ *)
+(* **** Compilation of expressions / statements            **** *)
+(* ************************************************************ *)
+
+  
+let gen_prog (Prog (fundecls, fundefns)) =
+  ISeq []
+    
+  

instrs.ml

@@ -0,0 +1,15 @@
+(* Datatypes for Postscript instructions *)
+
+
+open Lang
+
+type instr =
+  IVal of value
+| IVar of int
+| IOper of string
+| IBloc of instr
+| ISeq of instr list
+| ILoop of instr
+| IDef of fname * instr
+
+let string_of_instr instr = ""

interf.ml

@@ -0,0 +1,50 @@
+(* Interface with parser *)
+
+exception ParseLexError of exn * (string * int * int * string * string)
+
+let parse_file infile = 
+  let lexbuf = Lexing.from_channel (open_in infile) in
+  try 
+    Parser.start Lexer.token lexbuf
+  with exn ->
+    begin
+      let curr = lexbuf.Lexing.lex_curr_p in
+      let line = curr.Lexing.pos_lnum in
+      let cnum = curr.Lexing.pos_cnum - curr.Lexing.pos_bol in
+      let tok = Lexing.lexeme lexbuf in
+      let tail = Lexer.ruleTail "" lexbuf in
+      raise (ParseLexError (exn,(infile, line,cnum,tok,tail)))
+    end
+;;
+
+let print_parse_error (filename, line,cnum,tok,tail) =
+  print_string ("Parsing error in file: " ^ filename ^ 
+                      " on line: " ^ (string_of_int line) ^ 
+                      " column: " ^ (string_of_int cnum) ^
+                      " token: "  ^ tok ^
+                      "\nrest: "  ^ tail ^ "\n")
+;;
+
+let parse infile = 
+  try parse_file infile
+  with ParseLexError (e, r) -> 
+    print_parse_error r;
+    failwith "Stopped execution."
+;;
+
+let run_test infile outfile =
+  let inprog = parse infile in
+  if Typing.tp_prog inprog
+  then
+    (let genprog = Gen.gen_prog inprog in
+     let outf = open_out outfile in
+     let instrs = Instrs.string_of_instr genprog in
+     output_string outf instrs;
+     close_out outf;
+     print_string ("generated " ^ outfile ^ "\n")
+    )
+  else
+     print_string ("compilation aborted because of typing error")
+
+
+    

lang.ml

@@ -0,0 +1,64 @@
+(* Definition of source language data structures *)
+
+(* variable names *)
+type vname = string
+
+(* function names *)
+type fname = string
+
+(* binary arithmetic operators *)
+type barith = BAadd | BAsub | BAmul | BAdiv | BAmod (* integer *)
+            | BAfadd | BAfsub | BAfmul | BAfdiv (* float *)
+
+(* binary boolean operators: and, or *)
+type bbool = BBand | BBor
+
+(* binary comparison operators: =, >=, >, <=, <, != *)
+type bcompar = BCeq | BCge | BCgt | BCle | BClt | BCne
+
+(* binary operators, combining all of the above *)
+type binop =
+  BArith of barith
+| BBool of bbool
+| BCompar of bcompar
+    
+type value =
+  BoolV of bool
+| FloatV of float
+| IntV of int
+| LitV of string
+| StringV of string
+
+(* Expresssions *)
+type expr = 
+    Const of value                        (* constant *)
+  | VarE of vname                         (* variable *)
+  | BinOp of binop * expr *  expr         (* binary operation *)
+  | CondE of expr * expr * expr           (* conditional expr *)
+  | CallE of fname * (expr list)          (* call expression *)
+
+(* Commands *)
+type com =
+    Skip                                  (* no operation *)
+  | Exit                                  (* exit from loop *)
+  | Assign of vname * expr                (* assign expression to var *)
+  | Seq of com * com                      (* sequence of statements *)
+  | CondC of expr * com * com             (* conditional com *)
+  | Loop of com                           (* loop until exit *)
+  | CallC of fname * (expr list)          (* call statement *)
+  | Return of expr                        (* return from call *)
+
+(* Types *)
+type tp = BoolT | FloatT | IntT | LitT | StringT | VoidT
+
+(* variable / parameter declaration *)
+type vardecl = Vardecl of tp * vname
+
+(* function declaration: return type; parameter declarations *)
+type fundecl = Fundecl of tp * fname * (vardecl list)
+
+(* function definition: function declaration; function body *)
+type fundefn = Fundefn of fundecl * com
+
+type prog = Prog of (fundecl list) * (fundefn list) 
+    

typing.ml

@@ -0,0 +1,13 @@
+(* Typechecking of source programs *)
+
+open Lang
+
+(* Environments *)
+
+type environment = 
+    {localvars: (vname * tp) list; 
+     funbind: fundecl list   
+    }
+
+
+let tp_prog (Prog (fundecls, fundefns)) = true

use.ml

@@ -0,0 +1,25 @@
+
+#load "lang.cmo";;
+#load "parser.cmo" ;;
+#load "lexer.cmo" ;;
+#load "typing.cmo";;
+#load "instrs.cmo";;
+#load "gen.cmo";;
+#load "interf.cmo";;
+
+open Interf;;
+open Lang;;
+open Instrs;;
+
+(* For using the parser:
+
+- Evaluate this file (use.ml)
+- parse "Tests/rectangles.c" ;;
+
+* For code generation:
+
+- Evaluate this file (use.ml)
+- run_test "Tests/rectangles.c" "Tests/rectangles.ps";;
+*)
+
+