* Re: ocaml+twt 0.85
2006-07-24 23:39 ocaml+twt 0.85 Mike Lin
2006-07-25 0:10 ` [Caml-list] " Till Varoquaux
@ 2006-08-04 23:09 ` Ingo Bormuth
1 sibling, 0 replies; 3+ messages in thread
From: Ingo Bormuth @ 2006-08-04 23:09 UTC (permalink / raw)
To: mikelin, caml-list
[-- Attachment #1.1: Type: text/plain, Size: 1371 bytes --]
Hi Mike,
I frequently use ocaml+twt and really got used to my quicker to
type and easier to read sources. Be blessed for writing it !
The only inconvenience I found is that column numbers in compiler
errors do not match the original source which sometimes makes
debugging quite a pain.
Find attached a version which will put all the 'begins', 'ends'
and parentheses at the end of the lines which also makes the
generated code more pleasant to read.
I briefly tested my version on some simple code I had on hand.
I didn't test any complicated syntax. If you find any bugs
just tell me - I'm willing to review the changes again.
I just used the following vim commands to alter your code (v0.85).
You may want to just apply these in case you already have a new version.
'400' is the line number where 'OCaml syntax formation' starts.
:%s/" *\(begin\|end\|(\|)\|;;\) *"/" \1"/g
:%s/\^ *"\\n"/\^ endl/g
:%s/ *\^ *endl / /g
:400,$s/^\([ \t]*\)\([a-z]*line .*\)/\1endl \^ \2/g
:400,$s/-> *\([a-z]*line .*\)/-> endl \^ \1/g
:400,$s/\([^l ] *\^ *\)\([a-z]*line \)/\1endl \^ \2/g
:%s/(printer syntax)/( Str.replace_first (Str.regexp "\\n") "" (printer syntax) )/g
Cheers
Ingo
--
Ingo Bormuth, voicebox & telefax: +49-12125-10226517 '(~o-o~)'
public key 86326EC9, http://ibormuth.efil.de/contact --ooO--(.)--Ooo--
[-- Attachment #1.2: ocaml+twt.ml --]
[-- Type: text/plain, Size: 28179 bytes --]
(*
ocaml+twt.ml
by Mike Lin (mikelin@mit.edu)
"The Whitespace Thing" for OCaml
This is a preprocessor for a new OCaml syntax that uses indentation rather than
parenthesization to group expressions.
*)
type whitespace_mode =
Either
| Tab_only
| Space_only
type configuration = {
mutable whitespace_mode : whitespace_mode
}
let config = {
whitespace_mode = Either
}
let endl = "\n"
(******************************************************************************
stupid amateurish lexing stuff
******************************************************************************)
let whitespace_chars = [ ' '; '\t' ]
let comment_line_re = Str.regexp "[ \t]*(\\*.*"
let indent_count line =
let i = ref 0 in
let l = String.length line in
while !i < l && List.mem line.[!i] whitespace_chars do
i := !i + 1
done;
!i
let is_blank line =
(indent_count line) = (String.length line) || (Str.string_match comment_line_re line 0)
type lexical_state =
{
quote : bool;
comment : int;
paren : int;
square : int;
curly : int
}
let update_lexical_state oldstate s =
let quote = ref oldstate.quote in
let comment = ref oldstate.comment in
let paren = ref oldstate.paren in
let square = ref oldstate.square in
let curly = ref oldstate.curly in
let inc x = x := 1 + !x in
let dec x = x := !x - 1 in
let len = String.length s in
for i = 0 to len - 1 do
let more = i < (len - 1) in
let less = i > 0 in
match s.[i] with
'"' when !comment = 0 && not !quote -> quote := true
| '"' when !quote && ((not less) || (s.[i-1] <> '\\')) -> quote := false
| '(' when more && s.[i+1] = '*' && not !quote -> inc comment
| ')' when less && s.[i-1] = '*' && not !quote -> dec comment
| '(' when !comment = 0 && not !quote -> inc paren
| ')' when !comment = 0 && not !quote -> dec paren
| '[' when !comment = 0 && not !quote -> inc square
| ']' when !comment = 0 && not !quote -> dec square
| '{' when !comment = 0 && not !quote -> inc curly
| '}' when !comment = 0 && not !quote -> dec curly
| _ -> ()
done;
{ quote = !quote; comment = !comment; paren = !paren; square = !square; curly = !curly }
class line_reader chan =
object(self)
val mutable buf = None
val mutable line_num = 0
val mutable pre_lexical_state =
{
quote = false;
comment = 0;
paren = 0;
square = 0;
curly = 0
}
val mutable post_lexical_state =
{
quote = false;
comment = 0;
paren = 0;
square = 0;
curly = 0
}
method lexical_state () = pre_lexical_state
method line_number () = line_num
method peek () =
match buf with
Some line -> line
| None ->
let line = input_line chan in
let post_state = update_lexical_state post_lexical_state line in
pre_lexical_state <- post_lexical_state;
post_lexical_state <- post_state;
line_num <- 1 + line_num;
buf <- Some line;
line
method read () =
let line = self#peek () in
buf <- None;
line
method drop () =
ignore (self#read ())
end
(******************************************************************************
parsing
******************************************************************************)
type line_type =
| Identifier
| Paren
| Curly
| Square
| Quote
| NamedOperand
| OptionalOperand
| Let
| In
| And
| If
| Else
| Fun
| Match
| Function
| Pipe
| For
| While
| Try
| With
| Open
| Exception
| Type
| Val
| Module
| ModuleType
| Struct
| Sig
| Class
| Object
| Method
| Initializer
| Inherit
| Constraint
let line_res =
let keyword_res =
List.map
(fun (keyword,ty) -> (Str.regexp (keyword ^ "\\([ \t]+\\|$\\)"),ty))
[
("let",Let);
("in",In);
("and",And);
("if",If);
("else",Else);
("for",For);
("while",While);
("match",Match);
("function",Function);
("try",Try);
("with",With);
("open",Open);
("exception",Exception);
("fun",Fun);
("type",Type);
("val",Val);
("module[ \t]+type",ModuleType);
("module",Module);
("struct",Struct);
("sig",Sig);
("class",Class);
("object",Object);
("method",Method);
("initializer",Initializer);
("inherit",Inherit);
("constraint",Constraint)
]
in
keyword_res @
[
(Str.regexp "|.*",Pipe);
(Str.regexp "(.*",Paren);
(Str.regexp "{.*",Curly);
(Str.regexp "\\[.*",Square);
(Str.regexp "\".*",Quote);
(Str.regexp "'.*",Quote);
(Str.regexp "object(.*",Object);
(Str.regexp "~[a-zA-Z0-9'_]+:.*",NamedOperand);
(Str.regexp "\\?[a-zA-Z0-9'_]+:.*",OptionalOperand);
(Str.regexp "[a-zA-Z0-9!`#].*",Identifier)
]
let determine_line_type line =
let ic = indent_count line in
let rec iter = function
(re,ty) :: rest ->
if Str.string_match re line ic then
ty
else
iter rest
| [] -> invalid_arg "determine_line_type"
in
iter line_res
(* a helpful warning *)
let check_indentation line_num line =
let ic = indent_count line in
if ic > 0 then
let saw_space = ref false in
let saw_tab = ref false in
for i = 0 to ic - 1 do
if line.[i] = ' ' then saw_space := true;
if line.[i] = '\t' then saw_tab := true
done;
match config.whitespace_mode with
Tab_only when !saw_space ->
(Printf.eprintf "Error: line %d uses spaces for indentation; you asked for -tabonly\n" line_num;
exit 2)
| Space_only when !saw_tab ->
(Printf.eprintf "Error: line %d uses tabs for indentation; you asked for -spaceonly\n" line_num;
exit 2)
| Either when !saw_space && !saw_tab ->
Printf.eprintf "Warning: line %d uses mixed space and tab indentation.\n" line_num
| _ -> ()
(*
parse pass 1: read in the source code and transform it into a sequence of meaningful lines by:
- merge blank lines into the next meaningful line
- merge comment lines into the next meaningful line
- merge dangling curly-braced, square-bracketed, or parenthesized lines into
the previous meaningful line
- determine the type and indent-level of each meaningful line
*)
type syntax_pass1 = meaningful_line list
and meaningful_line = line_type * int * int * string (* line_type, indent_count, line_number, line_text *)
let parse_pass1 reader =
let rec dangling_lines () =
match try Some (reader#peek ()) with End_of_file -> None with
Some line ->
let lexstate = reader#lexical_state () in
if lexstate.quote || lexstate.comment > 0 || lexstate.square > 0 || lexstate.curly > 0 || lexstate.paren > 0 then
begin
reader#drop ();
endl ^ line ^ (dangling_lines ())
end
else
""
| None -> ""
in
let next_meaningful_line () =
let rec iter meaningless_lines =
let line = reader#read () in
let lexstate = reader#lexical_state () in
if lexstate.comment = 0 && not (is_blank line) then
let ty = try determine_line_type line with Invalid_argument _ -> Printf.eprintf "syntax error at line %d\n" (reader#line_number ()); exit 2 in
let ln = reader#line_number () in
let dangle = dangling_lines () in
check_indentation ln line;
(ty,indent_count line,ln,meaningless_lines ^ line ^ dangle)
else
iter (meaningless_lines ^ line ^ endl)
in
iter ""
in
let lines = ref [] in
begin
try
while true do
lines := (next_meaningful_line ()) :: !lines
done
with
End_of_file -> ()
end;
List.rev !lines
(* here's our extremely simple abstract syntax tree *)
type syntax = syntactic_unit list
and syntactic_unit =
Line of line_type*int*string (* line_type,line_number,line_text *)
| Block of syntax
| PipeBlock of syntax
(* parse pass 2: collect lines at the same indent-level into blocks and sub-blocks *)
let parse_pass2 lines =
let stream = Stream.of_list lines in
let rec level n =
match Stream.peek stream with
Some (ty,n',line_num,txt) when n = n' -> Stream.junk stream; (Line (ty,line_num,txt)) :: (level n)
| Some (ty,n',line_num,txt) when n < n' ->
let sublevel = level n' in
(Block sublevel) :: (level n)
| _ -> []
in
level 0
(* parse pass 3: (postprocessing) change Blocks with only pipe lines or sub-blocks (i.e. patterns) into PipeBlocks *)
let rec collect_pipe_blocks = function
(Block syntax) :: rest ->
let any_pipes = List.exists (function (Line (Pipe,_,_)) -> true | _ -> false) syntax in
let all_pipes = not (List.exists (function (Line (Pipe,_,_)) | (Block _) | (PipeBlock _) -> false | _ -> true) syntax) in
if any_pipes && all_pipes then
(PipeBlock (collect_pipe_blocks syntax)) :: (collect_pipe_blocks rest)
else
(Block (collect_pipe_blocks syntax)) :: (collect_pipe_blocks rest)
| fst :: rest -> fst :: (collect_pipe_blocks rest)
| [] -> []
(* aight *)
let parse reader =
let ml = parse_pass1 reader in
let syntax = parse_pass2 ml in
let postprocessed = collect_pipe_blocks syntax in
postprocessed
(******************************************************************************
syntax tree pretty-printing (mosty for debugging)
******************************************************************************)
let string_of_ty = function
Identifier -> "ID "
| Curly -> "Crl"
| Square -> "Sqr"
| Quote -> "Qut"
| Let -> "Let"
| In -> "In "
| And -> "And"
| If -> "If "
| Else -> "Els"
| For -> "For"
| While -> "Whl"
| Paren -> "Par"
| Pipe -> "Pip"
| Function -> "Fnc"
| Match -> "Mch"
| Try -> "Try"
| With -> "Wth"
| Open -> "Opn"
| Fun -> "Fun"
| Type -> "Typ"
| Module -> "Mod"
| ModuleType -> "MTy"
| Struct -> "Str"
| Sig -> "Sig"
| Val -> "Val"
| Class -> "Cls"
| Method -> "Mth"
| Object -> "Obj"
| Initializer -> "Ini"
| Inherit -> "Inh"
| NamedOperand -> "Nmd"
| OptionalOperand -> "Opt"
| Constraint -> "Cns"
| Exception -> "Exn"
;;
let rec print_block_syntax pfx level syntax =
List.iter
(function
Line (ty,_,line) -> Printf.eprintf "%c%d%s %s\n" pfx level (string_of_ty ty) line
| Block block -> print_block_syntax 'B' (level + 1) block
| PipeBlock block -> print_block_syntax 'P' (level + 1) block)
syntax;;
(******************************************************************************
OCaml syntax formation
******************************************************************************)
let rec nearest_line_number = function
(Line (_,num,_)) :: rest -> num
| (Block block) :: rest -> nearest_line_number block
| (PipeBlock block) :: rest -> nearest_line_number block
| [] -> 9999999
let rec form_expression form_rest = function
(* it would be preferable to use begin and end instead of parentheses in the first and fourth let clauses, but this breaks object constructors (class c = let name = value in object ... end) due to ocamlc bug^H^H^Hirregularities *)
(Line (Let,_,letline)) :: (Block block) :: rest ->
endl ^ letline ^ " (" ^ (form_sequence block) ^ " )" ^ (form_ands (form_ins form_rest) rest)
| (Line (Let,_,letline)) :: (PipeBlock block) :: rest ->
endl ^ letline ^ (form_patterns block) ^ (form_ands (form_ins form_rest) rest)
| (Line (Let,_,letline)) :: ((Line (In,_,_) :: _) as rest) ->
endl ^ letline ^ (form_ands (form_ins form_rest) rest)
| (Line (Let,_,letline)) :: ((Line (Let,_,_) :: _) as rest) ->
endl ^ letline ^ " (" ^ (form_sequence rest) ^ " )" ^ (form_rest [])
| (Line (If,_,ifline)) :: (Block block) :: rest ->
endl ^ ifline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_elses form_rest rest)
| (Line (loopty,_,loopline)) :: (Block block) :: rest when loopty = For || loopty = While ->
endl ^ loopline ^ (form_sequence block) ^ " done" ^ (form_rest rest)
| (Line (loopty,_,loopline)) :: rest when loopty = For || loopty = While ->
endl ^ loopline ^ " done" ^ (form_rest rest)
| (Line (Fun,_,line)) :: (Block block) :: rest -> " (" ^ endl ^ line ^ (form_sequence block) ^ " )" ^ (form_rest rest)
| (Line (Function,_,line)) :: (PipeBlock block) :: rest | (Line (Match,_,line)) :: (PipeBlock block) :: rest ->
endl ^ line ^ (form_patterns block) ^ (form_rest rest)
| (Line (Match,_,matchline)) :: (Block block) :: (Line (With,_,withline)) :: rest ->
endl ^ matchline ^ " begin" ^ (form_sequence block) ^ " end" ^ endl ^ withline ^
(match rest with
PipeBlock patterns :: rest ->
(form_patterns patterns) ^ (form_rest rest)
| _ -> form_rest rest)
| (Line (Try,_,tryline)) :: (Block block) :: (Line (With,_,withline)) :: rest ->
endl ^ tryline ^ " begin" ^ (form_sequence block) ^ " end" ^ endl ^ withline ^
(match rest with
PipeBlock patterns :: rest ->
(form_patterns patterns) ^ (form_rest rest)
| _ -> form_rest rest)
(* immediate objects *)
| (Line (Object,_,line)) :: (Block block) :: rest ->
endl ^ line ^ (form_object_contents block) ^ " end" ^ (form_rest rest)
| (Line (Object,_,line)) :: rest ->
endl ^ line ^ " end" ^ (form_rest rest)
(* local modules *)
| (Line (Struct,_,structline)) :: (Block block) :: rest ->
endl ^ structline ^ (form_module_sequence block) ^ " end" ^ (form_rest rest)
| (Line (Struct,_,structline)) :: rest ->
endl ^ structline ^ " end" ^ (form_rest rest)
| (Line (Sig,_,sigline)) :: (Block block) :: rest ->
endl ^ sigline ^ (form_module_type_contents block) ^ " end" ^ (form_rest rest)
| (Line (Sig,_,sigline)) :: rest ->
endl ^ sigline ^ " end" ^ (form_rest rest)
| (Line (_,_,line)) :: (PipeBlock block) :: rest -> endl ^ line ^ (form_patterns block) ^ (form_rest rest)
| (Line (Identifier,_,line)) :: (Block block) :: rest -> endl ^ line ^ (form_application_operands block) ^ (form_rest rest)
| (Line (Paren,_,line)) :: (Block block) :: rest -> endl ^ line ^ (form_application_operands block) ^ (form_rest rest)
| (Line (_,_,line)) :: (Block block) :: rest -> " (" ^ endl ^ line ^ " )" ^ (form_application_operands block) ^ (form_rest rest)
| (Line (_,_,line)) :: rest -> endl ^ line ^ (form_rest rest)
| (Block block) :: rest -> failwith (Printf.sprintf "unexpected block at line %d" (nearest_line_number block))
| (PipeBlock block) :: rest -> failwith (Printf.sprintf "unexpected pipeblock at line %d" (nearest_line_number block))
| [] -> ""
and form_ands form_rest = function
(Line (And,_,andline)) :: (Block block) :: rest ->
endl ^ andline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_ands form_rest rest)
| (Line (And,_,andline)) :: (PipeBlock block) :: rest ->
endl ^ andline ^ (form_patterns block) ^ (form_ands form_rest rest)
| (Line (And,_,andline)) :: rest ->
endl ^ andline ^ (form_ands form_rest rest)
| rest -> (form_rest rest)
and form_ins form_rest = function
(Line (In,_,inline)) :: (Block block) :: rest ->
endl ^ inline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_ins form_rest rest)
| (Line (In,_,inline)) :: ((Line (Let,_,_) :: _) as rest) ->
endl ^ inline ^ " begin" ^ (form_sequence rest) ^ " end" ^ (form_rest [])
| (Line (In,_,inline)) :: rest ->
endl ^ inline ^ (form_ins form_rest rest)
| rest -> form_rest rest
and form_elses form_rest = function
(Line (Else,_,elseline)) :: (Block block) :: rest ->
endl ^ elseline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_elses form_rest rest)
| (Line (Else,_,elseline)) :: rest ->
endl ^ elseline ^ (form_elses form_rest rest)
| rest -> form_rest rest
and form_naked_expressions syntax =
form_expression form_naked_expressions syntax
and form_sequence = function
[] -> ""
| syntax -> " (" ^ (form_expression (fun rest -> " )" ^ form_rest_sequence rest) syntax)
and form_rest_sequence = function
[] -> ""
| syntax -> "; (" ^ (form_expression (fun rest -> " )" ^ form_rest_sequence rest) syntax)
and form_application_operands = function
[] -> ""
| (Line (NamedOperand,_,line)) :: rest -> endl ^ line ^ (form_application_operands rest)
| (Line (OptionalOperand,_,line)) :: rest -> endl ^ line ^ (form_application_operands rest)
| syntax -> " (" ^ (form_expression (fun rest -> " )" ^ form_application_operands rest) syntax)
and form_patterns = function
(Line (Pipe,_,pipeline)) :: (Block block) :: rest ->
endl ^ pipeline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_patterns rest)
| (Line (Pipe,_,pipeline)) :: rest ->
endl ^ pipeline ^ (form_patterns rest)
| [] -> ""
| (Line (_,num,_)) :: rest -> failwith (Printf.sprintf "unexpected in pattern block at line %d; this shouldn't happen" num)
| ((Block block) :: rest) as x -> failwith (Printf.sprintf "unexpected block at line %d" (nearest_line_number x))
| ((PipeBlock block) :: rest) as x -> failwith (Printf.sprintf "unexpected pipeblock at line %d" (nearest_line_number x))
and form_object_contents = function
[] -> ""
| (Line (Val,_,line)) :: (Block block) :: rest ->
endl ^ line ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_object_contents rest)
| (Line (Val,_,line)) :: (PipeBlock block) :: rest ->
endl ^ line ^ (form_patterns block) ^ (form_object_contents rest)
| (Line (Val,_,line)) :: rest ->
endl ^ line ^ (form_object_contents rest)
| (Line (Method,_,line)) :: (Block block) :: rest ->
endl ^ line ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_object_contents rest)
| (Line (Method,_,line)) :: (PipeBlock block) :: rest ->
endl ^ line ^ (form_patterns block) ^ (form_object_contents rest)
| (Line (Method,_,line)) :: rest ->
endl ^ line ^ (form_object_contents rest)
| (Line (Initializer,_,line)) :: (Block block) :: rest ->
endl ^ line ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_object_contents rest)
| (Line (Initializer,_,line)) :: (PipeBlock block) :: rest ->
endl ^ line ^ (form_patterns block) ^ (form_object_contents rest)
| (Line (Initializer,_,line)) :: rest ->
endl ^ line ^ (form_object_contents rest)
| (Line (Inherit,_,line)) :: rest ->
endl ^ line ^ (form_object_contents rest)
| (Line (Constraint,_,line)) :: rest ->
endl ^ line ^ (form_object_contents rest)
| _ as lst -> failwith (Printf.sprintf "unexpected in object body at line %d" (nearest_line_number lst))
(* for recursive object types *)
and form_object_ands form_rest = function
| (Line (And,_,andline)) :: (Block ((Line (Let,_,_) :: _) as block)) :: rest
| (Line (And,_,andline)) :: (Block ((Line (Object,_,_) :: _) as block)) :: rest ->
endl ^ andline ^ (form_sequence block) ^ (form_object_ands form_rest rest)
| (Line (And,_,andline)) :: (Block block) :: rest ->
endl ^ andline ^ (form_object_contents block) ^ " end" ^ (form_object_ands form_rest rest)
| (Line (And,_,andline)) :: (Line (Object,_,structline)) :: (Block block) :: rest ->
endl ^ andline ^ endl ^ structline ^ (form_object_contents block) ^ " end" ^ (form_object_ands form_rest rest)
| (Line (And,_,line)) :: (Line (Object,_,structline)) :: rest ->
endl ^ line ^ endl ^ structline ^ " end" ^ (form_object_ands form_rest rest)
| (Line (And,_,andline)) :: rest ->
endl ^ andline ^ " end" ^ (form_object_ands form_rest rest)
| rest -> (form_rest rest)
and form_module_type_contents = function
[] -> ""
| (Line (Type,_,typeline)) :: (PipeBlock block) :: rest ->
endl ^ typeline ^ (form_patterns block) ^ (form_ands form_module_type_contents rest)
| (Line (Type,_,typeline)) :: rest ->
endl ^ typeline ^ (form_ands form_module_type_contents rest)
| (Line (Open,_,line)) :: rest ->
endl ^ line ^ (form_module_type_contents rest)
| (Line (Exception,_,line)) :: rest ->
endl ^ line ^ (form_module_type_contents rest)
| (Line (Val,_,line)) :: rest ->
endl ^ line ^ (form_module_type_contents rest)
| (Line (Module,_,line)) :: (Block ((Line (Sig,_,_) :: _) as block)) :: rest
| (Line (ModuleType,_,line)) :: (Block ((Line (Sig,_,_) :: _) as block)) :: rest ->
endl ^ line ^ (form_sequence block) ^ (form_module_type_contents rest)
| (Line (Module,_,line)) :: (Block block) :: rest
| (Line (ModuleType,_,line)) :: (Block block) :: rest ->
endl ^ line ^ (form_module_type_contents block) ^ " end" ^ (form_module_type_contents rest)
| (Line (Module,_,line)) :: (Line (Sig,_,sigline)) :: (Block block) :: rest
| (Line (ModuleType,_,line)) :: (Line (Sig,_,sigline)) :: (Block block) :: rest ->
endl ^ line ^ endl ^ sigline ^ (form_module_type_contents block) ^ " end" ^ (form_module_type_contents rest)
| (Line (Module,_,line)) :: rest
| (Line (ModuleType,_,line)) :: rest ->
endl ^ line (* ^ " end" *) ^ (form_module_type_contents rest) (* had to disable the end to allow: module Make (Q : IntervalType) : S with type t = Q.t *)
| (Line (Class,_,line)) :: (Block ((Line (Object,_,_) :: _) as block)) :: rest ->
endl ^ line ^ (form_naked_expressions block) ^ " " ^ (form_object_ands form_module_type_contents rest) (* the form_naked_expressions is a hack because (object ... end) with parentheses is inexplicably a syntax error *)
| (Line (Class,_,line)) :: (Block block) :: rest ->
endl ^ line ^ (form_object_contents block) ^ " end" ^ (form_object_ands form_module_type_contents rest)
| (Line (Class,_,line)) :: (Line (Object,_,structline)) :: (Block block) :: rest ->
endl ^ line ^ endl ^ structline ^ (form_object_contents block) ^ " end" ^ (form_object_ands form_module_type_contents rest)
| (Line (Class,_,line)) :: (Line (Object,_,structline)) :: rest ->
endl ^ line ^ endl ^ structline ^ " end" ^ (form_object_ands form_module_type_contents rest)
| (Line (Class,_,line)) :: rest ->
endl ^ line ^ " end" ^ (form_object_ands form_module_type_contents rest)
| _ as lst -> failwith (Printf.sprintf "unexpected in module type at line %d" (nearest_line_number lst))
and form_module_contents form_rest = function
[] -> ""
| (Line (Type,_,typeline)) :: (PipeBlock block) :: rest ->
endl ^ typeline ^ (form_patterns block) ^ (form_ands form_rest rest)
| (Line (Type,_,typeline)) :: rest ->
endl ^ typeline ^ (form_ands form_rest rest)
| (Line (Open,_,line)) :: rest ->
endl ^ line ^ (form_rest rest)
| (Line (Exception,_,line)) :: rest ->
endl ^ line ^ (form_rest rest)
| (Line (ModuleType,_,line)) :: (Block ((Line (Sig,_,_) :: _) as block)) :: rest ->
endl ^ line ^ (form_sequence block) ^ (form_rest rest)
| (Line (ModuleType,_,line)) :: (Block block) :: rest ->
endl ^ line ^ (form_module_type_contents block) ^ " end" ^ (form_rest rest)
| (Line (ModuleType,_,line)) :: (Line (Sig,_,sigline)) :: (Block block) :: rest ->
endl ^ line ^ endl ^ sigline ^ (form_module_type_contents block) ^ " end" ^ (form_rest rest)
| (Line (ModuleType,_,line)) :: rest ->
endl ^ line ^ " end" ^ (form_rest rest)
| (Line (Module,_,line)) :: (Block ((Line (Struct,_,_) :: _) as block)) :: rest ->
endl ^ line ^ (form_sequence block) ^ (form_rest rest)
| (Line (Module,_,line)) :: (Block block) :: rest ->
endl ^ line ^ (form_module_sequence block) ^ " end" ^ (form_rest rest)
| (Line (Module,_,line)) :: (Line (Struct,_,structline)) :: (Block block) :: rest ->
endl ^ line ^ endl ^ structline ^ (form_module_sequence block) ^ " end" ^ (form_rest rest)
(* to allow module N = MyFunctor(M) *)
| (Line (Module,_,line)) :: rest ->
endl ^ line ^ (form_rest rest)
(*
class c =
let name = value in
object
...
*)
| (Line (Class,_,line)) :: (Block ((Line (Let,_,_) :: _) as block)) :: rest
(*
class c =
object
...
*)
| (Line (Class,_,line)) :: (Block ((Line (Object,_,_) :: _) as block)) :: rest ->
endl ^ line ^ (form_sequence block) ^ " " ^ (form_object_ands form_rest rest)
(*
class c = object
...
*)
| (Line (Class,_,line)) :: (Block block) :: rest ->
endl ^ line ^ (form_object_contents block) ^ " end" ^ (form_object_ands form_rest rest)
(*
class c =
object
...
*)
| (Line (Class,_,line)) :: (Line (Object,_,structline)) :: (Block block) :: rest ->
endl ^ line ^ endl ^ structline ^ (form_object_contents block) ^ " end" ^ (form_object_ands form_rest rest)
(* probably an unnecessary clause:
class c =
object ...
*)
| (Line (Class,_,line)) :: (Line (Object,_,structline)) :: rest ->
endl ^ line ^ endl ^ structline ^ " end" ^ (form_object_ands form_rest rest)
(* class c = object ... *)
| (Line (Class,_,line)) :: rest ->
endl ^ line ^ " end" ^ (form_object_ands form_rest rest)
(* this clause disables the multi-let at the top level, but it's the only way for us to disambiguate let-in from the global let *)
| (Line (Let,_,letline)) :: ((Line (Let,_,_) :: _) as rest) ->
endl ^ letline ^ (form_rest rest)
| syntax -> (form_expression form_rest syntax)
and form_module_sequence = function
[] -> ""
| syntax -> (form_module_contents form_rest_module_sequence syntax)
and form_rest_module_sequence = function
[] -> ""
| syntax -> " ;;" ^ (form_module_contents form_rest_module_sequence syntax)
(******************************************************************************
main
******************************************************************************)
;;
type srctype =
ML
| MLI
let ty = ref None
let showblocks = ref false
let arg_spec =
Arg.align
[
("-spaceonly",Arg.Unit (fun () -> config.whitespace_mode <- Space_only)," only allow spaces for indentation (default either spaces or tabs allowed and counted equally)");
("-tabonly",Arg.Unit (fun () -> config.whitespace_mode <- Tab_only)," only allow tabs for indentation");
("-ml",Arg.Unit (fun () -> ty := Some ML)," consider the input an implementation (.ml) file, regardless of its extension");
("-mli",Arg.Unit (fun () -> ty := Some MLI)," consider the input an interface (.mli) file, regardless of its extension");
("-showblocks",Arg.Set(showblocks)," (for debugging) print the source code's block structure to standard error")
];;
let usage_msg =
"Usage: ocaml+twt [options] source.ml\n" ^
" normally the preprocessor should be invoked through ocamlc, e.g.\n" ^
" ocamlc -pp ocaml+twt source.ml\n" ^
" to invoke the preprocessor with options through ocamlc, quote the command, e.g.\n" ^
" ocamlc -pp \"ocaml+twt -spaceonly\" source.ml\n" ^
" options:"
let input_fname = ref "";;
Arg.parse arg_spec (fun s -> input_fname := s) usage_msg;;
let input_fname = !input_fname;;
let showblocks = !showblocks;;
if input_fname = "" then
(Arg.usage arg_spec usage_msg;
exit 2);;
let ty =
match !ty with
Some x -> x
| None ->
if Filename.check_suffix input_fname ".ml" || Filename.check_suffix input_fname ".ml+twt" then
ML
else if Filename.check_suffix input_fname ".mli" || Filename.check_suffix input_fname ".mli+twt" then
MLI
else
(Printf.eprintf "don't know what to do with %s\n" Sys.argv.(1);
exit 2);;
let chan = open_in input_fname
let reader = new line_reader chan;;
let syntax = parse reader;;
if showblocks then
(print_block_syntax 'T' 0 syntax;
flush_all ())
let printer =
match ty with
ML -> form_module_sequence
| MLI -> form_module_type_contents
;;
Printf.printf "#1 \"%s\"\n" input_fname;;
print_string ( Str.replace_first (Str.regexp "\n") "" (printer syntax) );;
[-- Attachment #1.3: ocaml+twt.vim --]
[-- Type: text/plain, Size: 327 bytes --]
:%s/" *\(begin\|end\|(\|)\|;;\) *"/" \1"/g
:%s/\^ *"\\n"/\^ endl/g
:%s/ *\^ *endl / /g
:400,$s/^\([ \t]*\)\([a-z]*line .*\)/\1endl \^ \2/g
:400,$s/-> *\([a-z]*line .*\)/-> endl \^ \1/g
:400,$s/\([^l ] *\^ *\)\([a-z]*line \)/\1endl \^ \2/g
:%s/(printer syntax)/( Str.replace_first (Str.regexp "\\n") "" (printer syntax) )/g
:wq
[-- Attachment #2: Type: application/pgp-signature, Size: 189 bytes --]
^ permalink raw reply [flat|nested] 3+ messages in thread