From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Original-To: caml-list@yquem.inria.fr Delivered-To: caml-list@yquem.inria.fr Received: from concorde.inria.fr (concorde.inria.fr [192.93.2.39]) by yquem.inria.fr (Postfix) with ESMTP id 55964BC29 for ; Sat, 5 Aug 2006 01:10:44 +0200 (CEST) Received: from efil.de (efil.de [81.3.25.37]) by concorde.inria.fr (8.13.6/8.13.6) with ESMTP id k74NAh7G004455 for ; Sat, 5 Aug 2006 01:10:43 +0200 Received: by efil.de (Postfix, from userid 1000) id DD024105291E; Sat, 5 Aug 2006 01:10:30 +0200 (CEST) Date: Sat, 5 Aug 2006 01:09:44 +0200 From: Ingo Bormuth To: mikelin@mit.edu, caml-list@yquem.inria.fr Subject: Re: ocaml+twt 0.85 Message-ID: <20060804230943.GA25593@kruemel> Reply-To: Ingo Bormuth References: <2a1a1a0c0607241639x7272d1aeoc88ddec8912f9715@mail.gmail.com> Mime-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha1; protocol="application/pgp-signature"; boundary="rJwd6BRFiFCcLxzm" Content-Disposition: inline In-Reply-To: <2a1a1a0c0607241639x7272d1aeoc88ddec8912f9715@mail.gmail.com> X-Attribution: Ingo Bormuth X-Url: http://ibormuth.efil.de/contact User-Agent: Mutt/1.5.11 X-Miltered: at concorde with ID 44D3D3F3.000 by Joe's j-chkmail (http://j-chkmail.ensmp.fr)! X-Spam: no; 0.00; ocaml:01 ocaml:01 compiler:01 debugging:01 syntax:01 vim:01 'ocaml:01 syntax:01 endl:01 endl:01 regexp:01 cheers:01 mikelin:01 mutable:01 config:01 X-Attachments: name="ocaml+twt.ml" name="ocaml+twt.vim" type="application/pgp-signature" X-Spam-Checker-Version: SpamAssassin 3.0.3 (2005-04-27) on yquem.inria.fr X-Spam-Level: X-Spam-Status: No, score=0.0 required=5.0 tests=none autolearn=disabled version=3.0.3 --rJwd6BRFiFCcLxzm Content-Type: multipart/mixed; boundary="WIyZ46R2i8wDzkSu" Content-Disposition: inline --WIyZ46R2i8wDzkSu Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-Transfer-Encoding: quoted-printable 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=20 debugging quite a pain. Find attached a version which will put all the 'begins', 'ends'=20 and parentheses at the end of the lines which also makes the=20 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).=20 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 syn= tax) )/g Cheers Ingo --=20 Ingo Bormuth, voicebox & telefax: +49-12125-10226517 '(~o-o~)' public key 86326EC9, http://ibormuth.efil.de/contact --ooO--(.)--Ooo-- --WIyZ46R2i8wDzkSu Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="ocaml+twt.ml" Content-Transfer-Encoding: quoted-printable (* 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 rathe= r than parenthesization to group expressions. *) type whitespace_mode =3D Either | Tab_only | Space_only type configuration =3D { mutable whitespace_mode : whitespace_mode } let config =3D { whitespace_mode =3D Either } let endl =3D "\n" (**************************************************************************= **** stupid amateurish lexing stuff ***************************************************************************= ***) let whitespace_chars =3D [ ' '; '\t' ] let comment_line_re =3D Str.regexp "[ \t]*(\\*.*" let indent_count line =3D let i =3D ref 0 in let l =3D String.length line in while !i < l && List.mem line.[!i] whitespace_chars do i :=3D !i + 1 done; !i let is_blank line =3D (indent_count line) =3D (String.length line) || (Str.string_match comment= _line_re line 0)=20 type lexical_state =3D { quote : bool; comment : int; paren : int; square : int; curly : int } let update_lexical_state oldstate s =3D let quote =3D ref oldstate.quote in let comment =3D ref oldstate.comment in let paren =3D ref oldstate.paren in let square =3D ref oldstate.square in let curly =3D ref oldstate.curly in let inc x =3D x :=3D 1 + !x in let dec x =3D x :=3D !x - 1 in let len =3D String.length s in for i =3D 0 to len - 1 do let more =3D i < (len - 1) in let less =3D i > 0 in match s.[i] with '"' when !comment =3D 0 && not !quote -> quote :=3D true | '"' when !quote && ((not less) || (s.[i-1] <> '\\')) -> quote :=3D fal= se | '(' when more && s.[i+1] =3D '*' && not !quote -> inc comment | ')' when less && s.[i-1] =3D '*' && not !quote -> dec comment | '(' when !comment =3D 0 && not !quote -> inc paren | ')' when !comment =3D 0 && not !quote -> dec paren | '[' when !comment =3D 0 && not !quote -> inc square | ']' when !comment =3D 0 && not !quote -> dec square | '{' when !comment =3D 0 && not !quote -> inc curly | '}' when !comment =3D 0 && not !quote -> dec curly | _ -> () done; { quote =3D !quote; comment =3D !comment; paren =3D !paren; square =3D = !square; curly =3D !curly } class line_reader chan =3D object(self) val mutable buf =3D None val mutable line_num =3D 0 val mutable pre_lexical_state =3D { quote =3D false; comment =3D 0; paren =3D 0; square =3D 0; curly =3D 0 } val mutable post_lexical_state =3D { quote =3D false; comment =3D 0; paren =3D 0; square =3D 0; curly =3D 0 } method lexical_state () =3D pre_lexical_state method line_number () =3D line_num method peek () =3D match buf with Some line -> line | None -> let line =3D input_line chan in let post_state =3D 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 () =3D let line =3D self#peek () in buf <- None; line method drop () =3D ignore (self#read ()) end (**************************************************************************= **** parsing ***************************************************************************= ***) type line_type =3D | 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 =3D let keyword_res =3D 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 =3D let ic =3D indent_count line in let rec iter =3D 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 =3D let ic =3D indent_count line in if ic > 0 then let saw_space =3D ref false in let saw_tab =3D ref false in for i =3D 0 to ic - 1 do if line.[i] =3D ' ' then saw_space :=3D true; if line.[i] =3D '\t' then saw_tab :=3D true done; match config.whitespace_mode with Tab_only when !saw_space -> (Printf.eprintf "Error: line %d uses spaces for indentation; you ask= ed 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 indentatio= n.\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 =3D meaningful_line list and meaningful_line =3D line_type * int * int * string (* line_type, indent= _count, line_number, line_text *) =20 let parse_pass1 reader =3D let rec dangling_lines () =3D match try Some (reader#peek ()) with End_of_file -> None with Some line -> let lexstate =3D reader#lexical_state () in if lexstate.quote || lexstate.comment > 0 || lexstate.square > 0 || le= xstate.curly > 0 || lexstate.paren > 0 then begin reader#drop (); endl ^ line ^ (dangling_lines ()) end else "" | None -> "" in let next_meaningful_line () =3D let rec iter meaningless_lines =3D let line =3D reader#read () in let lexstate =3D reader#lexical_state () in if lexstate.comment =3D 0 && not (is_blank line) then let ty =3D try determine_line_type line with Invalid_argument _ -> Print= f.eprintf "syntax error at line %d\n" (reader#line_number ()); exit 2 in let ln =3D reader#line_number () in let dangle =3D dangling_lines () in check_indentation ln line; (ty,indent_count line,ln,meaningless_lines ^ line ^ dangle) else=20 iter (meaningless_lines ^ line ^ endl) in iter "" in let lines =3D ref [] in begin try while true do=20 lines :=3D (next_meaningful_line ()) :: !lines done with End_of_file -> () end; List.rev !lines (* here's our extremely simple abstract syntax tree *) type syntax =3D syntactic_unit list and syntactic_unit =3D 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 =3D let stream =3D Stream.of_list lines in let rec level n =3D match Stream.peek stream with Some (ty,n',line_num,txt) when n =3D n' -> Stream.junk stream; (Line (ty,l= ine_num,txt)) :: (level n) | Some (ty,n',line_num,txt) when n < n' -> let sublevel =3D 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 =3D function (Block syntax) :: rest -> let any_pipes =3D List.exists (function (Line (Pipe,_,_)) -> true | _= -> false) syntax in let all_pipes =3D not (List.exists (function (Line (Pipe,_,_)) | (Blo= ck _) | (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 =3D=20 let ml =3D parse_pass1 reader in let syntax =3D parse_pass2 ml in let postprocessed =3D collect_pipe_blocks syntax in postprocessed (**************************************************************************= **** syntax tree pretty-printing (mosty for debugging) ***************************************************************************= ***) let string_of_ty =3D 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 =3D List.iter (function Line (ty,_,line) -> Printf.eprintf "%c%d%s %s\n" pfx level (string_of_ty t= y) 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 =3D 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 =3D function (* it would be preferable to use begin and end instead of parentheses i= n the first and fourth let clauses, but this breaks object constructors (cl= ass c =3D let name =3D value in object ... end) due to ocamlc bug^H^H^Hirre= gularities *) (Line (Let,_,letline)) :: (Block block) :: rest -> endl ^ letline ^ " (" ^ (form_sequence block) ^ " )" ^ (form_ands (fo= rm_ins form_rest) rest) | (Line (Let,_,letline)) :: (PipeBlock block) :: rest -> endl ^ letline ^ (form_patterns block) ^ (form_ands (form_ins form_re= st) 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_els= es form_rest rest) | (Line (loopty,_,loopline)) :: (Block block) :: rest when loopty =3D For= || loopty =3D While -> endl ^ loopline ^ (form_sequence block) ^ " done" ^ (form_rest rest) | (Line (loopty,_,loopline)) :: rest when loopty =3D For || loopty =3D Wh= ile -> endl ^ loopline ^ " done" ^ (form_rest rest) | (Line (Fun,_,line)) :: (Block block) :: rest -> " (" ^ endl ^ line ^ (f= orm_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 ^ w= ithline ^ (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_res= t 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_r= est rest) | (Line (Sig,_,sigline)) :: rest -> endl ^ sigline ^ " end" ^ (form_rest rest) | (Line (_,_,line)) :: (PipeBlock block) :: rest -> endl ^ line ^ (form_p= atterns block) ^ (form_rest rest) | (Line (Identifier,_,line)) :: (Block block) :: rest -> endl ^ line ^ (f= orm_application_operands block) ^ (form_rest rest) | (Line (Paren,_,line)) :: (Block block) :: rest -> endl ^ line ^ (form_a= pplication_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 pipeb= lock at line %d" (nearest_line_number block)) | [] -> "" and form_ands form_rest =3D function (Line (And,_,andline)) :: (Block block) :: rest -> endl ^ andline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_an= ds 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 =3D 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 =3D function (Line (Else,_,elseline)) :: (Block block) :: rest -> endl ^ elseline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_e= lses form_rest rest) | (Line (Else,_,elseline)) :: rest -> endl ^ elseline ^ (form_elses form_rest rest) | rest -> form_rest rest and form_naked_expressions syntax =3D form_expression form_naked_expressions syntax and form_sequence =3D function [] -> "" | syntax -> " (" ^ (form_expression (fun rest -> " )" ^ form_rest_sequenc= e rest) syntax) and form_rest_sequence =3D function [] -> "" | syntax -> "; (" ^ (form_expression (fun rest -> " )" ^ form_rest_sequen= ce rest) syntax) and form_application_operands =3D function [] -> "" | (Line (NamedOperand,_,line)) :: rest -> endl ^ line ^ (form_application= _operands rest) | (Line (OptionalOperand,_,line)) :: rest -> endl ^ line ^ (form_applicat= ion_operands rest) | syntax -> " (" ^ (form_expression (fun rest -> " )" ^ form_application_= operands rest) syntax) and form_patterns =3D function (Line (Pipe,_,pipeline)) :: (Block block) :: rest -> endl ^ pipeline ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_p= atterns rest) | (Line (Pipe,_,pipeline)) :: rest -> endl ^ pipeline ^ (form_patterns rest) | [] -> "" | (Line (_,num,_)) :: rest -> failwith (Printf.sprintf "unexpected in pat= tern block at line %d; this shouldn't happen" num) | ((Block block) :: rest) as x -> failwith (Printf.sprintf "unexpected bl= ock at line %d" (nearest_line_number x)) | ((PipeBlock block) :: rest) as x -> failwith (Printf.sprintf "unexpecte= d pipeblock at line %d" (nearest_line_number x)) and form_object_contents =3D function [] -> "" | (Line (Val,_,line)) :: (Block block) :: rest -> endl ^ line ^ " begin" ^ (form_sequence block) ^ " end" ^ (form_objec= t_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_objec= t_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_objec= t_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) =20 | _ 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 =3D function | (Line (And,_,andline)) :: (Block ((Line (Let,_,_) :: _) as block)) :: r= est | (Line (And,_,andline)) :: (Block ((Line (Object,_,_) :: _) as block)) := : rest -> endl ^ andline ^ (form_sequence block) ^ (form_object_ands form_rest res= t) | (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_res= t rest) | (Line (And,_,andline)) :: rest -> endl ^ andline ^ " end" ^ (form_object_ands form_rest rest) | rest -> (form_rest rest) and form_module_type_contents =3D 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)) :: r= est | (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_modu= le_type_contents rest) | (Line (Module,_,line)) :: (Line (Sig,_,sigline)) :: (Block block) :: re= st | (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= =3D Q.t *) | (Line (Class,_,line)) :: (Block ((Line (Object,_,_) :: _) as block)) ::= rest -> endl ^ line ^ (form_naked_expressions block) ^ " " ^ (form_object_and= s form_module_type_contents rest) (* the form_naked_expressions is a hack b= ecause (object ... end) with parentheses is inexplicably a syntax error *) | (Line (Class,_,line)) :: (Block block) :: rest -> endl ^ line ^ (form_object_contents block) ^ " end" ^ (form_object_an= ds form_module_type_contents rest) | (Line (Class,_,line)) :: (Line (Object,_,structline)) :: (Block block) = :: rest -> endl ^ line ^ endl ^ structline ^ (form_object_contents block) ^ " en= d" ^ (form_object_ands form_module_type_contents rest) | (Line (Class,_,line)) :: (Line (Object,_,structline)) :: rest -> endl ^ line ^ endl ^ structline ^ " end" ^ (form_object_ands form_mod= ule_type_contents rest) | (Line (Class,_,line)) :: rest -> endl ^ line ^ " end" ^ (form_object_ands form_module_type_contents re= st) | _ as lst -> failwith (Printf.sprintf "unexpected in module type at line= %d" (nearest_line_number lst)) and form_module_contents form_rest =3D 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) ^ " en= d" ^ (form_rest rest) (* to allow module N =3D MyFunctor(M) *) | (Line (Module,_,line)) :: rest -> endl ^ line ^ (form_rest rest) (* class c =3D let name =3D value in object ... *) | (Line (Class,_,line)) :: (Block ((Line (Let,_,_) :: _) as block)) :: re= st (* class c =3D object ... *) | (Line (Class,_,line)) :: (Block ((Line (Object,_,_) :: _) as block)) ::= rest -> endl ^ line ^ (form_sequence block) ^ " " ^ (form_object_ands form_re= st rest) (* class c =3D object ... *) | (Line (Class,_,line)) :: (Block block) :: rest -> endl ^ line ^ (form_object_contents block) ^ " end" ^ (form_object_an= ds form_rest rest) (* class c =3D object ... *) | (Line (Class,_,line)) :: (Line (Object,_,structline)) :: (Block block) = :: rest -> endl ^ line ^ endl ^ structline ^ (form_object_contents block) ^ " en= d" ^ (form_object_ands form_rest rest) (* probably an unnecessary clause: class c =3D object ... *) | (Line (Class,_,line)) :: (Line (Object,_,structline)) :: rest -> endl ^ line ^ endl ^ structline ^ " end" ^ (form_object_ands form_res= t rest) (* class c =3D 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 w= ay 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 =3D function [] -> "" | syntax -> (form_module_contents form_rest_module_sequence syntax) and form_rest_module_sequence =3D function [] -> "" | syntax -> " ;;" ^ (form_module_contents form_rest_module_sequence synta= x) (**************************************************************************= **** main ***************************************************************************= ***) ;; type srctype =3D ML | MLI let ty =3D ref None let showblocks =3D ref false let arg_spec =3D Arg.align [ ("-spaceonly",Arg.Unit (fun () -> config.whitespace_mode <- Space_onl= y)," only allow spaces for indentation (default either spaces or tabs allow= ed and counted equally)"); ("-tabonly",Arg.Unit (fun () -> config.whitespace_mode <- Tab_only),"= only allow tabs for indentation"); ("-ml",Arg.Unit (fun () -> ty :=3D Some ML)," consider the input an i= mplementation (.ml) file, regardless of its extension"); ("-mli",Arg.Unit (fun () -> ty :=3D 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 =3D "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 com= mand, e.g.\n" ^ " ocamlc -pp \"ocaml+twt -spaceonly\" source.ml\n" ^ " options:" let input_fname =3D ref "";; Arg.parse arg_spec (fun s -> input_fname :=3D s) usage_msg;; let input_fname =3D !input_fname;; let showblocks =3D !showblocks;; if input_fname =3D "" then (Arg.usage arg_spec usage_msg; exit 2);; let ty =3D 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 =3D open_in input_fname let reader =3D new line_reader chan;; let syntax =3D parse reader;; if showblocks then (print_block_syntax 'T' 0 syntax; flush_all ()) let printer =3D 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) );; --WIyZ46R2i8wDzkSu Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="ocaml+twt.vim" :%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 --WIyZ46R2i8wDzkSu-- --rJwd6BRFiFCcLxzm Content-Type: application/pgp-signature Content-Disposition: inline -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.5 (GNU/Linux) iD8DBQFE09O3NzWqdIYybskRArMiAJ96R4ZTG+aNZg8EAAgDW21o/iL1TQCePQY4 /IXMWBbaSpYRItupetTcKgM= =Gvhd -----END PGP SIGNATURE----- --rJwd6BRFiFCcLxzm--