From 68b9d63d7721d2c1c375c96355e9a542c62004ef Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Sun, 22 Jun 2008 11:56:02 +0000
Subject: 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
---
 ChangeLog             |  7 ++++++
 src/ellinika/dico.scm | 66 +++++++++++++++++++++++++++++++++++++++++++++------
 2 files changed, 66 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ee82c7e..dc20799 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
 2008-06-22  Sergey Poznyakoff  <gray@gnu.org.ua>
 
+	Implement levenshtein, basic regex, and general-purpose selector
+	matches.
+
+	* src/ellinika/dico.scm: Implement matching using strategy selectors.
+
+	Rearrange the directory structure.
+
 	* src: New dir
 	* src/Makefile.am: New file.
 	* cgi-bin, ellinika: Move to src.
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
@@ -221,8 +221,57 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
     "\" 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
@@ -238,14 +287,17 @@ Invariant Sections, no Front-Cover and Back-Cover Texts"))
   (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))))
-- 
cgit v1.2.1