Added interface files for all modules, moved command-line arguments to globals.ml, made types.ml an .mli file

Makefile

@@ -1,12 +1,16 @@
 RESULT := civicc
+GLOBALS := types globals stringify util
 PHASES := load parse print desug context typecheck dimreduce boolop extern \
 	constprop index assemble peephole output
-SOURCES := types.ml stringify.mli stringify.ml util.mli util.ml lexer.mll \
-	parser.mly $(patsubst %,phases/%.ml,$(PHASES)) main.ml
-PRE_TARGETS := types.cmi types.o stringify.cmi stringify.o util.cmi util.o
+SOURCES := $(addsuffix .mli,$(GLOBALS)) $(addsuffix .ml,$(GLOBALS)) \
+	lexer.mll parser.mly \
+	$(patsubst %,phases/%.mli,$(PHASES)) $(patsubst %,phases/%.ml,$(PHASES)) \
+	main.ml
+PRE_TARGETS := types.ml $(addsuffix .cmi,$(GLOBALS))
 LIBS := str unix
 
 OCAMLFLAGS := -g
+OCAMLDOCFLAGS :=
 
 OCAMLYACC := menhir
 YFLAGS := --infer --explain
@@ -24,6 +28,10 @@ all: native-code
 
 clean:: myclean
 
+# The Types module needs an implementation to stop ocamlc from complaining
+types.ml: types.mli
+	cp $< $@
+
 myclean:
 	rm -f a.out $(DIST_TGT)
 
@@ -33,6 +41,6 @@ check: all
 dist: $(DIST_TGT)
 
 $(DIST_TGT): $(DIST_FILES)
-	tar -czvf $@ $^
+	tar -czvf $@ $^ --exclude=types.ml
 
 include OCamlMakefile

README.md

@@ -4,6 +4,15 @@ CiviCaml
 CiviCaml is a compiler for the CiviC language, written in OCaml.
 
 
+Documentation
+-------------
+`make doc` generates HTML documentation, which is accessible through
+doc/civicc.index.html.
+
+The coding style we adhere to
+[http://wiki.xen.org/wiki/OCaml_Best_Practices_for_Developers#Use_of_open].
+
+
 Issues & TODO
 -------------
 

main.ml

@@ -2,6 +2,7 @@ open Printf
 open Lexing
 open Types
 open Util
+open Globals
 
 let always _ = true
 let when_optimize _ = args.optimize

phases/assemble.ml

@@ -2,6 +2,7 @@ open Printf
 open Types
 open Util
 open Stringify
+open Globals
 
 let comline comment = InlineComment (EmptyLine, comment)
 

phases/boolop.ml

@@ -18,6 +18,7 @@
  *)
 open Types
 open Util
+open Globals
 
 let cast ctype node = TypeCast (ctype, node, [Type ctype])
 

phases/constprop.ml

@@ -17,6 +17,7 @@
  *)
 open Types
 open Util
+open Globals
 
 let is_const_name name =
     Str.string_match (Str.regexp "^.+\\$\\$[0-9]+$") name 0

phases/context.ml

@@ -1,6 +1,7 @@
 open Printf
 open Types
 open Util
+open Globals
 
 type nametype = Varname of string | Funcname of string
 

phases/desug.ml

@@ -1,6 +1,7 @@
 open Printf
 open Types
 open Util
+open Globals
 
 (* Create new constant variables for all assigned array values so that they are
  * only evaluated once *)

phases/dimreduce.ml

@@ -1,5 +1,6 @@
 open Types
 open Util
+open Globals
 
 let rec expand_dims = function
     (* Flatten Block nodes returned by transformations below *)

phases/extern.ml

@@ -1,5 +1,6 @@
 open Types
 open Util
+open Globals
 
 let create_param ctype name =
     let param = Param (ctype, name, [Depth 1]) in

phases/index.ml

@@ -1,5 +1,6 @@
 open Types
 open Util
+open Globals
 
 let tag_index program =
     let nglobs = ref 0 in

phases/load.ml

@@ -1,62 +1,62 @@
 open Types
 open Util
+open Globals
 
 (* Unix command to call for C preprocessor:
- * -nostdinc        : don't include from C stdlib
- * -C               : don't remove comments
+ * -nostdinc    : don't include from C stdlib
+ * -C         : don't remove comments
  * -traditional-cpp : don't remove excessive whitespaces, so that error
- *                    messages preserve correct character locations *)
+ *          messages preserve correct character locations *)
 let cpp_cmd = "cpp -nostdinc -C -traditional-cpp"
 
 let input_all ic =
-    let n = in_channel_length ic in
-    let buf = String.create n in
-    really_input ic buf 0 n;
-    close_in ic;
-    buf
+  let n = in_channel_length ic in
+  let buf = String.create n in
+  really_input ic buf 0 n;
+  close_in ic;
+  buf
 
 let input_buffered ic chunksize =
-    let rec read_all buf bufsize pos =
-        match input ic buf pos (bufsize - pos) with
-        | 0 -> (close_in ic; buf)
-        | nread when nread = bufsize - pos ->
-            let bufsize = bufsize + chunksize in
-            let pos = pos + nread in
-            read_all (buf ^ String.create chunksize) bufsize pos
-        | nread ->
-            read_all buf bufsize (pos + nread)
-    in
-    read_all (String.create chunksize) chunksize 0
+  let rec read_all buf bufsize pos =
+    match input ic buf pos (bufsize - pos) with
+    | 0 -> (close_in ic; buf)
+    | nread when nread = bufsize - pos ->
+      let bufsize = bufsize + chunksize in
+      let pos = pos + nread in
+      read_all (buf ^ String.create chunksize) bufsize pos
+    | nread ->
+      read_all buf bufsize (pos + nread)
+  in
+  read_all (String.create chunksize) chunksize 0
 
 let phase = function
-    | Empty ->
-        let display_name = match args.infile with
-            | Some filename -> filename
-            | None -> "<stdin>"
-        in
-        let bufsize = 512 in
-
-        if args.cpp then
-            let cpp_out = match args.infile with
-                | Some filename ->
-                    Unix.open_process_in (cpp_cmd ^ " " ^ filename)
-                | None ->
-                    let content = input_buffered stdin bufsize in
-                    let (cpp_out, cpp_in) = Unix.open_process cpp_cmd in
-                    output_string cpp_in content;
-                    close_out cpp_in;
-                    cpp_out
-            in
+  | Empty ->
+    let display_name = match args.infile with
+    | Some filename -> filename
+    | None -> "<stdin>"
+    in
+    let bufsize = 512 in
 
-            let _ = log_line 2 "Run C preprocessor" in
+    if args.cpp then
+      let cpp_out = match args.infile with
+      | Some filename ->
+        Unix.open_process_in (cpp_cmd ^ " " ^ filename)
+      | None ->
+        let content = input_buffered stdin bufsize in
+        let (cpp_out, cpp_in) = Unix.open_process cpp_cmd in
+        output_string cpp_in content;
+        close_out cpp_in;
+        cpp_out
+      in
+      log_line 2 "Run C preprocessor";
 
-            (* Read preprocessed code from cpp's stdout *)
-            let preprocessed = input_buffered cpp_out bufsize in
-            FileContent (display_name, preprocessed)
-        else
-            let content = match args.infile with
-                | Some filename -> input_all (open_in filename)
-                | None -> input_buffered stdin bufsize
-            in
-            FileContent (display_name, content)
-    | _ -> raise (InvalidInput "load")
+      (* Read preprocessed code from cpp's stdout *)
+      let preprocessed = input_buffered cpp_out bufsize in
+      FileContent (display_name, preprocessed)
+    else
+      let content = match args.infile with
+      | Some filename -> input_all (open_in filename)
+      | None -> input_buffered stdin bufsize
+      in
+      FileContent (display_name, content)
+  | _ -> raise (InvalidInput "load")

phases/output.ml

@@ -1,5 +1,6 @@
 open Types
 open Util
+open Globals
 
 let phase = function
     | Assembly instrs ->

phases/parse.ml

@@ -1,6 +1,7 @@
 open Lexing
 open Types
 open Util
+open Globals
 
 let get_loc lexbuf =
     Util.loc_from_lexpos lexbuf.lex_curr_p lexbuf.lex_curr_p

phases/peephole.ml

@@ -1,6 +1,7 @@
 open Printf
 open Types
 open Util
+open Globals
 
 let rec strip_comments = function
     | Comment _ :: tl -> strip_comments tl

phases/print.ml

@@ -1,5 +1,6 @@
 open Types
 open Util
+open Globals
 open Stringify
 
 let tab = "    "

phases/typecheck.ml

@@ -17,6 +17,7 @@
 open Printf
 open Types
 open Util
+open Globals
 open Stringify
 
 let array_depth = function

stringify.ml

@@ -1,4 +1,5 @@
 open Types
+open Globals
 
 let tab = "    "
 

stringify.mli

@@ -1,9 +1,16 @@
+(** Stringification functions for AST elements. *)
+
+(**  *)
 val const2str : Types.const -> string
 
+(**  *)
 val op2str    : Types.operator -> string
 
+(**  *)
 val node2str  : Types.node -> string
 
+(**  *)
 val type2str  : Types.ctype -> string
 
+(**  *)
 val types2str : Types.ctype list -> string

types.ml

@@ -1,25 +1,39 @@
+(** Type definitions for abstract syntax tree, assembly code, and exceptions. *)
+
+(**  *)
 type location = string * int * int * int * int
-let noloc = ("", 0, 0, 0, 0)
 
+(**  *)
 type operator =
     | Neg | Not
     | Add | Sub | Mul | Div | Mod
     | Eq | Ne | Lt | Le | Gt | Ge
     | And | Or
+
+(**  *)
 type const =
     | BoolVal of bool
     | IntVal of int
     | FloatVal of float
+
+(**  *)
 type ctype =
     | Void | Bool | Int | Float | Array of ctype
     | ArrayDims of ctype * node list
+
+(**  *)
 and annotation =
     | Loc of location
     | Depth of int
     | Index of int
     | Type of ctype
     | LabelName of string
+
+(** Shorthand for annotation list, only to be used by {! Types.node} definitions
+    below. *)
 and ann = annotation list
+
+(**  *)
 and node =
     (* Global *)
     | Program of node list * ann
@@ -127,17 +141,14 @@ type instr =
     | EmptyLine
     | DummyInstr
 
-let immediate_consts = [
-    BoolVal true;
-    BoolVal false;
-    IntVal (-1);
-    IntVal 0;
-    IntVal 1;
-    FloatVal 0.0;
-    FloatVal 1.0;
-]
-
-(* Container for command-line arguments *)
+(* Intermediate representations between phases *)
+type intermediate =
+    | Empty
+    | FileContent of string * string
+    | Ast of node
+    | Assembly of instr list
+
+(** Container for command-line arguments. *)
 type args_record = {
     mutable infile   : string option;
     mutable outfile  : string option;
@@ -147,25 +158,6 @@ type args_record = {
     mutable endphase : string;
 }
 
-(* Commandline args are stored in a global record
- * (yes, it is a bit dirty, but I don't know how to do this without passing
- * [args] to every function) *)
-let args = {
-    infile   = None;
-    outfile  = None;
-    verbose  = 1;
-    cpp      = true;
-    optimize = true;
-    endphase = "";
-}
-
-(* Intermediate representations between phases *)
-type intermediate =
-    | Empty
-    | FileContent of string * string
-    | Ast of node
-    | Assembly of instr list
-
 (* Exceptions *)
 exception LocError of location * string
 exception NodeError of node * string

util.ml

@@ -2,6 +2,10 @@ open Printf
 open Str
 open Lexing
 open Types
+open Globals
+
+(** Empty location, use when node location is unkown or irrelevant. *)
+let noloc = ("", 0, 0, 0, 0)
 
 let rec repeat s n = if n < 1 then "" else s ^ (repeat s (n - 1))
 let expand n text = text ^ repeat " " (n - String.length text)
@@ -426,6 +430,17 @@ let mapi f lst =
         | hd :: tl -> f i hd :: (trav (i + 1) tl)
     in trav 0 lst
 
+(** Constants that are *)
+let immediate_consts = [
+    BoolVal true;
+    BoolVal false;
+    IntVal (-1);
+    IntVal 0;
+    IntVal 1;
+    FloatVal 0.0;
+    FloatVal 1.0;
+]
+
 let is_immediate_const const =
     if args.optimize then List.mem const immediate_consts else false
 

util.mli

@@ -1,67 +1,106 @@
+(** Utility functions used by multiple phases. *)
+(**
+Extended description...
+*)
+
+(**  *)
 val repeat : string -> int -> string
+
+(**  *)
 val expand : int -> string -> string
 
-(* Logging functions, they print to stderr and consider the verbosity flag *)
-val hline    : string
+(** Logging functions, they print to stderr and consider the verbosity flag *)
+val hline : string
+
+(**  *)
 val prt_line : string -> unit
+
+(**  *)
 val prt_node : Types.node -> unit
+
+(**  *)
 val log_line : int -> string -> unit
+
+(**  *)
 val log_plain_line : int -> string -> unit
+
+(**  *)
 val log_node : int -> Types.node -> unit
 
-(* Generate a fresh variable from a given prefix, e.g. "foo" -> "foo$1"  *)
+(** Generate a fresh variable from a given prefix, e.g. "foo" -> "foo$1"  *)
 val fresh_var : string -> string
 
-(* Generate a fresg constant from a given prefix, e.g. "foo" -> "foo$$1"  *)
+(** Generate a fresg constant from a given prefix, e.g. "foo" -> "foo$$1"  *)
 val fresh_const : string -> string
 
-(* Generate an Types.location tuple from Lexing data structures *)
+(** Generate an Types.location tuple from Lexing data structures *)
 val loc_from_lexpos : Lexing.position -> Lexing.position -> Types.location
 
-(* Default transformation traversal for AST nodes *)
+(** Default transformation traversal for AST nodes *)
 val transform_children : (Types.node -> Types.node) -> Types.node -> Types.node
 
-(* Add a single annotation to a node (no traversal) *)
+(** Add a single annotation to a node (no traversal) *)
 val annotate : Types.annotation -> Types.node -> Types.node
 
-(*val visit_children : (Types.node -> unit) -> Types.node -> unit*)
+(** Extract annotation from node *)
+val annof : Types.node -> Types.annotation list
 
-(* Extract annotation from node *)
-val annof   : Types.node -> Types.annotation list
-val locof   : Types.node -> Types.location
+(**  *)
+val locof : Types.node -> Types.location
+
+(**  *)
 val depthof : Types.node -> int
+
+(**  *)
 val indexof : Types.node -> int
-val typeof  : Types.node -> Types.ctype
+
+(**  *)
+val typeof : Types.node -> Types.ctype
+
+(**  *)
 val labelof : Types.node -> string
 
+(**  *)
 val const_type : Types.const -> Types.ctype
 
-(* Print file location to stderr *)
+(** Print file location to stderr *)
 val prerr_loc : Types.location -> unit
 
-(* Print file location to stderr *)
+(** Print file location to stderr *)
 val prerr_loc_msg : Types.location -> string -> unit
 
-(* Flatten Block nodes into the given array of nodes *)
+(** Flatten Block nodes into the given array of nodes *)
 val flatten_blocks : Types.node list -> Types.node list
 
-(* Extract the node list from a Block node *)
+(** Extract the node list from a Block node *)
 val block_body : Types.node -> Types.node list
 
-(* Get the basic type of a declaration, removing array dimensions *)
+(** Get the basic type of a declaration, removing array dimensions *)
 val basetypeof : Types.node -> Types.ctype
 
-(* Get name from variable or function declaration *)
+(** Get name from variable or function declaration *)
 val nameof : Types.node -> string
 
+(**  *)
 val optmap : ('a -> 'b) -> 'a list option -> 'b list option
+
+(**  *)
 val optmapl : ('a -> 'b) -> 'a list option -> 'b list
 
-(* List.mapi clone (only available in OCaml version >= 4.00 *)
+(** List.mapi clone (only available in OCaml version >= 4.00 *)
 val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
 
+(**  *)
 val is_immediate_const : Types.const -> bool
 
+(**  *)
 val is_array : Types.node -> bool
 
+(**  *)
 val node_warning : Types.node -> string -> unit
+
+(**  *)
+val noloc : Types.location
+
+(**  *)
+val immediate_consts : Types.const list