Permalink
Browse files

Merge pull request #3 from camlspotter/master

Ported to OCaml 4.00.1 + opt compilation
  • Loading branch information...
mzp committed Feb 16, 2013
2 parents 8bdf112 + 91186e2 commit ae4c78cca7cc48cf3b6de321612013e69d95edfc
Showing with 6,065 additions and 118 deletions.
  1. +4 −2 .gitignore
  2. +29 −13 OMakefile
  3. +2 −16 README.mkdn
  4. +14 −0 _oasis
  5. +16 −2 base.ml
  6. +57 −0 base.mli
  7. +1 −1 config.ml → chconfig.ml
  8. 0 config.mli → chconfig.mli
  9. +105 −0 cli.ml
  10. +3 −3 controller.ml
  11. +4 −2 controller.mli
  12. +2 −2 list2.ml
  13. +3 −3 main.ml
  14. +1 −0 modules-init.sh
  15. +6 −0 opam/ocaml-hoogle.1.0.0/descr
  16. +12 −0 opam/ocaml-hoogle.1.0.0/opam
  17. +6 −0 opam/template/descr
  18. +2 −0 opam/template/opam
  19. +28 −0 scrape-modules.sh
  20. +52 −21 search.ml
  21. +4 −3 search.mli
  22. +2 −1 searchTest.ml
  23. +110 −49 searchid.ml
  24. +12 −0 searchid.mli
  25. +5,590 −0 setup.ml
View
@@ -1,12 +1,14 @@
*~
.omakedb
.omakedb.lock
-*.cm[iox]
+*.cm*
*.omc
*.cgi
*.run
+*.opt
*.annot
*.o
*-runner
config-test.txt
-modules.txt
+modules.txt
+
View
@@ -1,25 +1,27 @@
+.PHONY: clean all
+
USE_OCAMLFIND = true
OCAMLPACKS[] =
oUnit
extlib
CamlGI
str
-
+ compiler-libs.bytecomp
if $(not $(OCAMLFIND_EXISTS))
eprintln('This project requires ocamlfind, but is was not found.')
eprintln('You need to install ocamlfind and run "omake --configure".')
exit 1
-OCAMLFLAGS += -dtypes -g -thread
+OCAMLFLAGS += -dtypes -g -thread -w A-4-9 -warn-error A-4-6-9-27-31-33
OCAMLINCLUDES += ../parsing
OCAMLINCLUDES += ../typing
-NATIVE_ENABLED = false
+NATIVE_ENABLED = true
BYTE_ENABLED = true
-FILES[] =
- config
+CGI_FILES[] =
+ chconfig
controller
hList
list2
@@ -28,23 +30,37 @@ FILES[] =
base
main
-PROGRAM = index.cgi
+CGI_PROGRAM = index.cgi
+
+all:: $(OCamlProgram $(CGI_PROGRAM), $(CGI_FILES))
+
+CLI_FILES[] =
+ chconfig
+ controller
+ hList
+ list2
+ searchid
+ search
+ base
+ cli
+
+CLI_PROGRAM = ocamlas
+
+all:: $(OCamlProgram $(CLI_PROGRAM), $(CLI_FILES))
# OCAML_LIBS +=
# OCAML_CLIBS +=
-OCAML_OTHER_LIBS += toplevellib
+# OCAML_OTHER_LIBS += toplevellib
# OCAML_LIB_FLAGS +=
#
-.PHONY: clean all
-
-all: $(OCamlProgram $(PROGRAM), $(FILES)) modules.txt
+all:: modules.txt
modules.txt : modules-init.sh
./modules-init.sh
clean:
- rm -f *.cm[oix] *.o *.omc $(PROGRAM) *.run *~ *.annot
+ rm -f *.cm* *.o *.omc $(CGI_PROGRAM) $(CLI_PROGRAM) *.run *.opt *~ *.annot *Test-runner
.DEFAULT: all
@@ -72,8 +88,8 @@ OUNIT_LIBS[] =
base
hList
-OUnitTest(config, config)
-OUnitTest(search, search config searchid list2)
+OUnitTest(config, chconfig)
+OUnitTest(search, search chconfig searchid list2)
OUnitTest(controller, controller)
########################################################################
View
@@ -13,34 +13,20 @@ It is similar to Hoogle, which is a Haskell API search engine.
PREREQUISITES
-------------
-* ocaml 3.11
+* ocaml 4.00.1
* omake
* findlib
* extlib
* oUnit(for unit test)
+* CamlGI
INSTALL
-------
-### 1. Download OCaml compiler version 3.11.1. ###
-
-* Do no ask me where to find it.
-* You can also use the CVS version
-
-### 2. Extract the compiler source. ###
-
-* tar zxvf ocaml-3.11.1.tar.gz
-* cd ocaml3.11.1
-
### 3. Download OCaml API search ###
* git clone git://github.com/mzp/ocaml-hoogle.git
-### 4. Build a bytecode compiler ###
-
-* ./configure
-* make core
-
### 5. Build OCaml API Search ###
* cd ocaml-hoogle
View
14 _oasis
@@ -0,0 +1,14 @@
+OASISFormat: 0.2
+Name: ocaml-hoogle
+Version: 1.0.0
+Synopsis: OCaml API Search
+Authors: MIZUNO Hiroki
+License: LGPL
+Plugins: StdFiles (0.2)
+BuildType: Custom (0.2)
+InstallType: Custom (0.2)
+XCustomBuild: yes no | omake --install; PREFIX=$prefix omake
+XCustomInstall: PREFIX=$prefix omake install
+XCustomUninstall: PREFIX=$prefix omake uninstall
+XCustomBuildClean: PREFIX=$prefix omake clean
+BuildTools: omake
View
18 base.ml
@@ -1,5 +1,5 @@
-let (@@) f g = f g
-let (+>) f g = g f
+external (@@) : ('a -> 'b) -> 'a -> 'b = "%apply"
+external (+>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
let ($) f g x = f (g x)
let (!$) = Lazy.force
external id : 'a -> 'a = "%identity"
@@ -128,3 +128,17 @@ let open_in_with path f =
let undefined = Obj.magic 42
let undef = undefined
+
+let rec format_list (sep : (unit, Format.formatter, unit) format) f ppf = function
+ | [] -> ()
+ | [x] -> f ppf x
+ | x::xs ->
+ Format.fprintf ppf "@[%a@]%t%a"
+ f x
+ (fun ppf -> Format.fprintf ppf sep)
+ (format_list sep f) xs
+
+let format_ocaml_list f ppf xs =
+ Format.fprintf ppf "[ @[%a@] ]"
+ (format_list ";@ " f) xs
+
View
@@ -0,0 +1,57 @@
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+(** Haskell's ($) *)
+
+external ( +> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+(** F#'s (|>) *)
+
+val ( $ ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b
+(** Haskell's (.) *)
+
+val ( !$ ) : 'a Lazy.t -> 'a
+(** Lazy.force *)
+
+external id : 'a -> 'a = "%identity"
+(** Identity *)
+
+val uncurry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c
+val curry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
+val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c
+val const : 'a -> 'b -> 'a
+val sure : ('a -> 'b) -> 'a option -> 'b option
+val option : ('a -> 'b) -> 'a -> 'b option
+val maybe : ('a -> 'b) -> 'a -> [> `Error of exn | `Val of 'b ]
+val tee : ('a -> 'b) -> 'a -> 'a
+type ('a, 'b) either = Left of 'a | Right of 'b
+
+val failwithf : ('a, unit, string, unit -> 'b) format4 -> 'a
+(** failwith with formatting *)
+
+val assoc : 'a -> ('a * 'b) list -> 'b option
+(** List.assoc with option *)
+
+val string_of_list : string list -> string
+val unfold : ('a -> ('b * 'a) option) -> 'a -> 'b list
+val range : int -> int -> int list
+val interperse : 'a -> 'a list -> 'a list
+val map_accum_left : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+val map_accum_right : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+val filter_map : ('a -> 'b option) -> 'a list -> 'b list
+val group_by : ('a -> 'a -> bool) -> 'a list -> 'a list list
+val index : 'a -> 'a list -> int
+val string_of_char : char -> string
+val hex : int -> string
+val open_out_with : string -> (out_channel -> 'a) -> 'a
+val open_in_with : string -> (in_channel -> 'a) -> 'a
+val undefined : 'a
+val undef : 'a
+
+val format_list :
+ (unit, Format.formatter, unit) format
+ -> (Format.formatter -> 'a -> unit)
+ -> Format.formatter -> 'a list -> unit
+(** Format for lists *)
+
+val format_ocaml_list :
+ (Format.formatter -> 'a -> unit)
+ -> Format.formatter -> 'a list -> unit
+(** Format for lists in OCaml style [ a; b; ... ] *)
@@ -32,7 +32,7 @@ let r_path =
regexp "^PATH *:: *\\(.*\\)$"
let parse_line s =
- if s = "" then
+ if s = "" || s.[0] = '#' then
()
else if string_match r_path s 0 then
path := Some (matched_group 1 s)
File renamed without changes.
View
105 cli.ml
@@ -0,0 +1,105 @@
+open Base
+
+let q =
+ let rev_args = ref [] in
+ Arg.parse [] (fun x -> rev_args := x::!rev_args)
+ @@ Printf.sprintf "%s <query strings>" Sys.argv.(0);
+ String.concat " " @@ List.rev !rev_args
+
+let configs = Chconfig.read "modules.txt"
+
+let modules = HList.concat_map (fun {Chconfig.modules=m} -> m) configs
+
+let paths = filter_map (fun {Chconfig.path=p} -> p) configs
+
+let results, stat =
+ match Searchid.Stat.get (Search.raw_search q modules) paths with
+ | `Error exn, _ -> raise exn
+ | `Ok res, stat -> res, stat
+
+open Format
+
+let info_of_value id =
+ let _name =
+ match id with
+ | Longident.Lident x -> x
+ | Longident.Ldot (_, x) -> x
+ | _ -> "z"
+ in
+ let _, vd =
+ Env.lookup_value id !Searchid.start_env
+ in
+ vd.Types.val_type, vd.Types.val_loc
+
+let info_of_type id =
+ let _path, td = Env.lookup_type id !Searchid.start_env in
+ td
+
+let analyze_pkind (id, pkind) = match pkind with
+ | Searchid.Pvalue ->
+ `Value (id, info_of_value id)
+ | Searchid.Ptype ->
+ `Type (id, info_of_type id)
+ | Searchid.Pmodule ->
+ `Module id
+ | Searchid.Pmodtype ->
+ `ModuleType id
+ | Searchid.Pclass ->
+ `Class id
+ | Searchid.Pcltype ->
+ `ClassType id
+ | Searchid.Plabel ->
+ `Label id
+ | Searchid.Pconstructor ->
+ `Constr id
+
+(* module O = Outcometree --- We cannot do this! Since outcometree is mli only...
+*)
+open Outcometree
+open Types
+
+let format ppf = function
+ | `Value (id, (type_, _loc)) ->
+(*
+ fprintf ppf "%a@.val %a : %a@."
+ Location.print_loc loc
+ Printtyp.longident id
+ Printtyp.type_scheme type_
+*)
+ fprintf ppf "@[<2>val %a :@ %a@]"
+ Printtyp.longident id
+ Printtyp.type_scheme type_
+ | `Type (id, td) ->
+ (* To print the path name with module names,
+ we hack outcometree *)
+ let o = Printtyp.tree_of_type_declaration (Ident.create "z") td Types.Trec_first in
+ let o = match o with
+ | Osig_type (odecl, ors) ->
+ let odecl = match odecl with
+ | _name, a, b, c, d ->
+ String.concat "." (Longident.flatten id), a, b, c, d
+ in
+ Osig_type (odecl, ors)
+ | _ -> assert false
+ in
+ !Oprint.out_sig_item ppf o;
+ if td.type_manifest = None && td.type_kind = Type_abstract then
+ fprintf ppf " (* abstract *)"
+ | `Module id ->
+ fprintf ppf "module %a" Printtyp.longident id
+ | `ModuleType id ->
+ fprintf ppf "module type %a" Printtyp.longident id
+ | `Class id ->
+ fprintf ppf "class %a" Printtyp.longident id
+ | `ClassType id ->
+ fprintf ppf "class type %a" Printtyp.longident id
+ | `Label id ->
+ fprintf ppf "label %a" Printtyp.longident id
+ | `Constr id ->
+ fprintf ppf "constr %a" Printtyp.longident id
+
+let () =
+ Format.printf "%a@.%a@."
+ (format_list "@." format) (List.map analyze_pkind results)
+ Searchid.Stat.format stat
+
View
@@ -9,9 +9,9 @@ type t =
let find_package module_ configs =
let config =
List.find configs
- ~f:(fun { Config.modules=modules } -> List.mem (List.hd module_) modules)
+ ~f:(fun { Chconfig.modules=modules } -> List.mem (List.hd module_) modules)
in
- config.Config.name
+ config.Chconfig.name
let module_ =
function [] -> [""]
@@ -92,7 +92,7 @@ let pagenation ~offset ~window xs =
let available configs =
Table begin
- List.map configs ~f:begin fun { Config.name = name; modules = modules} ->
+ List.map configs ~f:begin fun { Chconfig.name = name; modules = modules} ->
["package", String name;
"modules", Table begin
List.map modules ~f:begin fun s ->
View
@@ -3,6 +3,8 @@ type t =
| Bool of bool
| Table of (string * t) list list
-val format : Config.t list -> Search.t -> (string * t) list
+val format : Chconfig.t list -> Search.t -> (string * t) list
+(** formatter for [Search.t] *)
+
val pagenation : offset:int -> window:int -> 'a list -> (string * t) list * 'a list
-val available : Config.t list -> t
+val available : Chconfig.t list -> t
Oops, something went wrong.

0 comments on commit ae4c78c

Please sign in to comment.