summaryrefslogtreecommitdiffabout
path: root/src/ellinika
authorSergey Poznyakoff <gray@gnu.org.ua>2008-06-22 11:56:02 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2008-06-22 11:56:02 (GMT)
commit68b9d63d7721d2c1c375c96355e9a542c62004ef (patch) (side-by-side diff)
treeeda423b77e24710d35d3890e34a48f1d1c467ef1 /src/ellinika
parent7d34b25dac463e53f3a93cf021f7706913deeb42 (diff)
downloadellinika-68b9d63d7721d2c1c375c96355e9a542c62004ef.tar.gz
ellinika-68b9d63d7721d2c1c375c96355e9a542c62004ef.tar.bz2
Implement levenshtein, basic regex, and general-purpose selector matches.
* src/ellinika/dico.scm: Implement matching using strategy selectors. git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@528 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'src/ellinika') (more/less context) (ignore whitespace changes)
-rw-r--r--src/ellinika/dico.scm66
1 files changed, 59 insertions, 7 deletions
diff --git a/src/ellinika/dico.scm b/src/ellinika/dico.scm
index 9383d1f..c156862 100644
--- a/src/ellinika/dico.scm
+++ b/src/ellinika/dico.scm
@@ -218,14 +218,63 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
(string-append
"SELECT DISTINCT dict.word FROM dict, articles WHERE dict.word regexp \""
(ellinika:translate-input word)
"\" AND dict.ident=articles.ident "
"AND articles.lang='" (dbh:lang dbh) "' ORDER BY 1")))
-(define (match-basic-regex dbh strat word)
- #f) ;FIXME
+;; Implementation of a Common LISP mapcan function
+(define (mapcan fun list)
+ (apply (lambda ( . slist)
+ (let loop ((elt '())
+ (slist slist))
+ (cond
+ ((null? slist)
+ (reverse elt))
+ ((not (car slist))
+ (loop elt (cdr slist)))
+ (else
+ (loop (cons (car slist) elt) (cdr slist))))))
+ (map fun list)))
+
+;; Convert SLIST, which is a list of strings, into a string of
+;; comma-separated values.
+(define (list->csv slist)
+ (apply string-append
+ (let loop ((elt '())
+ (slist slist))
+ (cond
+ ((null? (cdr slist))
+ (reverse
+ (cons "\"" (cons (car slist) (cons "\"" elt)))))
+ (else
+ (loop (cons "\"," (cons (car slist) (cons "\"" elt)))
+ (cdr slist)))))))
+
+(define (match-selector dbh strat key)
+ (let* ((sound (ellinika:sounds-like key))
+ (dlist (mapcan
+ (lambda (elt)
+ (let ((word (car elt)))
+ (and (dico-strat-select? strat word sound)
+ word)))
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.sound FROM dict,articles "
+ "WHERE dict.ident=articles.ident "
+ "AND articles.lang='" (dbh:lang dbh)
+ "' ORDER BY 1")))))
+ (if (not (null? dlist))
+ (my-sql-query
+ (dbh:conn dbh)
+ (string-append
+ "SELECT DISTINCT dict.word FROM dict "
+ "WHERE dict.sound IN ("
+ (list->csv dlist)
+ ")"))
+ #f)))
(define (match-default dbh strat word)
(my-sql-query
(dbh:conn dbh)
(string-append
"SELECT DISTINCT dict.word FROM dict,articles WHERE dict.sound LIKE \""
@@ -235,20 +284,23 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
(define strategy-list
(list (cons "exact" match-exact)
(cons "prefix" match-prefix)
(cons "suffix" match-suffix)
- (cons "re" match-extnd-regex)
- (cons "regexp" match-basic-regex)))
+ (cons "re" match-extnd-regex)))
(define (match-word dbh strat word)
(let ((sp (assoc (dico-strat-name strat) strategy-list)))
- (let ((res (if sp
- ((cdr sp) dbh strat word)
- (match-default dbh strat word))))
+ (let ((res (cond
+ (sp
+ ((cdr sp) dbh strat word))
+ ((dico-strat-selector? strat)
+ (match-selector dbh strat word))
+ (else
+ (match-default dbh strat word)))))
(if res
(cons #f (map car res))
#f))))
(define (output res n)
(let ((type (car res))

Return to:

Send suggestions and report system problems to the System administrator.