Commits

camlspotter committed 2db6c9a

-show-status for printing the state info at the last

Comments (0)

Files changed (1)

 open Reader
 
 module Stack = struct
-    
-  type k = 
+
+  type k =
     | KExpr of int
     | KParen of int
     | KBrace of int
     | KBracket of int
-    | KLet of [`Top | `Local ] * int 
-    | KVal 
-    | KType of int 
+    | KLet of [`Top | `Local ] * int
+    | KVal
+    | KType of int
     | KException of int
-    | KNone 
-    | KStruct of int 
-    | KSig of int 
-    | KModule of int 
-    | KOpen 
+    | KNone
+    | KStruct of int
+    | KSig of int
+    | KModule of int
+    | KOpen
     | KBegin of int
     | KObject of int
     | KMatch of int
 
 module State = struct
   type t = {
-    bases : Stack.t;
+    modified : bool; (* Has the source code ever modified ? *)
     orig_indent : int; (* The original indent of the current line *)
     last_indent : int; (* At line head, first pass: the fixed indent of the last line
                           At line head, snd pass: the fixed indent of the current line
                           Otherwise: the fixed indent of the current line *)
     last_token : Parser.token option;
-    modified : bool (* Has the source code ever modified ? *)
+    bases : Stack.t;
   } with sexp_of
 
   let init = { bases = []; orig_indent = 0; last_indent = 0; last_token = None; modified = false }
 
   let indent t = Stack.indent t.last_indent t.bases
+
+  let print t = print_endline (Sexplib.Sexp.to_string_mach (sexp_of_t t))
 end
 
 open State
   | Some t ->
       match t with
       | COMMENT -> assert false (* COMMENT must be skipped *)
-      | STRUCT | SEMISEMI 
+      | STRUCT | SEMISEMI
 
       | UIDENT _|STRING _|OPTLABEL _|NATIVEINT _|LIDENT _|LABEL _|INT64 _|INT32 _
       | INT _|FLOAT _|CHAR _|WITH|VIRTUAL|VAL|UNDERSCORE|TYPE|TRUE|TILDE|SIG|SHARP
 
 let function_read_ahead = lbrace_read_ahead
 
-let token state str at_the_head region (t : Parser.token) : State.t * State.t = 
+let token state str at_the_head region (t : Parser.token) : State.t * State.t =
   let line = Region.lnum region in
   let cols = Region.columns region in
   let indent = state.last_indent in
         let bases = unwind_top bases0 in
         bases, bases
 
-    | OPEN -> 
+    | OPEN ->
         let bases = unwind_top bases0 in
-        bases, 
+        bases,
         { k = KOpen; indent = cols + 2; } :: bases
 
     | MODULE ->
         let bases = unwind_top bases0 in
-        bases, 
+        bases,
         { k = KModule cols; indent = cols + 2; } :: bases
 
     | LET when is_top_let state.last_token ->
         let bases = unwind_top bases0 in
-        bases, 
+        bases,
         { k = KLet (`Top, cols); indent = cols + 2; } :: bases
 
     | LET ->
         bases0, { k = KLet (`Local, cols); indent = cols + 2; } :: bases0
 
-    | VAL -> 
+    | VAL ->
         let bases = unwind_top bases0 in
-        bases, 
+        bases,
         { k = KVal; indent = cols + 2; } :: bases
 
     | EQUAL ->
           | {k = (KLet (_,cols) | KType cols | KModule cols) } :: _ ->
               bases, bases
           (* Equal can exceed the following *)
-          | { k = (KExpr _ | KNone) } :: bs -> f bs  
+          | { k = (KExpr _ | KNone) } :: bs -> f bs
           (* Equal cannot exceed the other *)
           | _ :: bs -> bases0, bases0
           | [] -> [], []
         in
         f bases0
-        
+
     | TYPE when state.last_token = Some MODULE -> (* module type *)
         (* we might change the kind to KModuleType, but ... let's keep it simpler *)
-        bases0, bases0 
-          
+        bases0, bases0
+
     | TYPE ->
         let bases = unwind_top bases0 in
-        bases, 
+        bases,
         { k = KType cols; indent = cols + 2; } :: bases
-          
+
     | EXCEPTION ->
         let bases = unwind_top bases0 in
-        bases, 
+        bases,
         { k = KException cols; indent = cols + 2; } :: bases
-        
-    | AND -> 
+
+    | AND ->
         (* for let *)
         (* recover the last let *)
         let rec f bases = match bases with
     | IN ->
         (* in must paired with let *)
         let rec f bases = match bases with
-          | { k = KLet(_, cols) } :: bs -> 
+          | { k = KLet(_, cols) } :: bs ->
               fix cols, bs
           | [] -> [], []
           | _ :: bs -> f bs
 
     | END ->
         let rec f bases = match bases with
-          | { k = (KStruct cols | KSig cols | KBegin cols | KObject cols) } :: bs -> 
+          | { k = (KStruct cols | KSig cols | KBegin cols | KObject cols) } :: bs ->
               fix cols, bs
           | [] -> [], []
           | _ :: bs -> f bs
         f bases0
 
     | MATCH ->
-        bases0, 
+        bases0,
         if at_the_head then
           { k = KMatch cols; indent = cols + 2; } :: bases0
         else
           { k = KMatch (indent + 2); indent = cols + 2; } :: bases0
 
     | TRY ->
-        bases0, 
+        bases0,
         if at_the_head then
           { k = KTry cols; indent = cols + 2; } :: bases0
         else
         let rec f bases = match bases with
           | { k = KBrace cols } :: _ ->
               fix (cols + 2), bases
-          | { k = (KType cols | KException cols | KMatch cols | KTry cols) } :: bs -> 
-              fix cols, 
+          | { k = (KType cols | KException cols | KMatch cols | KTry cols) } :: bs ->
+              fix cols,
              { k = KWith cols; indent = cols + 2; } :: bs
           | [] -> [], []
           | _ :: bs -> f bs
         in
         f bases0
 
-    | IF -> 
+    | IF ->
         bases0, { k = KIf cols; indent = cols + 2; } :: bases0
 
     | THEN ->
         in
         f bases0
 
-    | WHILE -> 
+    | WHILE ->
         bases0, { k = KWhile indent; indent = cols + 2; } :: bases0
 
     | DO ->
         let rec f bases = match bases with
-          | { k = (KWhile cols ) } :: bs -> 
+          | { k = (KWhile cols ) } :: bs ->
               { k = KDo cols; indent = cols; } :: bs, bs
           | [] -> [], []
           | _ :: bs -> f bs
 
     | DONE ->
         let rec f bases = match bases with
-          | { k = (KDo cols ) } :: bs -> 
+          | { k = (KDo cols ) } :: bs ->
               fix cols, bs
           | [] -> [], []
           | _ :: bs -> f bs
 
     | RPAREN ->
         let rec f bases = match bases with
-          | { k = (KParen cols ) } :: bs -> 
+          | { k = (KParen cols ) } :: bs ->
               fix cols, bs
           | [] -> [], []
           | _ :: bs -> f bs
 
     | RBRACE ->
         let rec f bases = match bases with
-          | { k = (KBrace cols ) } :: bs -> 
+          | { k = (KBrace cols ) } :: bs ->
               fix cols, bs
           | [] -> [], []
           | _ :: bs -> f bs
 
     | RBRACKET ->
         let rec f bases = match bases with
-          | { k = (KBracket cols ) } :: bs -> 
+          | { k = (KBracket cols ) } :: bs ->
               fix cols, bs
           | [] -> [], []
           | _ :: bs -> f bs
 
     | FUNCTION ->
         if function_read_ahead line str then
-          bases0, 
-          { k = KFunction cols; indent = cols + 10 (* function+2 *); } :: bases0 
+          bases0,
+          { k = KFunction cols; indent = cols + 10 (* function+2 *); } :: bases0
         else
-          bases0, 
-          { k = KFunction indent; indent = indent + 4 (* "  | " *); } :: bases0 
+          bases0,
+          { k = KFunction indent; indent = indent + 4 (* "  | " *); } :: bases0
 
-    | FUN -> 
-        bases0, { k = KFun indent; indent = indent + 2; } :: bases0 
+    | FUN ->
+        bases0, { k = KFun indent; indent = indent + 2; } :: bases0
 
     | BAR ->
         let rec f bases = match bases with
-          | { k = ( KType cols 
+          | { k = ( KType cols
                   | KFunction cols) } :: _ ->
               fix (cols + 2), bases
-          | { k = ( KBracket cols 
+          | { k = ( KBracket cols
                   | KWith cols
                   | KParen cols) } :: _ ->
               fix cols, bases
     | MINUSGREATER ->
         let rec f bases = match bases with
           | { k = (KWith cols) } :: _ ->
-              bases0, 
+              bases0,
               { k = KCaseArrow; indent = cols + 4; } :: bases
           | { k = (KFunction cols) } :: _ ->
-              bases0, 
+              bases0,
               { k = KCaseArrow; indent = cols + 6; } :: bases
           | { k = (KFun cols) } :: _ ->
-              bases0, 
+              bases0,
               { k = KCaseArrow; indent = cols + 2; } :: bases
           | [] -> bases0, bases0 (* if overrun, keep the original *)
           | _ :: bs -> f bs
 
     | COMMA ->
         let rec f bases = match bases with
-          | { k = ( KBegin cols 
-                  | KBracket cols 
-                  | KBrace cols 
+          | { k = ( KBegin cols
+                  | KBracket cols
+                  | KBrace cols
                   | KLet (_, cols) ) } :: _ ->
               fix (cols + 2), bases
           | { k = ( KParen cols ) } :: _ ->
         let rec f bases = match bases with
           | { k = (KParen cols | KBegin cols | KBracket cols | KBrace cols | KLet (_, cols)) | KTry cols | KMatch cols | KFun cols | KFunction cols } :: _ ->
               fix cols, bases
-          | { k = (KThen cols | KElse cols) } :: bs -> 
+          | { k = (KThen cols | KElse cols) } :: bs ->
               fix cols, bs
           | [] -> bases0, bases0 (* if overrun, keep the original *)
           | _ :: bs -> f bs
         in
         f bases0
-          
+
     | INT64 _ | INT32 _ | INT _ | LIDENT _ | UIDENT _ | FLOAT _| CHAR _ | STRING _ | TRUE | FALSE ->
         let rec f bases = match bases with
           | { k = KExpr _ } :: _ -> bases0, bases0
         in
         f bases0
 
-    | STAR | PLUSDOT | PLUS | MINUSDOT | MINUS 
-    | INFIXOP4 _ | INFIXOP3 _ | INFIXOP2 _ | INFIXOP1 _ | INFIXOP0 _ 
+    | STAR | PLUSDOT | PLUS | MINUSDOT | MINUS
+    | INFIXOP4 _ | INFIXOP3 _ | INFIXOP2 _ | INFIXOP1 _ | INFIXOP0 _
     | LESS | GREATER | AMPERSAND | AMPERAMPER
       ->
         let rec f bases = match bases with
-          | { k = KExpr cols } :: _ -> 
+          | { k = KExpr cols } :: _ ->
               { k = KNone; indent = cols } :: bases0, bases0
           | [] -> bases0, bases0
           | _ :: bs -> f bs
 
     | COMMENT ->
         (* Comments are tricky. It is:
-           
+
            - sometimes affected by the previous line's indentation
            - sometimes affected by the next line's indentation
            - sometimes independent
         *)
         fix cols, bases0
-        
+
     |PREFIXOP _|OPTLABEL _|NATIVEINT _|LABEL _
     |WHEN|VIRTUAL|UNDERSCORE|TO|TILDE|
       SHARP|REC|QUOTE|QUESTIONQUESTION|QUESTION|
   { state with bases = pre_bases },
   { state with bases = post_bases }
 
-let update_state state new_line fix_indent str orig_region t = 
+let update_state state new_line fix_indent str orig_region t =
 
-  (* If it is a new line + we need to fix the indent of the line, compute the line's indentation. 
+  (* If it is a new line + we need to fix the indent of the line, compute the line's indentation.
      Otherwise, we use the original state.
   *)
   let state' =
   in
 
   (* Fix the indentation. It may be updated by the previous call of [token]. *)
-  let fixed_region = 
+  let fixed_region =
     (* CR jfuruse: Spaghetti... *)
     if fix_indent then Region.move_chars (state'.last_indent - state.orig_indent) orig_region else orig_region
   in
-  let state = { state 
-                with 
+  let state = { state
+                with
                   last_indent = state'.last_indent
-                  ; modified = state'.modified || orig_region <> fixed_region 
-              } 
+                  ; modified = state'.modified || orig_region <> fixed_region
+              }
   in
 
   (* Rerun [token] *)
   token state str new_line fixed_region t
 
-let parse_args () = 
+let paths, debug, lines, showstate =
   let rev_paths = ref [] in
   let debug = ref false in
   let lines = ref None in
+  let showstate = ref false in
   Arg.parse [
     ("-debug", Arg.Set debug, "debugging");
     ("-lines", Arg.String (fun s ->
-      try 
+      try
         let pos = String.index s '-' in
         let (start,end_) = (int_of_string (String.sub s 0 pos),
                             int_of_string (String.sub s (pos+1) (String.length s - pos - 1))) in
         lines := Some (start, end_)
       with
       | _ -> failwith (Printf.sprintf "Wrong -lines specification: %s" s)),
-     "lines, ex. 10-12") 
+     "lines, ex. 10-12") ;
+    ("-show-state", Arg.Set showstate, "show state at the last");
   ] (fun s -> rev_paths := s :: !rev_paths) "indent paths";
   let paths = List.rev !rev_paths in
   let paths = if paths = [] then [""] else paths in (* CR jfuruse: ugly *)
-  let debug = !debug in
-  let lines = !lines in
-  begin match paths, lines with
+  begin match paths, !lines with
   | [], _ -> assert false
   | [_], _ -> ()
-  | _, Some _ -> failwith "Region can be specified with at most one file" 
+  | _, Some _ -> failwith "Region can be specified with at most one file"
   | _ -> ()
   end;
-  paths, debug, lines
+  paths, !debug, !lines, !showstate
 
-let paths, debug, lines = parse_args ()
+let check_lines l = function
+  | None -> `Inside
+  | Some (start, end_) ->
+      if l < start then `Before
+      else if l <= end_ then `Inside
+      else `Over
 
 module Printer = struct
 
   type t = (int * int) option
 
-  let add_debug t lnum s =
-    match t with
-    | None -> print_string s
-    | Some (start, end_) ->
-        if lnum < start then ()
-        else if lnum > end_ then ()
-        else print_string s
+  let add_debug t lnum s = match check_lines lnum t with
+    | `Before | `Over -> ()
+    | `Inside -> print_string s
 
   let add_string t lnum s =
-    let add_line t lnum s =
-      match t with
-      | None -> print_string s
-      | Some (start, end_) ->
-          if lnum < start then ()
-          else if lnum > end_ then raise Exit
-          else print_string s
+    let add_line t lnum s = match check_lines lnum t with
+      | `Before -> ()
+      | `Over -> raise Exit
+      | `Inside -> print_string s
     in
     let get_line s =
-      try 
+      try
         let pos = String.index s '\n' in
-        String.sub s 0 (pos + 1), 
+        String.sub s 0 (pos + 1),
         Some (String.sub s (pos + 1) (String.length s - pos - 1))
       with
       | Not_found -> s, None
     in
-    let rec iter lnum s = 
+    let rec iter lnum s =
       let line, rest =  get_line s in
       add_line t lnum line;
       match rest with
       | None -> ()
     in
     iter lnum s
-  ;;
-    
-end 
 
-let indent_file path = 
+  let add_string t lnum s = try add_string t lnum s with Exit -> ()
+
+end
+
+let indent_file path =
   let printer = lines in
   let str = if path = "" then Tokenstr.of_channel stdin else Tokenstr.of_path path in
 
   let rec loop last_orig_region state str = match Tokenstr.destr str with
-    | None -> ()
+    | None -> state
 
     | Some (({Tokenstr.token = EOF} as i), _) ->
         let space_between = i.Tokenstr.space in
-        Printer.add_string printer (Region.lnum last_orig_region) space_between
-          
-    | Some (i, str) ->
-        let t = i.Tokenstr.token in
-        let orig_region = i.Tokenstr.region in
-        let space_between = i.Tokenstr.space in
-        let substr = i.Tokenstr.substr in
+        Printer.add_string printer (Region.lnum last_orig_region) space_between;
+        state
 
-          (*
-            Format.eprintf "<%s %d>@."
-            (Sexplib.Sexp.to_string_mach (Parser.sexp_of_token t))
-            (Region.columns orig_region);
-          *)
+    | Some ({ Tokenstr.token = t; region = orig_region; space = space_between; substr }, str) ->
 
-          let last_line = Region.lnum last_orig_region in
-          let current_line = Region.lnum orig_region in
-          let new_line = last_line <>  current_line in
+        let last_line = Region.lnum last_orig_region in
+        let current_line = Region.lnum orig_region in
+        let new_line = last_line <>  current_line in
 
-          let state = 
-            if new_line then { state with orig_indent = Region.columns orig_region } else state
-          in
-          
-          let fix_indent = 
-            match lines with
-            | Some (start, _) -> start <= Region.lnum orig_region
-            | _ -> true
-          in
+        match check_lines (Region.lnum orig_region) lines with
+        | `Over -> 
+            Printer.add_string printer last_line space_between;
+            state
+        | (`Before | `Inside as line_status) -> 
+            (*
+              Format.eprintf "<%s %d>@."
+              (Sexplib.Sexp.to_string_mach (Parser.sexp_of_token t))
+              Fatal error: exception Lexer.Error(0, _)
+            *)
 
-          let pre, post = update_state state new_line fix_indent str orig_region t in
-          
-          (* printing *)
-          
-          if new_line then begin
-            (* the line 1 has no previous new line char *)
-            let spaces = try String.sub space_between 0 (String.rindex space_between '\n' + 1) with _ -> "" in 
-            Printer.add_string printer last_line spaces;
+
+            let state =
+              if new_line then { state with orig_indent = Region.columns orig_region } else state
+            in
+
+            let fix_indent = match line_status with
+              | `Inside -> true
+              | `Before -> false
+              | `Over -> assert false
+            in
+
+            let pre, post = update_state state new_line fix_indent str orig_region t in
             
-            let indent_string = String.make (State.indent pre) ' ' in
-            if debug then begin
+            (* printing *)
+
+            if new_line then begin
+              (* the line 1 has no previous new line char *)
+              let spaces = try String.sub space_between 0 (String.rindex space_between '\n' + 1) with _ -> "" in
+              let indent_string = String.make (State.indent pre) ' ' in
+
+              Printer.add_string printer last_line spaces;
+
+              if debug then begin
+                Printer.add_string printer current_line indent_string;
+                if pre == post then
+                  Printer.add_debug printer current_line
+                    (Printf.sprintf "-- %s\n" (Sexplib.Sexp.to_string_mach (Stack.sexp_of_t pre.bases)))
+                else
+                  Printer.add_debug printer current_line
+                    (Printf.sprintf "-- %s // %s\n"
+                      (Sexplib.Sexp.to_string_mach (Stack.sexp_of_t pre.bases))
+                      (Sexplib.Sexp.to_string_mach (Stack.sexp_of_t post.bases)))
+              end;
+
               Printer.add_string printer current_line indent_string;
-              if pre == post then 
-                Printer.add_debug printer current_line
-                  (Printf.sprintf "-- %s\n" (Sexplib.Sexp.to_string_mach (Stack.sexp_of_t pre.bases)))
+              Printer.add_string printer current_line substr
+            end else begin
+              Printer.add_string printer current_line space_between;
+              Printer.add_string printer current_line substr;
+            end;
+
+            (* Now move to the next token *)
+
+            let post =
+              if new_line then
+                { post with
+                  last_token = (if t <> COMMENT then Some t else state.last_token)
+                ; last_indent = State.indent pre
+                }
               else
-                Printer.add_debug printer current_line
-                  (Printf.sprintf "-- %s // %s\n" 
-                     (Sexplib.Sexp.to_string_mach (Stack.sexp_of_t pre.bases))
-                     (Sexplib.Sexp.to_string_mach (Stack.sexp_of_t post.bases)))
-            end;
-            
-            Printer.add_string printer current_line indent_string;
-            Printer.add_string printer current_line substr
-          end else begin
-            Printer.add_string printer current_line space_between;
-            Printer.add_string printer current_line substr;
-          end;
-          
-          (* Now move to the next token *)
-          
-          let post = 
-            if new_line then 
-              { post with 
-                last_token = (if t <> COMMENT then Some t else state.last_token)
-              ; last_indent = State.indent pre 
-              }
-            else 
-              { post with 
-                last_token = (if t <> COMMENT then Some t else state.last_token)
-              }
-                
-          in
-          
-          loop orig_region post str
-    in
-    try
-      loop Region.zero State.init str;
-      raise Exit
-    with
-    | Exit -> Tokenstr.close str
+                { post with
+                  last_token = (if t <> COMMENT then Some t else state.last_token)
+                }
+
+            in
+
+            loop orig_region post str
+  in
+  let final_state = loop Region.zero State.init str in
+  if showstate then State.print final_state;
+  Tokenstr.close str
 
 let _ = List.iter indent_file paths