1. camlspotter
  2. cmigrep-fork

Commits

camlspotter  committed 3ee386d

original version 1.5

  • Participants
  • Parent commits e7e1a6f
  • Branches default

Comments (0)

Files changed (7)

File COPYING

View file
  • Ignore whitespace
+Copyright (C) 2004 Eric Stokes
+
+This library is free software; you can redistribute it and/or               
+modify it under the terms of the GNU General Public                  
+License as published by the Free Software Foundation; either                
+version 2.1 of the License, or (at your option) any later version.          
+   
+This library is distributed in the hope that it will be useful,             
+but WITHOUT ANY WARRANTY; without even the implied warranty of              
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU           
+Lesser General Public License for more details.                             
+   
+You should have received a copy of the GNU General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+USA

File Changes

View file
  • Ignore whitespace
+1.5
+* ignore (but warn about) missing findlib packages
+* minor refactoring
+
+1.4
+* support module aliasing with let module, and module =
+* started making a cmigrep library, but not done yet
+
+1.3
+* bug fixes
+
+1.2 
+* add support for specifying a list of open modules
+* fix some regexp bugs in the module expression parser

File GPL

View file
  • Ignore whitespace
+		    GNU GENERAL PUBLIC LICENSE
+		       Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+			    Preamble
+
+  The licenses for most software are designed to take away your
+freedom to share and change it.  By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users.  This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it.  (Some other Free Software Foundation software is covered by
+the GNU Lesser General Public License instead.)  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+  To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have.  You must make sure that they, too, receive or can get the
+source code.  And you must show them these terms so they know their
+rights.
+
+  We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+  Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software.  If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+  Finally, any free program is threatened constantly by software
+patents.  We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary.  To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+		    GNU GENERAL PUBLIC LICENSE
+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+  0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License.  The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language.  (Hereinafter, translation is included without limitation in
+the term "modification".)  Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope.  The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+  1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+  2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+    a) You must cause the modified files to carry prominent notices
+    stating that you changed the files and the date of any change.
+
+    b) You must cause any work that you distribute or publish, that in
+    whole or in part contains or is derived from the Program or any
+    part thereof, to be licensed as a whole at no charge to all third
+    parties under the terms of this License.
+
+    c) If the modified program normally reads commands interactively
+    when run, you must cause it, when started running for such
+    interactive use in the most ordinary way, to print or display an
+    announcement including an appropriate copyright notice and a
+    notice that there is no warranty (or else, saying that you provide
+    a warranty) and that users may redistribute the program under
+    these conditions, and telling the user how to view a copy of this
+    License.  (Exception: if the Program itself is interactive but
+    does not normally print such an announcement, your work based on
+    the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole.  If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works.  But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+  3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+    a) Accompany it with the complete corresponding machine-readable
+    source code, which must be distributed under the terms of Sections
+    1 and 2 above on a medium customarily used for software interchange; or,
+
+    b) Accompany it with a written offer, valid for at least three
+    years, to give any third party, for a charge no more than your
+    cost of physically performing source distribution, a complete
+    machine-readable copy of the corresponding source code, to be
+    distributed under the terms of Sections 1 and 2 above on a medium
+    customarily used for software interchange; or,
+
+    c) Accompany it with the information you received as to the offer
+    to distribute corresponding source code.  (This alternative is
+    allowed only for noncommercial distribution and only if you
+    received the program in object code or executable form with such
+    an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it.  For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable.  However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+  4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+  5. You are not required to accept this License, since you have not
+signed it.  However, nothing else grants you permission to modify or
+distribute the Program or its derivative works.  These actions are
+prohibited by law if you do not accept this License.  Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+  6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions.  You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+  7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all.  For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices.  Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+  8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded.  In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+  9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number.  If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation.  If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+  10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission.  For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this.  Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+			    NO WARRANTY
+
+  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+		     END OF TERMS AND CONDITIONS
+
+	    How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License along
+    with this program; if not, write to the Free Software Foundation, Inc.,
+    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+    Gnomovision version 69, Copyright (C) year name of author
+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  Here is a sample; alter the names:
+
+  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+  `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+  <signature of Ty Coon>, 1 April 1989
+  Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs.  If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.

File Makefile

View file
  • Ignore whitespace
+SOURCES=misc.cmx tbl.cmx config.cmx clflags.cmx terminfo.cmx ccomp.cmx	\
+warnings.cmx consistbl.cmx linenum.cmx location.cmx longident.cmx	\
+syntaxerr.cmx parser.cmx lexer.cmx parse.cmx printast.cmx		\
+unused_var.cmx ident.cmx path.cmx primitive.cmx types.cmx btype.cmx	\
+oprint.cmx subst.cmx predef.cmx datarepr.cmx env.cmx typedtree.cmx	\
+ctype.cmx printtyp.cmx includeclass.cmx mtype.cmx includecore.cmx	\
+includemod.cmx parmatch.cmx typetexp.cmx stypes.cmx typecore.cmx	\
+typedecl.cmx typeclass.cmx typemod.cmx cmigrep.ml
+
+BYTESOURCES=misc.cmo tbl.cmo config.cmo clflags.cmo terminfo.cmo	\
+ccomp.cmo warnings.cmo consistbl.cmo linenum.cmo location.cmo		\
+longident.cmo syntaxerr.cmo parser.cmo lexer.cmo parse.cmo		\
+printast.cmo unused_var.cmo ident.cmo path.cmo primitive.cmo types.cmo	\
+btype.cmo oprint.cmo subst.cmo predef.cmo datarepr.cmo env.cmo		\
+typedtree.cmo ctype.cmo printtyp.cmo includeclass.cmo mtype.cmo		\
+includecore.cmo includemod.cmo parmatch.cmo typetexp.cmo stypes.cmo	\
+typecore.cmo typedecl.cmo typeclass.cmo typemod.cmo cmigrep.ml
+
+
+GODI_CONF=$(shell godi_confdir)
+GODI_BASE=$(shell cat $(GODI_CONF)/godi.conf | grep ^LOCALBASE | sed -e 's/LOCALBASE *= *//')
+GODI_LIB=$(GODI_BASE)/lib/ocaml/compiler-lib
+
+all:
+	ocamlfind ocamlopt -o cmigrep -I $(GODI_LIB) \
+	-package pcre,findlib,unix -linkpkg $(SOURCES)
+
+byte:
+	ocamlfind ocamlc -o cmigrep -I $(GODI_LIB) \
+	-package pcre,findlib,unix -linkpkg $(BYTESOURCES)
+
+install:
+	cp cmigrep $(GODI_BASE)/bin
+
+clean:
+	@rm -f *.o *.cmo *.cmi *.cma *.cmx *.cmi cmigrep

File README

View file
  • Ignore whitespace
+GODI Recomended
+
+To build, type make.
+
+If it doesn't work, you probably aren't using godi.  You'll have to
+edit the make file to tell it where your compiler sources are, as well
+as possibly rewrite the very simple build rule to not use findlib.
+
+A short description of features,
+
+cmigrep: <args> <module-expr> 
+
+cmigrep has two modes, the first and most common is that of searching
+for various types of objects inside a module. Objects that you can
+search for include
+
+switch         purpose
+-t             (regexp) print types with matching names
+-r             (regexp) print record field labels with matching names
+-c             (regexp) print constructors with matching names
+-p             (regexp) print polymorphic variants with matching names
+-e             (regexp) print exceptions with matching constructors
+-v             (regexp) print values with matching names
+-o             (regexp) print all classes with matching names
+-a             (regexp) print all names which match the given expression
+
+These are all very useful for finding specific things inside a given
+module. Here are a few examples,
+
+find some constructors in the unix module
+
+itsg106:~ eric$ cmigrep -c SO_ Unix 
+SO_DEBUG (* socket_bool_option *)
+SO_BROADCAST (* socket_bool_option *)
+SO_REUSEADDR (* socket_bool_option *)
+SO_KEEPALIVE (* socket_bool_option *)
+SO_DONTROUTE (* socket_bool_option *)
+SO_OOBINLINE (* socket_bool_option *)
+SO_ACCEPTCONN (* socket_bool_option *)
+SO_SNDBUF (* socket_int_option *)
+SO_RCVBUF (* socket_int_option *)
+SO_ERROR (* socket_int_option *)
+SO_TYPE (* socket_int_option *)
+SO_RCVLOWAT (* socket_int_option *)
+SO_SNDLOWAT (* socket_int_option *)
+SO_LINGER (* socket_optint_option *)
+SO_RCVTIMEO (* socket_float_option *)
+SO_SNDTIMEO (* socket_float_option *)
+
+find the same constructors, but this time anywhere
+
+itsg106:~/cmigrep-1.1 eric$ ./cmigrep -c SO_ \*
+SO_DEBUG (* UnixLabels.socket_bool_option *)
+SO_BROADCAST (* UnixLabels.socket_bool_option *)
+SO_REUSEADDR (* UnixLabels.socket_bool_option *)
+SO_KEEPALIVE (* UnixLabels.socket_bool_option *)
+SO_DONTROUTE (* UnixLabels.socket_bool_option *)
+SO_OOBINLINE (* UnixLabels.socket_bool_option *)
+SO_ACCEPTCONN (* UnixLabels.socket_bool_option *)
+SO_SNDBUF (* UnixLabels.socket_int_option *)
+SO_RCVBUF (* UnixLabels.socket_int_option *)
+SO_ERROR (* UnixLabels.socket_int_option *)
+SO_TYPE (* UnixLabels.socket_int_option *)
+SO_RCVLOWAT (* UnixLabels.socket_int_option *)
+SO_SNDLOWAT (* UnixLabels.socket_int_option *)
+SO_LINGER (* UnixLabels.socket_optint_option *)
+SO_RCVTIMEO (* UnixLabels.socket_float_option *)
+SO_SNDTIMEO (* UnixLabels.socket_float_option *)
+SO_DEBUG (* Unix.socket_bool_option *)
+SO_BROADCAST (* Unix.socket_bool_option *)
+SO_REUSEADDR (* Unix.socket_bool_option *)
+SO_KEEPALIVE (* Unix.socket_bool_option *)
+SO_DONTROUTE (* Unix.socket_bool_option *)
+SO_OOBINLINE (* Unix.socket_bool_option *)
+SO_ACCEPTCONN (* Unix.socket_bool_option *)
+SO_SNDBUF (* Unix.socket_int_option *)
+SO_RCVBUF (* Unix.socket_int_option *)
+SO_ERROR (* Unix.socket_int_option *)
+SO_TYPE (* Unix.socket_int_option *)
+SO_RCVLOWAT (* Unix.socket_int_option *)
+SO_SNDLOWAT (* Unix.socket_int_option *)
+SO_LINGER (* Unix.socket_optint_option *)
+SO_RCVTIMEO (* Unix.socket_float_option *)
+SO_SNDTIMEO (* Unix.socket_float_option *)
+
+It seems they only exist in the unix module. By default cmigrep
+searches the current directory, and the standard library. You can of
+course tell it to search elsewhere.
+
+full types get printed in the case that the constructors have
+arguments. Notice that adding to the include path is modeled after the
+compiler. Findlib is also supported.
+
+itsg106:~ eric$ cmigrep -c "^Tsig_.*" -I /opt/godi/lib/ocaml/compiler-lib Types
+Tsig_value of Ident.t * value_description (* signature_item *)
+Tsig_type of Ident.t * type_declaration * rec_status (* signature_item *)
+Tsig_exception of Ident.t * exception_declaration (* signature_item *)
+Tsig_module of Ident.t * module_type * rec_status (* signature_item *)
+Tsig_modtype of Ident.t * modtype_declaration (* signature_item *)
+Tsig_class of Ident.t * class_declaration * rec_status (* signature_item *)
+Tsig_cltype of Ident.t * cltype_declaration * rec_status (* signature_item *)
+
+record field labels
+itsg106:~ eric$ cmigrep -r "^st_" Unix
+st_dev: int (* stats *)
+st_ino: int (* stats *)
+st_kind: file_kind (* stats *)
+st_perm: file_perm (* stats *)
+st_nlink: int (* stats *)
+st_uid: int (* stats *)
+st_gid: int (* stats *)
+st_rdev: int (* stats *)
+st_size: int (* stats *)
+st_atime: float (* stats *)
+st_mtime: float (* stats *)
+st_ctime: float (* stats *)
+
+findlib support, matching value names
+itsg106:~ eric$ cmigrep -package pcre -v for Pcre
+val foreach_line : ?ic:in_channel -> (string -> unit) -> unit 
+val foreach_file : string list -> (string -> in_channel -> unit) -> unit 
+
+nested modules
+itsg106:~ eric$ cmigrep -v ".*" Unix.LargeFile
+val lseek : file_descr -> int64 -> seek_command -> int64 
+val truncate : string -> int64 -> unit 
+val ftruncate : file_descr -> int64 -> unit 
+val stat : string -> stats 
+val lstat : string -> stats 
+val fstat : file_descr -> stats 
+
+types
+itsg106:~ eric$ cmigrep -t ".*" Unix.LargeFile
+type stats = {
+  st_dev : int;
+  st_ino : int;
+  st_kind : file_kind;
+  st_perm : file_perm;
+  st_nlink : int;
+  st_uid : int;
+  st_gid : int;
+  st_rdev : int;
+  st_size : int64;
+  st_atime : float;
+  st_mtime : float;
+  st_ctime : float;
+}
+
+everything!
+itsg106:~ eric$ cmigrep -a ".*" Unix.LargeFile
+val lseek : file_descr -> int64 -> seek_command -> int64
+val truncate : string -> int64 -> unit
+val ftruncate : file_descr -> int64 -> unit
+type stats = {
+  st_dev : int;
+  st_ino : int;
+  st_kind : file_kind;
+  st_perm : file_perm;
+  st_nlink : int;
+  st_uid : int;
+  st_gid : int;
+  st_rdev : int;
+  st_size : int64;
+  st_atime : float;
+  st_mtime : float;
+  st_ctime : float;
+}
+val stat : string -> stats
+val lstat : string -> stats
+val fstat : file_descr -> stats
+
+exception declarations
+itsg106:~/cmigrep eric$ ./cmigrep -e ".*" Unix
+exception Unix_error of error * string * string
+
+toplevel modules starting with Net
+
+itsg106:~/cmigrep-1.1 eric$ ./cmigrep -m -package netstring Net*
+Neturl
+Netulex
+Netstring_top
+Netstring_str
+Netstring_pcre
+Netstring_mt
+Netstream
+Netsendmail
+Netmime
+Netmappings_other
+Netmappings_min
+Netmappings_jp
+Netmappings_iso
+Netmappings
+Nethttp
+Nethtml_scanner
+Nethtml
+Netencoding
+Netdb
+Netdate
+Netconversion
+Netchannels
+Netbuffer
+Netaux
+Netaddress
+Netaccel_link
+Netaccel
+
+sub modules one level deep of modules starting with Net
+
+itsg106:~/cmigrep-1.1 eric$ ./cmigrep -m -package netstring Net*.*
+Netulex.ULB
+Netulex.Ulexing
+Nethttp.Header
+Netencoding.Base64
+Netencoding.QuotedPrintable
+Netencoding.Q
+Netencoding.Url
+Netencoding.Html
+Netaux.KMP
+Netaux.ArrayAux
+

File cmigrep.el

View file
  • Ignore whitespace
+; pop up the tooltip under the text
+; partially complete as much as possible
+
+(if (string-match "XEmacs" emacs-version)
+    (defun replace-regexp-in-string (regexp newtext string)
+      (replace-in-string string regexp newtext)))
+
+(unless (fboundp 'looking-back)         ; Exists in Emacs 22
+  (defun looking-back (regexp &optional limit greedy) ; Copied from Emacs 22
+    "Return non-nil if text before point matches regular expression
+     REGEXP.  Like `looking-at' except matches before point, and is slower.
+     LIMIT if non-nil speeds up the search by specifying a minimum starting
+     position, to avoid checking matches that would start before LIMIT.
+
+     If GREEDY is non-nil, extend the match backwards as far as possible,
+     stopping when a single additional previous character cannot be part
+     of a match for REGEXP."
+    (let ((start (point))
+          (pos
+           (save-excursion
+             (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
+                  (point)))))
+      (if (and greedy pos)
+          (save-restriction
+            (narrow-to-region (point-min) start)
+            (while (and (> pos (point-min))
+                        (save-excursion
+                          (goto-char pos)
+                          (backward-char 1)
+                          (looking-at (concat "\\(?:"  regexp "\\)\\'"))))
+              (setq pos (1- pos)))
+            (save-excursion
+              (goto-char pos)
+              (looking-at (concat "\\(?:"  regexp "\\)\\'")))))
+      (not (null pos)))))
+
+(unless (fboundp 'tooltip-show)
+  (defun tooltip-show (tip)
+    (print tip)))
+
+(unless (fboundp 'line-number-at-pos)   ; Exists in Emacs 22.
+  (defun line-number-at-pos (&optional pos)
+    "Buffer line number at position POS. Current line number if POS is nil.
+     Counting starts at (point-min), so any narrowing restriction applies."
+    (1+ (count-lines (point-min) (save-excursion (when pos (goto-char pos))
+                                                 (forward-line 0) (point))))))
+
+(defun fold (f x li)
+  "Recursively applies (f x i) where i is the ith element in the list li.
+   For example, (fold f x '(1 2)) returns (f (f x 1) 2)"
+  (let ((li2 li) (ele) (x2 x))
+    (while (setq ele (pop li2))
+      (setq x2 (funcall f x2 ele)))
+    x2))
+
+(defun filter (g li)
+  (fold (lambda (acc x) 
+          (if (funcall g x) 
+              (cons x acc) 
+            acc)) 
+        nil li))
+
+(defun caml-format-packages (packages)
+  (mapconcat 'identity packages ","))
+
+;(caml-format-packages '("pcre" "netstring" "ocamldap"))
+
+(defun caml-format-paths (paths)
+  (fold '(lambda (acc p) (cons "-I" (cons p acc))) 
+        () 
+        paths))
+
+;(caml-format-paths '("/home/eric" "/opt/godi/lib/ocaml/pkg-lib/pcre" "foo"))
+
+; state and configuration variables
+(defvar caml-completion-buf "*caml-cmigrep*")
+(defvar caml-packages nil)
+(defvar caml-includes nil)
+(defvar caml-default-dir nil)
+(defvar caml-always-show-completions-buf t)
+(make-variable-buffer-local 'caml-default-dir)
+(set-default 'caml-default-dir nil)
+
+(defconst search-type-value "-v")
+(defconst search-type-record-label "-r")
+(defconst search-type-module "-m")
+(defconst search-type-constructor "-c")
+(defconst search-type-variant "-p")
+
+(defun caml-clear-completion-buf ()
+  (save-excursion
+    (set-buffer caml-completion-buf)
+    (delete-region (point-min) (point-max))))
+
+(defun strip-props (s)
+  (set-text-properties 0 (length s) nil s)
+  s)
+
+(defun open-modules ()
+  "parse the file to determine the list of modules open, 
+   and return the list unqualified"
+  (save-excursion
+    (save-match-data
+      (goto-char (point-min))
+      (let ((modules ""))
+        (while (re-search-forward "open +\\([A-Z][a-zA-Z0-9'._]*\\)" nil t)
+          (if (equal modules "")
+              (setq modules (strip-props (match-string 1)))
+              (setq modules (concat modules "," (strip-props (match-string 1))))))
+        modules))))
+
+(defun caml-search (search-type value &rest module-exps)
+  "search for a value starting with [value] in [module-exp], 
+   in the directories specified by [packages] and [includes]
+   and with the current working directory of cmigrep set to [dir].
+   placing the results in the *caml-cmigrep* buffer"
+  (let ((process-connection-type nil) ; Use a pipe for communication
+	(default-directory (if caml-default-dir
+			       caml-default-dir
+			     default-directory)) ; Set CWD of cmigrep to dir
+        (args (if value
+                  (append (list search-type value) module-exps)
+                (cons search-type module-exps)))
+        (open (open-modules)))
+    (and caml-packages
+        (let ((packages (caml-format-packages caml-packages)))
+          (push packages args)
+          (push "-package" args)))
+    (and caml-includes
+        (let ((includes (caml-format-paths caml-includes)))
+          (setq args (append includes args))))
+    (and (not (equal open ""))
+         (progn
+           (push open args)
+           (push "-open" args)))
+    (and (get-buffer caml-completion-buf)
+        (caml-clear-completion-buf))
+    (apply 'call-process 
+           (append (list "cmigrep" nil caml-completion-buf nil) args))))
+
+(defun condense-spaces (s)
+  "condense long strings of white space into a single space"
+  (replace-regexp-in-string "[[:space:]]+" " " s))
+
+(defun strip (s)
+  (replace-regexp-in-string 
+   "[[:space:]]+$" ""
+   (replace-regexp-in-string "^[[:space:]]+" "" s)))
+
+(defun extract-value-name ()
+  (save-match-data
+    (if (re-search-forward "[a-z]")
+        (let ((start (progn (backward-char)
+                            (point))))
+          (if (re-search-forward ":")
+              (progn 
+                (backward-char)
+                (strip (buffer-substring start (point)))))))))
+
+(defun extract-value-type ()
+  (interactive)
+  (save-match-data
+    (let ((start (point)))
+      (if (re-search-forward "=\\|(\\*" (point-at-eol) t)
+          (progn 
+            (backward-char 2)
+            (strip (buffer-substring start (point))))
+        (progn
+          (goto-char (point-at-eol))
+          (strip (buffer-substring start (point))))))))
+
+(defun extract-value-module ()
+  (save-match-data
+    (let ((start (point)))
+      (if (search-forward "(*" (point-at-eol) t)
+          (if (re-search-forward "[[:space:]]*\\([A-Za-z0-9_'.]*\\)" (point-at-eol) t)
+              (match-string 1)
+            (error "invalid module comment"))
+        nil))))
+
+(defun caml-parse-value-completion ()
+  (save-match-data
+    (if (re-search-forward "val\\|external")
+        (let* ((value-name (extract-value-name))
+               (value-type (extract-value-type))
+               (value-module (extract-value-module)))
+          (if value-module
+              (list value-name 
+                    (condense-spaces (concat value-type " from " value-module)))
+            (list value-name value-type)))
+      (error "invalid value completion"))))
+
+(defun caml-extract-value-completion (line)  
+  (set-buffer caml-completion-buf)
+  (goto-line line) ; goto the line that our completion is on
+  (beginning-of-line) ; goto the beginning
+  (caml-parse-value-completion))
+
+(defun caml-extract-module-completion (line)
+  (save-match-data
+    (set-buffer caml-completion-buf)
+    (goto-line line)
+    (beginning-of-line)
+    (if (looking-at "\\([A-Z][a-zA-Z0-9._']*\\)")
+        (match-string 1)
+      (error "cannot read completion"))))
+
+(defun caml-parse-record-label ()
+  (or (search-forward "mutable" (point-at-eol) t) ; skip the "mutable" keyword
+      (goto-char (point-at-bol)))
+  (let* ((field-name (extract-value-name))
+         (field-type (extract-value-type))
+         (field-module (extract-value-module)))
+    (if field-module
+        (list field-name
+              (condense-spaces (concat field-type " from " field-module)))
+      (list field-name field-type))))
+  
+(defun caml-extract-record-label (line)
+  (set-buffer caml-completion-buf)
+  (goto-line line)
+  (beginning-of-line)
+  (caml-parse-record-label))
+
+(defun extract-constructor-name ()
+  (save-match-data
+    (let ((start (point)))
+      (if (search-forward " of " (point-at-eol) t)
+          (progn 
+            (backward-char 4)
+            (strip (buffer-substring start (point))))
+        (progn
+          (goto-char (point-at-bol))
+          (if (search-forward "(*" (point-at-eol) t)
+              (progn
+                (backward-char 2)
+                (strip (buffer-substring start (point))))
+            (progn
+              (goto-char (point-at-eol))
+              (strip (buffer-substring start (point))))))))))
+
+(defun caml-extract-constructor-completion (line)
+  (set-buffer caml-completion-buf)
+  (goto-line line)
+  (beginning-of-line)
+  (let* ((constructor-name (extract-constructor-name))
+         (constructor-type (extract-value-type))
+         (constructor-module (extract-value-module))
+         (hint constructor-type))
+    (and constructor-module
+         (setq hint (concat hint " from " constructor-module)))
+    (list constructor-name hint)))
+
+;  (caml-extract-value-completion 1)
+
+(defun caml-extract-completions (completion-parser)
+  (save-match-data
+    (save-excursion
+      (set-buffer caml-completion-buf)
+      (goto-char (point-min))
+      (let ((beg (line-number-at-pos (point-min)))
+            (end (line-number-at-pos (point-max)))
+            completions)
+        (while (> end (line-number-at-pos (point)))
+          (let ((completion (funcall completion-parser (line-number-at-pos (point)))))
+            (setq completions (cons completion completions))
+            (forward-line)))
+        completions))))
+
+(defun caml-format-value-match (value)
+  (if value
+      (concat "^" value ".*")
+    ".*"))
+
+(defun caml-format-module-exp (module-match)
+  (if module-match
+      (substring module-match 0 (- (length module-match) 1))
+    (error "no module matched")))
+
+; (caml-format-module-exp "Unix.LargeFile.")
+
+(defun strip-colon (type)
+  "given a type expression in the form ': foo -> bar', this
+   function will strip the ':', just a small cosmetic thing. It
+   actually just strips any colon and following white space"
+  (save-match-data
+    (if (string-match ":[[:space:]]*" type)
+        (replace-match "" nil nil type nil)
+      type)))
+
+; (strip-colon-from-type ": foo -> bar")  
+
+(defun caml-show-completions (completions)
+  (with-output-to-temp-buffer "*Completions*"
+    (display-completion-list completions)
+    0))
+
+(defun caml-show-unique-completion (completion)
+  (if caml-always-show-completions-buf
+      (caml-show-completions (list completion))
+    (tooltip-show completion)))
+
+(defun caml-perform-completion (unformatted-value completions)
+  (save-match-data
+    (if completions
+        (if (> (length completions) 1)
+            (caml-show-completions completions)
+          (let* ((completion (car completions))
+                 (value-name (if (listp completion)
+                                 (car completion)
+                               completion))
+                 (value-type (if (listp completion)
+                                 (car (cdr completion))
+                               nil)))
+            (if unformatted-value
+                (let* ((beg (length unformatted-value))
+                       (end (length value-name))
+                       (value-substr (substring value-name beg end)))
+                  (insert value-substr)
+                  (if value-type 
+                      (caml-show-unique-completion (strip-colon value-type)))
+                  (length value-substr))
+              (progn
+                (insert value-name)
+                (if value-type
+                    (caml-show-unique-completion (strip-colon value-type)))
+                (length value-name))))))))
+
+(defun deref-module (x)
+  (let* ((local (concat "let +module +" x " *= *\\([A-Z][A-Za-z_'0-9.]*\\) +in"))
+         (global (concat "module +" x " *= *\\([A-Z][A-Za-z_'0-9.]*\\)")))
+    (cond ((re-search-backward local nil t)
+           (deref-module-exp (match-string 1)))
+          ((re-search-backward global nil t)
+           (deref-module-exp (match-string 1)))
+          (t x))))
+
+(defun deref-module-exp (x)
+  (mapconcat 'deref-module (split-string x "\\.") "."))
+
+(defun caml-cmigrep-complete-qualified (parser search-type)
+  (let* ((module-name (match-string 1))
+         (unformatted-value (match-string 2))
+         (value (caml-format-value-match unformatted-value))
+         (module-exp (save-excursion
+                       (save-match-data
+                         (deref-module-exp (caml-format-module-exp module-name))))))
+    (if (caml-search search-type value module-exp)
+        (let ((completions (caml-extract-completions parser)))
+          (caml-perform-completion unformatted-value completions))
+      (error "cmigrep failed"))))
+
+(defun caml-cmigrep-complete-unqualified (parser search-type)
+  (let* ((unformatted-value (match-string 1))
+         (value (caml-format-value-match unformatted-value)))
+    (if (caml-search search-type value)
+        (caml-perform-completion unformatted-value (caml-extract-completions parser))
+      (error "cmigrep failed"))))
+
+(defconst qualified-record-field-lookup
+  "[^a-zA-Z_'][a-z_][a-zA-Z0-9_']*\\.\\(\\(?:[A-Z][A-Za-z_'0-9]*\\.\\)+\\)\\([a-z_][a-zA-Z0-9_']*\\)?")
+(defconst qualified-value 
+  "[^a-zA-Z_'.]\\([A-Z][A-Za-z_'0-9.]*\\.\\)\\([a-z_][A-Za-z0-9_']*\\)?")
+(defconst qualified-constructor
+  "[^a-zA-Z_'.]\\(\\(?:[A-Z][A-Za-z_'0-9]*\\.\\)+\\)\\([A-Z][A-Za-z_'0-9]*\\)")
+(defconst unqualified-record-field-lookup 
+  "[^a-zA-Z_'][a-z][A-Za-z0-9_']*\\.\\([a-z][A-Za-z0-9_']*\\)?")
+(defconst unqualified-value "^[^a-zA-Z_']\\([a-z][A-Za-z0-9_']*\\)")
+(defconst qualified-partial-module
+  "[^a-zA-Z_']\\(\\(?:[A-Z][A-Za-z_'0-9]*\\.\\)+\\)\\([A-Z][A-Za-z_'0-9]*\\)?")
+(defconst unqualified-partial-module "[^a-zA-Z_']\\([A-Z][A-Za-z_'0-9]*\\)")
+
+(defun caml-cmigrep-complete ()
+  "complete OCaml based on context"
+  (interactive)
+  (let ((case-fold-search nil) ; make searches case sensitive. I HATE DYNAMIC SCOPE!
+        chars-added)
+    (save-excursion
+      (save-match-data
+        (or caml-default-dir
+	    (and (buffer-file-name)
+		(setq caml-default-dir (file-name-directory (buffer-file-name)))))
+        (setq chars-added
+              (cond ((looking-back qualified-record-field-lookup (point-at-bol))
+                     (caml-cmigrep-complete-qualified 'caml-extract-record-label 
+                                                      search-type-record-label))
+                    ((looking-back qualified-value (point-at-bol))
+                     (caml-cmigrep-complete-qualified 'caml-extract-value-completion 
+                                                      search-type-value))
+                    ((looking-back unqualified-record-field-lookup (point-at-bol))
+                     (caml-cmigrep-complete-unqualified 'caml-extract-record-label 
+                                                        search-type-record-label))
+                    ((looking-back unqualified-value (point-at-bol))
+                     (caml-cmigrep-complete-unqualified 'caml-extract-value-completion
+                                                        search-type-value))
+                    ((looking-back qualified-constructor (point-at-bol))
+                     (caml-cmigrep-complete-qualified 'caml-extract-constructor-completion
+                                                      search-type-constructor))
+                    (t (error "requested completion not implemented (yet)"))))))
+    (if chars-added
+        (forward-char chars-added))))
+
+(defun not-empty-string (s)
+  (if (equal s "")
+      nil
+    s))
+                  
+(defun caml-complete-module ()
+  (let* (unformatted-value
+         (module-exp
+          (cond ((looking-back qualified-partial-module (point-at-bol))
+                 (let ((containing-module (not-empty-string (match-string 1)))
+                       (partial-module (match-string 2)))
+                   (setq unformatted-value partial-module)
+                   (list 
+                    (concat 
+                     (caml-format-module-exp containing-module)
+                     "." partial-module "*"))))
+                ((looking-back unqualified-partial-module (point-at-bol))
+                 (let* ((partial-module (match-string 1))
+                        (partial-module-exp (concat partial-module "*")))
+                   (setq unformatted-value partial-module)
+                   (list partial-module-exp)))
+                (t (list "*")))))
+    (if (apply 'caml-search
+               (cons search-type-module module-exp))
+        (let ((completions (caml-extract-completions 'caml-extract-module-completion)))
+          (caml-perform-completion unformatted-value completions))
+      (error "cmigrep failed"))))
+
+(defun caml-cmigrep-complete-module ()
+  "complete the partial module name before the point"
+  (interactive)
+  (let ((case-fold-search nil) ; make searches case sensitive. I HATE DYNAMIC SCOPE!
+        chars-added)
+    (save-excursion
+      (save-match-data
+        (or caml-default-dir
+            (setq caml-default-dir (file-name-directory (buffer-file-name))))
+        (setq chars-added (caml-complete-module))))
+    (if chars-added
+        (forward-char chars-added))))

File cmigrep.ml

View file
  • Ignore whitespace
+(* A utility to gather information from caml compiled interface files
+
+   Copyright (C) 2007 Eric Stokes
+
+   This library is free software; you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation; either version 2.1 of
+   the License, or (at your option) any later version.
+   
+   This library is distributed in the hope that it will be useful,             
+   but WITHOUT ANY WARRANTY; without even the implied warranty of              
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU           
+   Lesser General Public License for more details.                             
+   
+   You should have received a copy of the GNU General Public License
+   along with this library; if not, write to the Free Software
+   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+   USA
+*)
+
+open Types
+
+exception Break
+
+module Pathset = Set.Make(struct
+  type t = string
+  let trailing_slash = Pcre.regexp "/\\s*$|\\\\\\s*$"
+  let compare p1 p2 = 
+    let p1' = Pcre.replace ~rex:trailing_slash ~templ:"" p1 in
+    let p2' = Pcre.replace ~rex:trailing_slash ~templ:"" p2 in
+    String.compare p1' p2'
+end)
+
+(* the standard library should not be so deficient *)
+module List = struct
+  include List
+
+  let filter_map f l = 
+    List.fold_left
+      (fun acc item -> 
+         match f item with
+         | Some x -> x :: acc
+         | None -> acc)
+      []
+      l
+
+  let find_map f l = 
+    let res = ref None in
+    try
+      List.iter
+        (fun x -> 
+           match f x with
+           | None -> ()
+           | Some y -> res := Some y; raise Break)
+        l;
+      raise Not_found
+    with Break -> 
+      begin match !res with
+      | Some y -> y
+      | None -> raise Break
+      end
+
+  let map f l = 
+    let r = rev_map f l in
+    rev r
+end
+
+module Unix = struct
+  include Unix
+
+  let fold_path ~f ~init path = 
+    let dir = Unix.opendir path in
+    let acc = ref init in
+    try
+      while true do
+        let file = Unix.readdir dir in
+        acc := f file !acc
+      done;
+      !acc
+    with 
+    | End_of_file -> Unix.closedir dir; !acc
+    | exn -> Unix.closedir dir; raise exn
+end
+
+module Match = struct
+  let comma = Pcre.regexp "\\s*,\\s*"
+end
+
+module Module_expression = struct
+  type t = 
+  | Exact of string
+  | Begins_with of string * Pcre.regexp
+  | Ends_with of string * Pcre.regexp
+  | Begins_and_ends of string * Pcre.regexp
+  | Contains of string * Pcre.regexp
+  | Any
+
+  let to_string = function
+    | Exact m -> m
+    | Begins_with (s, _) 
+    | Ends_with (s, _)
+    | Begins_and_ends (s, _)
+    | Contains (s, _) -> s
+    | Any -> "*"
+
+  (* ModA,ModB,Foo*.Make *)
+  let parse = 
+    let dot = Pcre.regexp "\\." in
+    let capname = Pcre.regexp "^[A-Z][A-Za-z_'0-9]*$" in
+    let starend = Pcre.regexp "^[A-Z][A-Za-z0-9_']*\\*$" in
+    let starbegin = Pcre.regexp "^\\*[A-Za-z0-9_']+$" in
+    let starboth = Pcre.regexp "^\\*[A-Za-z0-9_']+\\*$" in
+    let starmiddle = Pcre.regexp "^([A-Z][A-Za-z0-9_']*)\\*([A-Za-z0-9_']+)$" in
+    let star = Pcre.regexp "\\*" in
+    fun exp ->
+      List.map
+        (fun token ->
+          let token_no_star = Pcre.replace ~rex:star ~templ:"" token in
+          if token = "*" then
+            Any
+          else if Pcre.pmatch ~rex:capname token then
+            Exact token
+          else if Pcre.pmatch ~rex:starboth token then
+            Contains (token, Pcre.regexp ("^.*" ^ token_no_star ^ ".*$"))
+          else if Pcre.pmatch ~rex:starmiddle token then
+            begin match Pcre.extract ~rex:starmiddle token with
+            | [|_whole; begins; ends |] -> 
+                let rex = Pcre.regexp (Printf.sprintf "^%s.*%s$" begins ends) in
+                Begins_and_ends (token, rex)
+            | _ -> failwith "invalid begins and ends with match"
+            end
+          else if Pcre.pmatch ~rex:starbegin token then
+            Ends_with (token, Pcre.regexp (Printf.sprintf "%s$" token_no_star))
+          else if Pcre.pmatch ~rex:starend token then
+            Begins_with (token, Pcre.regexp (Printf.sprintf "^%s" token_no_star))
+          else
+            failwith "invalid module expression")
+        (Pcre.split ~rex:dot exp)
+
+  let is_exact t = 
+    List.for_all 
+      (function 
+        | Exact _ -> true 
+        | Begins_with _
+        | Ends_with _
+        | Begins_and_ends _
+        | Contains _
+        | Any -> false)
+      t
+
+  let parse_exact exp = 
+    let t = parse exp in
+    if is_exact t then
+      t
+    else
+      failwith "Module_expression.parse_exact: expression is not exact!"
+end
+
+type mode = 
+  | Find_type of Pcre.regexp
+  | Find_constructor of Pcre.regexp
+  | Find_polymorphic_variant of Pcre.regexp
+  | Find_record_label of Pcre.regexp
+  | Find_value of Pcre.regexp
+  | Find_exception of Pcre.regexp
+  | Find_module
+  | Find_class of Pcre.regexp
+  | Find_all of Pcre.regexp
+
+type module_tree = 
+  | Leaf of string * signature
+  | Node of string * signature * module_tree list
+
+type args = {
+  mode: mode;
+  path: Pathset.t;
+  context: Module_expression.t list list; (* open modules *)
+  modname: Module_expression.t list list;
+}
+
+let parse_args () =
+  let module Parse = struct
+    open Arg
+    let mode = ref None
+    let path = ref (Pathset.add "." (Pathset.singleton Config.standard_library))
+    let context = ref ["Pervasives"]
+    let modname = ref []
+
+    let set_mode m =
+      match !mode with
+      | None -> mode := Some m;
+      | Some _ -> raise (Invalid_argument "the mode is already set")
+
+    let add_packages p = 
+      Findlib.init ();
+      let packages = Pcre.split ~rex:Match.comma p in
+      List.iter 
+        (fun package ->
+          try
+            let dir = Findlib.package_directory package in
+            path := Pathset.add dir !path
+          with exn -> 
+            Printf.eprintf "warning, error finding package dir: %s\n" (Printexc.to_string exn))
+        packages
+
+    let add_opens s = context := Pcre.split ~rex:Match.comma s
+
+    let args = 
+      Arg.align
+        [("-t", String (fun s -> set_mode (Find_type (Pcre.regexp s))),
+          "      (regexp) print types with matching names");
+         ("-r", String (fun s -> set_mode (Find_record_label (Pcre.regexp s))),
+          "      (regexp) print record field labels with matching names");
+         ("-c", String (fun s -> set_mode (Find_constructor (Pcre.regexp s))), 
+          "      (regexp) print constructors with matching names");
+         ("-p", String (fun s -> 
+                         set_mode 
+                           (Find_polymorphic_variant 
+                             (Pcre.regexp s))),
+          "      (regexp) print polymorphic variants with matching names");
+         ("-m", Unit (fun () -> set_mode Find_module),
+          "      (regexp) print all matching module names in the path");
+         ("-v", String (fun s -> set_mode (Find_value (Pcre.regexp s))), 
+          "      (regexp) print values with matching names");
+         ("-e", String (fun s -> set_mode (Find_exception (Pcre.regexp s))), 
+          "      (regexp) print exceptions with matching constructors");
+         ("-o", String (fun s -> set_mode (Find_class (Pcre.regexp s))),
+          "      (regexp) print all classes with matching names");
+         ("-a", String (fun s -> set_mode (Find_all (Pcre.regexp s))),
+          "      (regexp) print all names which match the given expression");
+         ("-I", String (fun s -> path := Pathset.add s !path), 
+          "      (directory) add additional directory to the search path");
+         ("-package", String (fun s -> add_packages s),
+          "      (packages) comma seperated list of findlib packages to search");
+         ("-open", String (fun s -> add_opens s), 
+          "      (modules) comma seperated list of open modules (in order!)")]
+    let usage = 
+      Printf.sprintf
+        ("%s: <args> <module-expr> \n" ^^
+           "extract information from caml compiled interface files\n" ^^
+           " <module-expr> can be an exact module name, " ^^
+           " or a shell wildcard. Multiple modules can be specified " ^^
+           "E.G. \"ModA ModB Foo*.Make\" means to search ModA, ModB, and " ^^
+           "any submodule Make of a module that starts with Foo.")
+        Sys.argv.(0)
+
+    let parse () = 
+      Arg.parse args
+        (fun anon -> modname := (Module_expression.parse anon) :: !modname)
+        usage
+
+    let error msg = 
+      prerr_endline msg;
+      Arg.usage args usage;
+      exit 1
+  end
+  in
+  Parse.parse ();
+  let mode = 
+    match !Parse.mode with
+    | Some m -> m
+    | None -> Parse.error "you must specify a search mode"
+  in
+  {mode = mode;
+   path = 
+      if Pathset.is_empty !Parse.path then Parse.error "you must specify a search path"
+      else !Parse.path;
+   context = 
+      List.map
+        Module_expression.parse_exact
+        !Parse.context;
+   modname = 
+      (match !Parse.modname with
+       | [] -> 
+           if !Parse.context = [] then
+             Parse.error "you must specify a module expression, or a list of open modules"
+           else 
+             []
+       | name -> name)}
+
+let match_ident exp id = Pcre.pmatch ~rex:exp (Ident.name id)
+
+let whsp = Pcre.regexp ~study:true "\\s+|$"
+
+let print_type print_path path s exp =
+  List.iter
+    (function 
+       | Tsig_type (id, type_decl, rec_status) ->
+           if match_ident exp id then begin
+             Printtyp.type_declaration id Format.std_formatter type_decl;
+             if print_path then
+               Format.print_string (Printf.sprintf " (* %s *)" path);
+             Format.print_newline ()
+           end
+       | _ -> ())
+    s
+
+let print_constructor print_path path s exp =
+  let type_expr_to_string exp = 
+    Printtyp.type_expr Format.str_formatter exp;
+    Format.flush_str_formatter ();
+  in
+  List.iter
+    (function
+       | Tsig_type (id, type_decl, _rec_status) ->
+           begin match type_decl.type_kind with
+           | Type_variant (constructors, _private) ->
+               List.iter
+                 (fun (name, type_exprs) ->
+                    if Pcre.pmatch ~rex:exp name then begin
+                      Format.print_string name;
+                      if type_exprs <> [] then begin
+                        Format.print_string " of ";
+                        Format.print_string
+                          (String.concat " * "
+                             (List.map
+                                (fun e -> type_expr_to_string e)
+                                type_exprs))
+                      end;
+                      Format.print_string " (* ";
+                      if print_path then
+                        Format.print_string (path ^ ".");
+                      Format.print_string (Ident.name id);
+                      Format.print_string " *)";
+                      Format.print_newline ()
+                    end)
+                 constructors
+           | _ -> ()
+           end
+       | _ -> ())
+    s
+
+let print_polymorphic_variant print_path path s expr = 
+  let print_if_polymorphic_variant id type_decl =
+    begin match type_decl.type_manifest with
+    | None -> ()
+    | Some {desc = type_descr} ->
+        begin match type_descr with
+        | Tvariant variant_descr ->
+            List.iter
+              (fun (name, param) ->
+                 let src_name = "`" ^ name in
+                 if Pcre.pmatch ~rex:expr src_name then begin
+                   Format.print_string src_name;
+                   begin match param with
+                   | Rpresent None -> ()
+                   | Rabsent -> ()
+                   | Reither _ -> () (* this can't happen in a type *)
+                   | Rpresent (Some type_expr) ->
+                       Format.print_string " of ";
+                       Printtyp.type_expr 
+                         Format.str_formatter type_expr;
+                       let s = 
+                         Pcre.replace ~rex:whsp ~templ:" "
+                           (Format.flush_str_formatter ()) 
+                       in
+                       Format.print_string s;
+                   end;
+                   Format.print_string 
+                     (Printf.sprintf " (* %s%s *)"
+                        (if print_path then (path ^ ".") else "")
+                        (Ident.name id));
+                   Format.print_newline ()
+                 end)
+              variant_descr.row_fields
+        | _ -> ()
+        end
+    end
+  in
+  List.iter
+    (function 
+       | Tsig_type (id, type_decl, _rec_status) ->
+           begin match type_decl.type_kind with
+           | Type_abstract -> print_if_polymorphic_variant id type_decl
+           | _ -> ()
+           end
+       | _ -> ())
+    s
+
+let print_record_label print_path path s exp =
+  List.iter
+    (function
+       | Tsig_type (id, type_decl, _rec_status) ->
+           begin match type_decl.type_kind with
+           | Type_record (labels, _, _) ->
+               List.iter
+                 (fun (name, mutable_flag, type_expr) ->
+                    if Pcre.pmatch ~rex:exp name then begin
+                      begin match mutable_flag with
+                      | Asttypes.Mutable -> Format.print_string "mutable "
+                      | Asttypes.Immutable -> ()
+                      end;
+                      Format.print_string name;
+                      Format.print_string ": ";
+                      Printtyp.type_expr Format.std_formatter type_expr;
+                      Format.print_string " (* ";
+                      if print_path then
+                        Format.print_string (path ^ ".");
+                      Format.print_string (Ident.name id);
+                      Format.print_string " *)";
+                      Format.print_newline ()
+                    end)
+                 labels
+           | _ -> ()
+           end
+       | _ -> ())
+    s
+
+let print_value print_path path s exp =
+  List.iter
+    (function
+       | Tsig_value (id, desc) ->
+           if match_ident exp id then begin
+             Printtyp.value_description id Format.str_formatter desc;
+             let s = 
+               Pcre.replace ~rex:whsp ~templ:" "
+                 (Format.flush_str_formatter ()) 
+             in
+             if print_path then
+               print_endline (s ^ (Printf.sprintf " (* %s *)" path))
+             else
+               print_endline s
+           end
+       | _ -> ())
+    s
+
+let print_class print_path path s exp =
+  List.iter
+    (function
+       | Tsig_class (id, cd, _) when match_ident exp id ->
+           Printtyp.class_declaration id Format.std_formatter cd;
+           if print_path then
+             Format.print_string (Printf.sprintf " (* %s *)" path);
+           Format.print_newline ()
+       | Tsig_cltype (id, ct, _) when match_ident exp id ->
+           Printtyp.cltype_declaration id Format.std_formatter ct;
+           if print_path then
+             Format.print_string (Printf.sprintf " (* %s *)" path);
+           Format.print_newline ()
+       | _ -> ())
+    s
+
+let print_all print_path path s exp = 
+  let new_s = 
+    List.filter 
+      (function
+         | Tsig_value (id, _)
+         | Tsig_type (id, _, _)
+         | Tsig_exception (id, _)
+         | Tsig_module (id, _, _)
+         | Tsig_modtype (id, _)
+         | Tsig_class (id, _, _)
+         | Tsig_cltype (id, _, _) ->
+             match_ident exp id)
+      s
+  in
+  Printtyp.signature Format.std_formatter new_s;
+  if print_path then
+    Format.print_string (Printf.sprintf " (* %s *)" path);
+  Format.print_newline ()
+
+let print_exception print_path path s exp = 
+  List.iter
+    (function 
+       | Tsig_exception (id, exn) ->
+           if match_ident exp id then begin
+             Printtyp.exception_declaration id Format.std_formatter exn;
+             if print_path then
+               Format.print_string (Printf.sprintf " (* %s *)" path);
+             Format.print_newline ()
+           end
+       | _ -> ())
+    s
+
+let warn_env_error e =
+  Env.report_error Format.str_formatter e;
+  let e = Format.flush_str_formatter () in
+  Printf.eprintf "%s\n%!" e
+
+let match_mod_expr expr mod_name = 
+  let module E = Module_expression in
+  match expr with
+  | E.Exact name -> mod_name = name
+  | E.Begins_with (_, rex)
+  | E.Ends_with (_, rex)
+  | E.Begins_and_ends (_, rex)
+  | E.Contains (_, rex) -> Pcre.pmatch ~rex mod_name
+  | E.Any -> true
+
+let cmi_file = Pcre.regexp "\\.cmi$"
+let modname_of_cmi f = 
+  String.capitalize (Pcre.replace ~templ:"" ~rex:cmi_file f)
+
+let cmi_of_modname n = (String.lowercase n) ^ ".cmi"
+
+let cmi_files args mod_expr = 
+  let module E = Module_expression in
+  match mod_expr with
+  | E.Exact mod_name ->
+      let cmi_name = cmi_of_modname mod_name in
+      Pathset.fold
+        (fun path acc -> 
+           if Sys.file_exists (Filename.concat path cmi_name) then
+             (mod_name, Filename.concat path cmi_name) :: acc
+           else
+             acc)
+        args.path
+        []
+  | _ ->
+      Pathset.fold
+        (fun path cmi_files ->
+           Unix.fold_path
+             ~f:(fun file cmi_files -> 
+                   if Pcre.pmatch ~rex:cmi_file file then begin
+                     let mod_name = modname_of_cmi file in
+                     if match_mod_expr mod_expr mod_name then 
+                       (mod_name, Filename.concat path file) :: cmi_files
+                     else
+                       cmi_files
+                   end else
+                     cmi_files)
+             ~init:cmi_files
+             path)
+        args.path
+        []
+
+let rec matching_submods mod_expr s =
+  match s with
+  | Tsig_module (id, mt, _) :: tl when match_mod_expr mod_expr (Ident.name id) ->
+      begin match mt with
+      | Tmty_signature sg -> (Ident.name id, sg) :: matching_submods mod_expr tl
+      | Tmty_functor (_, mt, _) ->
+          begin match mt with
+          | Tmty_signature sg -> (Ident.name id, sg) :: matching_submods mod_expr tl
+          | _ -> matching_submods mod_expr tl
+          end
+      | Tmty_ident _ -> matching_submods mod_expr tl
+      end
+  | _ :: tl -> matching_submods mod_expr tl
+  | [] -> []
+
+let rec build_module_tree name root mod_expr = 
+  match mod_expr with
+  | [] -> Leaf (name, root)
+  | mod_expr :: tl ->
+      begin match matching_submods mod_expr root with
+      | [] -> Leaf (name, root)
+      | mods -> 
+          let children = 
+            List.map 
+              (fun (name, sg) -> build_module_tree name sg tl)
+              mods
+          in
+          Node (name, root, children)
+      end
+
+let rec extract_nodes depth path modtree =
+  let concatpath path name = 
+    if path = "" then name
+    else (path ^ "." ^ name)
+  in
+  match modtree with
+  | Leaf (name, sg) -> [(concatpath path name, depth, sg)]
+  | Node (name, sg, children) ->
+      (concatpath path name, depth, sg) ::
+        (List.flatten
+           (List.map
+              (fun submod -> extract_nodes (depth + 1) (concatpath path name) submod)
+              children))
+
+let print_requested_stuff print_path name s args =
+  match args.mode with
+  | Find_type e -> print_type print_path name s e
+  | Find_constructor e -> print_constructor print_path name s e
+  | Find_polymorphic_variant e -> print_polymorphic_variant print_path name s e
+  | Find_record_label e -> print_record_label print_path name s e
+  | Find_value e -> print_value print_path name s e
+  | Find_exception e -> print_exception print_path name s e
+  | Find_class e -> print_class print_path name s e
+  | Find_all e -> print_all print_path name s e
+  | Find_module -> 
+      Format.print_string name;
+      Format.print_newline ()
+
+let read_cmi_file filename =
+  let ic = open_in_bin filename in
+  try
+    let buffer = String.create (String.length Config.cmi_magic_number) in
+    really_input ic buffer 0 (String.length Config.cmi_magic_number);
+    if buffer <> Config.cmi_magic_number then begin
+      close_in ic;
+      failwith (Printf.sprintf "not an interface: %s" filename)
+    end;
+    let (name, sg) = input_value ic in
+    close_in ic;
+    sg
+  with exn ->
+    close_in ic;
+    failwith 
+      (Printf.sprintf 
+         "bad cmi file: %s, error: %s"
+         filename
+         (Printexc.to_string exn))
+
+let module_exists args mod_exp = 
+  let expr_len = List.length mod_exp in
+  let mod_name = List.hd mod_exp in
+  let submods = List.tl mod_exp in
+  match cmi_files args mod_name with
+  | [] -> false
+  | cmi_files ->
+      List.exists
+        (fun (name, cmi_file) ->
+           let s = read_cmi_file cmi_file in
+           let sgs = 
+             List.filter
+               (fun (_, depth, _) -> depth = expr_len)
+               (extract_nodes 1 "" (build_module_tree name s submods))
+           in
+           List.length sgs > 0)
+        cmi_files
+
+let gen_qualified args context = 
+  let context = Array.of_list context in
+  for i = 0 to Array.length context - 1 do
+    try
+      for j = i downto 0 do
+        let maybe_parent = context.(j) in
+        let child = context.(i) in
+        let qualified = maybe_parent @ child in
+        if module_exists args qualified then begin
+          context.(i) <- qualified;
+          raise Break
+        end
+      done
+    with Break -> ()
+  done;
+  Array.to_list context
+
+let () = 
+  let args = parse_args () in
+  let qualified_context = gen_qualified args args.context in
+  let mod_exprs = 
+    (* combine the list of fully qualified open modules with the
+       module expressions that the user has specified following the
+       compiler's rules about module opens for exact expressions, and
+       combining everything for non exact expressions. *)
+    match args.modname with
+    | [] -> qualified_context
+    | exps ->
+        List.flatten
+          (List.map
+             (fun exp -> 
+                if Module_expression.is_exact exp then
+                  [try 
+                     List.find_map
+                       (fun qual -> 
+                          let exp' = qual @ exp in
+                          if module_exists args exp' then Some exp'
+                          else None)
+                       (List.rev qualified_context) (* look from the bottom up *)
+                   with Not_found -> exp]
+                else
+                  exp ::
+                    (List.rev_map
+                       (fun qual -> qual @ exp)
+                       qualified_context))
+             exps)
+  in
+  List.iter
+    (fun mod_expr ->
+       try
+         let expr_len = List.length mod_expr in
+         let mod_name = List.hd mod_expr in
+         let submods = List.tl mod_expr in
+         let cmi_files = cmi_files args mod_name in
+         List.iter
+           (fun (name, cmi_file) ->
+              let s = read_cmi_file cmi_file in
+              let sgs = 
+                List.filter
+                  (fun (_, depth, _) -> depth = expr_len)
+                  (extract_nodes 1 "" (build_module_tree name s submods))
+              in
+              let print_path = 
+                List.length sgs > 1 || 
+                  List.length cmi_files > 1 ||
+                  List.length args.modname > 1
+              in
+              List.iter
+                (fun (name, _,  sg) -> print_requested_stuff print_path name sg args)
+                sgs)
+           cmi_files
+       with exn -> 
+         Printf.eprintf
+           "failed to operate on: \"%s\", %s\n%!"
+           (String.concat " " (List.map Module_expression.to_string mod_expr))
+           (Printexc.to_string exn))
+    mod_exprs