1. camlspotter
  2. ocaml-indent

Source

ocaml-indent / main.ml

The default branch has multiple heads

open Sexplib.Conv
open Pos
open Reader

module Indent = struct
  (* a *)
  type t = 
    | Add_to_last of int
    | Diff of int 
    | Set of int
  with sexp
end

module Stack = struct
  open Indent
    
  type k = KExpr | KParen | KLet of [`Top | `Local ] * int | KType of int | KNone | KStruct of int | KSig of int | KModule of int | KOpen | KBegin of int
  with sexp

  type elt = { k : k;
               line : int;
               indent : Indent.t }
  with sexp

  type t = elt list with sexp

  let rec indent last_indent  = function
    | [] -> 0
    | { indent = Set n } :: _ -> n
    | { indent = Add_to_last n } :: _ -> last_indent + n
    | { indent = Diff n } :: ts -> indent last_indent ts + n
end

module State = struct
  type t = {
    bases : Stack.t;
    orig_indent : int;
    last_indent : int;
    last_token : Parser.token option;
  } with sexp

  let init = { bases = []; orig_indent = 0; last_indent = 0; last_token = None; }

  let indent t = Stack.indent t.last_indent t.bases
end

open State
open Stack
open Parser

let rec is_top_let = function
  | None -> true
  | Some t ->
      match t with
      | COMMENT -> assert false (* COMMENT must be skipped *)
      | STRUCT | SEMISEMI 

      | UIDENT _|STRING _|OPTLABEL _|NATIVEINT _|LIDENT _|LABEL _|INT64 _|INT32 _
      | INT _|FLOAT _|CHAR _|WITH|VIRTUAL|VAL|UNDERSCORE|TYPE|TRUE|TILDE|SIG|SHARP
      | RPAREN|REC|RBRACKET|RBRACE|QUOTE|QUESTIONQUESTION|QUESTION|PRIVATE|OPEN
      | OF|OBJECT|NEW|MUTABLE|MODULE|METHOD|MATCH|LET|LESS|LAZY|INHERIT|INCLUDE
      | GREATERRBRACKET|GREATERRBRACE|GREATER|FUNCTOR|FUNCTION|FUN|FOR|FALSE
      | EXTERNAL|EXCEPTION|EOF|END|DOTDOT|DOT|DONE|CONSTRAINT|COLONGREATER
      | COLONCOLON|COLON|CLASS|BARRBRACKET|BARBAR|BAR|BANG|BACKQUOTE|ASSERT|AS|AND
      | AMPERSAND|AMPERAMPER -> true

      | _ -> false

let rec unwind_top = function (* unwind the top *)
  | { k = KLet (`Top, _) } :: bs -> bs
  | ({ k = KModule _ } :: _ as bs) -> bs
  | _ :: bs -> unwind_top bs
  | [] -> []

let token state region str (t : Parser.token) : State.t * State.t = 
  let line = Region.lnum region in
  let columns = Region.columns region in
  let indent = state.last_indent in
  let bases0 = state.bases in

  let pre_bases, post_bases = match t with
    | SEMISEMI ->
        (* unwind the top *)
        let bases = unwind_top bases0 in
        bases, bases

    | OPEN -> 
        let bases = unwind_top bases0 in
        bases, 
        { k = KOpen; indent = Indent.Diff 2; line } :: bases

    | MODULE ->
        let bases = unwind_top bases0 in
        bases, 
        { k = KModule columns; indent = Indent.Diff 2; line } :: bases

    | LET when is_top_let state.last_token ->
        let bases = unwind_top bases0 in
        bases, 
        { k = KLet (`Top, columns); indent = Indent.Diff 2; line } :: bases

    | LET ->
        bases0, { k = KLet (`Local, columns); indent = Indent.Diff 2; line } :: bases0

    | TYPE ->
        let bases = unwind_top bases0 in
        bases, 
        { k = KType columns; indent = Indent.Diff 2; line } :: bases
          
    | AND -> 
        (* for let *)
        (* recover the last let *)
        let rec f = function
          | ({k = (KLet (_,columns) | KType columns | KModule columns) } :: bs as bases) -> 
              { k = KNone; indent = Indent.Set columns; line }:: bs, bases
          | [] -> [], []
          | _ :: bs -> f bs
        in
        f bases0

    | IN ->
        (* in must paired with let *)
        let rec f = function
          | { k = KLet(_, columns) } :: bs -> 
              { k = KNone; indent = Indent.Set columns; line } :: bs, bs
          | [] -> [], []
          | _ :: bs -> f bs
        in
        f bases0

    | STRUCT ->
        bases0, { k = KStruct indent; indent = Indent.Diff 2; line } :: bases0

    | SIG ->
        bases0, { k = KSig indent; indent = Indent.Diff 2; line } :: bases0

    | BEGIN ->
        bases0, { k = KBegin indent; indent = Indent.Diff 2; line } :: bases0

    | END ->
        let rec f = function
          | { k = (KStruct columns | KSig columns | KBegin columns) } :: bs -> 
              { k = KNone; indent = Indent.Set columns; line } :: bs, bs
          | [] -> [], []
          | _ :: bs -> f bs
        in
        f bases0

(*
    | EQUAL -> (* after let *)
        let rec f = function
          | { k = KLet } :: bs -> 
              { k = KLet; indent = Indent.Diff 2; line } :: bs, 
              { k = KLet; indent = Indent.Diff 2; line } :: bs
          | [] -> [], []
          | _ :: bs -> f bs
        in
        f bases0

    | INT64 _ | INT32 _ |INT _ | LIDENT _ | UIDENT _ ->
        let rec f = function
          | { k = KExpr } :: _ -> bases0
          | { k = KParen } :: _ -> { k = KExpr; indent =Indent.Set columns; line } :: bases0
          | [] -> { k = KExpr; indent = Indent.Diff 2; line } :: bases0
          | _ :: bs -> f bs
        in
        bases0, f bases0

    | PLUS | PLUSDOT | MINUS | MINUSDOT | STAR ->
        { k = KExpr; indent = Indent.Diff (-2); line} :: bases0, bases0
          
    | COMMA ->
        let bases = 
          let rec f = function
            | ({ k = KExpr } :: bs as bases) -> bases
            | { k = KParen } :: _ -> bases0
            | [] -> []
            | _ :: bs -> f bs
          in
          f bases0
        in
        bases, bases0
*)
          
(*
    | LPAREN ->
        bases0, { k = KParen; indent = Indent.Set (columns + 2); line } :: bases0

    | RPAREN ->
        let rec f = function
          | _ :: { k = KTop } :: bs -> bs
          | { k = KParen }  :: bs -> bs
          | [] -> []
          | _ :: bs -> f bs
        in
        let bases = f bases0 in
        bases, bases
*)

          | (UIDENT _|LIDENT _|INT64 _|INT32 _|INT _|STAR|RPAREN|PLUSDOT|PLUS|MINUSDOT|
      MINUS|LPAREN|EQUAL|COMMA)

    | STRING _|PREFIXOP _|OPTLABEL _|NATIVEINT _|LABEL _|INFIXOP4 _|
      INFIXOP3 _|INFIXOP2 _|INFIXOP1 _|INFIXOP0 _|FLOAT _|CHAR _|COMMENT|WITH|
      WHILE|WHEN|VIRTUAL|VAL|UNDERSCORE|TRY|TRUE|TO|TILDE|THEN|
      SHARP|SEMI|REC|RBRACKET|RBRACE|QUOTE|QUESTIONQUESTION|QUESTION|
      PRIVATE|OR|OF|OBJECT|NEW|MUTABLE|MINUSGREATER|METHOD|MATCH
          |LESSMINUS|LESS|LBRACKETGREATER|LBRACKETLESS|LBRACKETBAR|LBRACKET|
      LBRACELESS|LBRACE|LAZY|INITIALIZER|INHERIT|INCLUDE|IF|GREATERRBRACKET|
      GREATERRBRACE|GREATER|FUNCTOR|FUNCTION|FUN|FOR|FALSE|EXTERNAL|EXCEPTION|EOF|
      ELSE|DOWNTO|DOTDOT|DOT|DONE|DO|CONSTRAINT|COLONGREATER|COLONEQUAL|
      COLONCOLON|COLON|CLASS|BARRBRACKET|BARBAR|BAR|BANG|BACKQUOTE|ASSERT|AS|
      AMPERSAND|AMPERAMPER -> bases0, bases0
  in
  { state with bases = pre_bases },
  { state with bases = post_bases; last_token = (if t <> COMMENT then Some t else state.last_token); }

let update_state state new_line orig_region str t = 

  (* if it is a new line, compute the line's indentation *)
  let state' =
    if new_line then
      let pre, _ = token state orig_region str t in
      pre
    else
      state
  in

  let ind = State.indent state' in

  let fixed_region = Region.move_chars (ind - state.orig_indent) orig_region in
 
  token state fixed_region str t

let parse_args () = 
  let rev_paths = ref [] in
  let debug = ref false in
  Arg.parse [
    ("-debug", Arg.Set debug, "debugging")
  ] (fun s -> rev_paths := s :: !rev_paths) "indent paths";
  List.rev !rev_paths, !debug

let paths, debug = parse_args ()

let _ = 
  List.iter (fun path ->
    let str = lazy (Filter.streamer path) in

    let rec loop last_orig_region state str = match Filter.destr str with
      | None ->
          (* The last white space is gone *)
          print_string "\n"
      | Some (i, str) ->
          let t = i.Filter.token in
          let orig_region = i.Filter.region in
          let space_between = i.Filter.space in
          let substr = i.Filter.substr in

          let new_line = Region.lnum last_orig_region <>  Region.lnum orig_region in

          let state = 
            if new_line then { state with orig_indent = Region.columns orig_region } else state
          in
          
          let pre, post = update_state state new_line orig_region str t in

          let post = 
            if new_line then 
              { post with last_indent = State.indent pre }
            else post
          in
          
          (* printing *)

          if new_line then begin
            let space_between = 
              try 
                let pos = String.rindex space_between '\n' in 
                String.sub space_between 0 pos
              with
              | _ -> assert false
            in
            print_endline space_between;

            let indent_string = String.make (State.indent pre) ' ' in
            if debug then begin
              print_string indent_string;
              Format.printf "-- %s@." (Sexplib.Sexp.to_string_mach (Stack.sexp_of_t pre.bases))
            end;

            print_string indent_string;
            print_string substr
          end else begin
            print_string space_between;
            print_string substr;
          end;
          
          loop orig_region post str
    in

    loop Region.zero State.init str
  ) paths