Commits

orbitz committed dd795d4

Some formatting changes, slowly figuring out how to actually do this formatting

Comments (0)

Files changed (7)

 let rec print_warnings = function
   | [] -> ()
   | warning::xs -> begin
-    Printf.printf "Line: %d\nMsg: %s\n"
+    Printf.printf "%% Line: %d\nMsg: %s\n"
       warning.Formatter.line_number
       warning.Formatter.msg;
     print_warnings xs
   Token.pp_list code_lexed;
   match Formatter.format program_options stdout code_lexed with
     | Return.Success [] ->
-      Printf.printf "Success\n"
+      ()
     | Return.Success warnings -> begin
-      Printf.printf "%d warnings\n" (List.length warnings);
+      Printf.printf "%% %d warnings\n" (List.length warnings);
       print_warnings warnings
     end
     | Return.Failure error ->
-      Printf.printf "Failed\nLine: %d\nMsg: %s\n"
+      Printf.printf "%% Failed\nLine: %d\nMsg: %s\n"
 	error.Formatter.line_number
 	error.Formatter.msg
 

src/format_builder.ml

+type token =
+  | Token of Token.t
+  | Space of int
+
+type t = token list
+
+let initial_buffer_length = 80
+
+let create () = []
+
+let add_token line_builder token =
+  (Token token)::line_builder
+
+let add_tokens line_builder tokens =
+  let tokens = List.map (fun t -> Token t) tokens in
+  (List.rev tokens) ++ line_builder
+
+let add_space line_builder n =
+  (Space n)::line_builder
+
+let to_string line_builder string_of_token =
+  let buffer = Buffer.create initial_buffer_length in
+  List.iter
+    (function
+      | Token t -> Buffer.add_char buffer (string_of_token t)
+      | Space n -> Buffer.add_string buffer (String.make n ' '))
+    (List.rev line_builder)
+
+

src/format_builder.mli

+type t
+
+val create      : unit -> t
+val add_token   : t -> Token.t -> t
+val add_space   : t -> int -> t
+val line_length : t -> int
+val to_string   : t -> (Token.t -> string) -> string
 module R = Return
 
 type error = { line_number : int
-	     ; msg : string
+	     ; msg         : string
 	     }
 
 type warning = error
 
-
-type function_info = { name : string
-		     ; spec : Token.t list
-		     }
-
 type parser_state =
   | Top_level
-  | Function of function_info
+  | Function
+  | Compiler_directive
 
-type state = { program_options : Program_options.t
-	     ; imputed_line_length : int
+type state = { program_options   : Program_options.t
 	     (* The number of indentations, not the number of spaces *)
 	     ; indentation_level : int
-	     (* This is the current line we aer reading, starting at 0 *)
-	     ; src_line_number : int
+	     (* This is the current line we are reading, starting at 0 *)
+	     ; src_line_number   : int
 	     (* This is current line number we are writing, starting at 0 *)
-	     ; dst_line_number : int
-	     ; parser_state : parser_state
-	     ; buffer : Buffer.t
-	     ; warnings : warning list
+	     ; dst_line_number   : int
+	     ; parser_state      : parser_state list
+	     ; builder           : Format_builder.t
+	     ; warnings          : warning list
 	     }
 
 
 let default_state program_options buffer =
-  { program_options = program_options
-  ; imputed_line_length = 0
+  { program_options   = program_options
   ; indentation_level = 0
-  ; src_line_number = 0
-  ; dst_line_number = 0
-  ; parser_state = Top_level
-  ; buffer = buffer
-  ; warnings = []
+  ; src_line_number   = 0
+  ; dst_line_number   = 0
+  ; parser_state      = [Top_level]
+  ; builder           = Format_builder.t
+  ; warnings          = []
   }
 
+
+let string_of_token = function
+  | Token.Keyword kwd -> kwd
+  | Token.Atom atm    -> atm
+  | Token.Var var     -> var
+  | Token.Char char   -> char
+  | Token.Number num  -> num
+  | Token.String str  -> str
+  | Token.Comment com -> "%" ^ com
+  | Token.Newline     -> "\n"
+  | Token.Dot         -> "."
+
 let incr ?(step = 1) num = num + step
 
 let incr_src_line state =
   { state with src_line_number = incr state.src_line_number }
 
 let incr_dst_line state =
-  Buffer.add_char state.buffer '\n';
+  Buffer.add_string state.buffer (string_of_token Newline);
   { state with
     dst_line_number = incr state.dst_line_number;
     imputed_line_length = 0
   }
 
+(*
+ * Kind of lame I'm naming this bind but this is effectively
+ * a monad-like thing so might as well stick to the literature?
+ *)
+let bind f = function
+  | R.Success (state, rest) ->
+    f state rest
+  | R.Failure error ->
+    R.Failure error
+
 let fail state msg =
   R.Failure { line_number = state.src_line_number
 	    ; msg = msg
   | Newline::xs ->
     format_top_level (incr_dst_line (incr_src_line state)) xs
   | (Comment text)::xs -> begin
-    Buffer.add_string state.buffer ("%" ^ text);
+    Buffer.add_string state.buffer (string_of_token (Comment text));
     if is_line_too_long state text then
       format_top_level
-	(add_warning state "Comment too long, please fix")
+	(add_warning state "Comment longer than maximum line length")
 	xs
     else
       format_top_level state xs
   end
-  | (Keyword "-")::(Atom "module")::(Keyword "("
+  | (Keyword "-")::(Atom "module")::xs ->
+    bind
+      format_top_level
+      (format_module
+	 { state with
+	   state.parser_state =
+	     Compiler_directive::state.parser_state;
+	   line_builder =
+	     Line_builder.add_tokens
+	       state.line_builder
+	       [Keyword "-"; Atom "module"]
+	 }
+	 xs)
   | [] -> succeed state
   | _::xs -> format_top_level state xs
+and format_module state = function
+  | (Keyword "(")::(Atom mod_name)::(Keyword ")")::Dot::Newline::xs ->
+    
+
 
 let format_code program_options code =
   (*
    *)
   let buffer = Buffer.create (List.length code * 10) in
   let state = default_state program_options buffer in
-  format_top_level state code
+  match format_top_level state code with
+    | R.Success (state, []) ->
+      succeed state
+    | R.Success (state, _) ->
+      fail state "Did not consume entire input"
+    | R.Failure error ->
+      R.Failure error
 
-let format program_options out_chan code =
+let format_to_channel program_options out_chan code =
   match format_code program_options code with
     | R.Success (formatted_code, warnings) -> begin
       output_string out_chan formatted_code;
 
 type warning = error
 
-val format : Program_options.t -> out_channel -> Token.t list -> (warning list, error) Return.t
+val format_code       : Program_otpions.t -> Token.t list -> ((string * warning list), error) Return.t
+val format_to_channel : Program_options.t -> out_channel -> Token.t list -> (warning list, error) Return.t
 type t = 
-  (* case receive .. etc *)
+  (* { } ( ) + = =:= : case receive .. etc *)
   | Keyword of string
-  (* { } ( ) + = === : .. etc *)
   | Atom of string
   | Var of string
   (* 
   | Dot ->
     "Dot"
 
-let rec pp stream =
+let rec pp_stream stream =
   match Stream.peek stream with
     | None ->
       Printf.printf "\n"
 type t = 
-  (* == =:= [ ] case receive .. etc *)
+  (* { } ( ) + = =:= : case receive .. etc *)
   | Keyword of string
   | Atom of string
   | Var of string
   | Dot
 
 
-val pp : t Stream.t -> unit
+val pp_stream : t Stream.t -> unit
 val pp_list : t list -> unit