Fetching contributors…
Cannot retrieve contributors at this time
82 lines (69 sloc) 3.53 KB
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA 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 Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <>.
@author Louis Gesbert
This module extracts search-words from a text: it's used, for instance, by
the database full-search function.
Filtering is quite naive for now, but can be improved.
This module uses the Ulex syntax extension
exception Result of int StringMap.t (* internal use, to return result at eof *)
(* Based on 10002fr.equ file (most common English words on Usenet list), taken
from Moby Word Lists by Grady Ward, a public domain package: The regular expression contains all
the words up to line 70 of the file, excluding "article", "writes", "UUCP",
single letter words and capitalized words (all of which are variants of lower
case words already on the list).
Unoptimized regexp:
Optimized regexp: *)
let common_words = Str.regexp "\\(a\\(bout\\|ll\\|n[dy]\\|re\\|[mnst]\\)\\|b\\(ut\\|[ey]\\)\\|can\\|do\\(n't\\)?\\|edu\\|f\\(or\\|rom\\)\\|get\\|h\\(a\\(s\\|ve\\)\\|e\\)\\|i[fnst]\\|just\\|like\\|m\\(ore\\|[ey]\\)\\|not?\\|o\\(ne\\|ther\\|ut\\|[fnr]\\)\\|so\\(me\\)?\\|t\\(h\\(at\\|e\\(re\\|y\\)?\\|is\\)\\|o\\)\\|up\\|w\\(as\\|e\\|h\\(at\\|ich\\|o\\)\\|i\\(ll\\|th\\)\\|ould\\)\\|your?\\)$"
(** @param map is a map from word to number of its occurrences; this function
returns the updated map with occurrences from s *)
let utf8_string map s =
let bad_utf8 () =
(* Base.jlog ~level:3 "Invalid utf-8 in string, not indexing";*) map in
let add_word map w =
match StringMap.find_opt w map with
| Some num -> StringMap.add w (num + 1) map
| None -> StringMap.add w 1 map
let extract_word acc = lexer
| xml_ideographic ->
(* Fixme: splitting words in ideographic languages is non-trivial. See
for example *)
(* add_word acc (Ulexing.utf8_lexeme lexbuf) -- index single ideograms ? *)
acc (* we don't index at all, for now *)
| xml_letter+ ->
if Ulexing.lexeme_length lexbuf <= 1 then
let word = Cactutf.lowercase (Ulexing.utf8_lexeme lexbuf) in
if String.length word <= 1 || Str.string_match common_words word 0 then
add_word acc word
| eof -> raise (Result acc)
| _ -> acc
let rec lex acc lexbuf = lex (extract_word acc lexbuf) lexbuf
lex map (Ulexing.from_utf8_string s)
| Result map -> map
| Ulexing.Error | Ulexing.InvalidCodepoint _ -> bad_utf8()
| Utf8.MalFormed -> bad_utf8() (* that one is undocumented in ulex (?) *)