diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e278cf5 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +lexer.ml +parser.cmi +parser.ml + +*.cmo +*.mli diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..0870c84 --- /dev/null +++ b/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 diff --git a/Tests/rectangles.c b/Tests/rectangles.c new file mode 100644 index 0000000..31bde0a --- /dev/null +++ b/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.); +} + diff --git a/comp.ml b/comp.ml new file mode 100644 index 0000000..38d98cc --- /dev/null +++ b/comp.ml @@ -0,0 +1,11 @@ +(* Main function and target of compilation in Makefile *) + +let main () = + let help_message = "Run with:\n comp \n" in + if (Array.length (Sys.argv)) != 3 + then print_string help_message + else Interf.run_test Sys.argv.(1) Sys.argv.(2) +;; + +main();; + diff --git a/gen.ml b/gen.ml new file mode 100644 index 0000000..70741b8 --- /dev/null +++ b/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 [] + + diff --git a/instrs.ml b/instrs.ml new file mode 100644 index 0000000..42b681f --- /dev/null +++ b/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 = "" diff --git a/interf.ml b/interf.ml new file mode 100644 index 0000000..f69ee26 --- /dev/null +++ b/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") + + + diff --git a/lang.ml b/lang.ml new file mode 100644 index 0000000..c3791aa --- /dev/null +++ b/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) + diff --git a/typing.ml b/typing.ml new file mode 100644 index 0000000..2b1c8aa --- /dev/null +++ b/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 diff --git a/use.ml b/use.ml new file mode 100644 index 0000000..d673b5c --- /dev/null +++ b/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";; +*) + +