Dictionary parser

git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@195 941c8c0f-9102-463b-b60b-cd22ce0e6858

1 files changed, 654 insertions, 0 deletions

diff --git a/scm/dictrans.scm b/scm/dictrans.scm
new file mode 100644
index 0000000..5cfc50e
--- /dev/null
+++ b/scm/dictrans.scm
@@ -0,0 +1,654 @@
+;;;; This file is part of Ellinika
+;;;; Copyright (C) 2004 Sergey Poznyakoff
+;;;;
+;;;; Ellinika 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.
+;;;;
+;;;; Ellinika 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 Ellinika; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;;
+
+;;;; Dictionary structure
+;;;; Internal representation:
+;;;; 
+;;;; * Each dictionary entry is represented as a vector:
+;;;; 
+;;;; #(KEY FORMS XREF P-LIST)
+;;;; 
+;;;; KEY is list of strings  
+;;;; 
+;;;; * FORMS is either #f or a string describing forms of the key if they
+;;;; are formed in an irregular manner.
+;;;; 
+;;;; * XREF is a list of cross-references
+;;;; 
+;;;; * P-LIST is a list of P-ARTICLES. Each P-ARTICLE is a vector:
+;;;; 
+;;;;  #(POS ARTICLE AREF XREF TOPIC)
+;;;; 
+;;;; Member    Type          Meaning
+;;;; POS       string        part of speech
+;;;; ARTICLE   list(string)  Dictionary article associated with this key/pos
+;;;; AREF      list(string)  List of antonyms
+;;;; XREF      list(string)  List of cross-references
+;;;; TOPIC     list(string)  List of topics this item pertains to
+;;;; 
+;;;; 
+;;;; External representation (XML):
+;;;; 
+;;;; <NODE>
+;;;;  <K>string</K>+
+;;;;  [<F>string</F>]
+;;;;  <P ID="string">
+;;;;   <M>string</M>+
+;;;;   <A>string</A>*
+;;;;   <X>string</X>*
+;;;;   <T ID="string" />*
+;;;;  </P>+
+;;;;  <X>string</X>*
+;;;; </NODE>
+;;;; 
+;;;; If only one P entry is present, the following alternative forms
+;;;; are understood:
+;;;; 
+;;;; <NODE>
+;;;;  <K>string</K>+
+;;;;  [<F>string</F>]
+;;;;  <P>string</P>
+;;;;  <M>string</M>*
+;;;;  <A>string</A>*
+;;;;  <X>string</X>*
+;;;;  <T ID="string" />*
+;;;; </NODE>
+;;;; 
+;;;; or
+;;;; 
+;;;; <NODE>
+;;;;  <K>string</K>+
+;;;;  [<F>string</F>]
+;;;;  <P>string</P>
+;;;;  <X>string</X>*
+;;;;  <T ID="string" />*
+;;;; </NODE>
+
+(set! %load-path (cons "/usr/local/share/guile-sql" %load-path))
+(use-modules (xmltools xmltrans)
+             (sql)
+             (ice-9 getopt-long))
+
+(use-syntax (ice-9 syncase))
+
+(define compile-only #f)
+(define cleanup-option #f)
+(define preserve-option #f)
+
+(define sql-iface "mysql")
+(define sql-host "localhost")
+(define sql-database "ellinika")
+(define sql-port 3306)
+(define sql-password #f)
+(define sql-user #f)
+(define verbose-option #f)
+(define debug-level 0)
+(define input-files '())
+
+(define (debug level . rest)
+  (if (>= debug-level level)
+      (begin
+        (for-each
+         (lambda (x)
+           (display x))
+         rest)
+        (newline))))
+
+
+;;;; XML definitions
+
+;;; Set the default handler
+(define tag-list '())
+
+(define (lingua:default-start tag attr)
+  (xmltrans:set-attr #f "__START__" 1)
+  #f)
+
+(xmltrans:set-default-start-handler lingua:default-start)
+
+(define (lingua:default-end tag attr text)
+  (if (xmltrans:attr attr "__START__")
+      (xmltrans:parse-error #f "Unhandled element " tag))
+  (set! tag-list
+        (cons
+         (xmltrans:make-tag tag attr text)
+         tag-list))
+  #f)
+
+(xmltrans:set-default-end-handler lingua:default-end)
+
+;;; Current node
+(define current-node #f)
+
+(define-syntax node-get
+  (syntax-rules ()
+    ((node-get #:key)
+     (vector-ref current-node 0))
+    ((node-get #:forms)
+     (vector-ref current-node 1))
+    ((node-get #:xref)
+     (vector-ref current-node 2))
+    ((node-get #:p-list)
+     (vector-ref current-node 3))))
+
+(define (mark-invalid)
+  (xmltrans:set-attr "NODE" "__INVALID__" 1))
+
+(define-syntax node-set
+  (syntax-rules ()
+    ((node-set #:key k)
+     (cond
+      ((node-get #:key) =>
+       (lambda (klist)
+         (vector-set! current-node 0 (append klist (list k)))))
+      (else
+       (vector-set! current-node 0 (list k)))))
+    ((node-set #:forms f)
+     (begin
+       (cond
+        ((node-get #:forms)
+         (xmltrans:parse-error #f "Forms already set")
+         (mark-invalid)))
+       (vector-set! current-node 1 f)))
+    ((node-set #:xref x)
+     (cond
+      ((node-get #:xref) =>
+       (lambda (xlist)
+         (vector-set! current-node 2 (append xlist (list x)))))
+      (else
+       (vector-set! current-node 2 (list x)))))
+    ((node-set! #:p-article p)
+     (cond
+      ((node-get #:p-list) =>
+       (lambda (plist)
+         (vector-set! current-node 3 (append plist (list p)))))
+      (else
+       (vector-set! current-node 3 (list p)))))
+    ((node-set #:topic t)
+     (for-each
+      (lambda (p)
+        ;; FIXME: Use p-article-set
+        (vector-set! p 4 (append (vector-ref p 4) (list t))))
+      (node-get #:p-list)))))
+
+(define p-article #f)
+
+(define-syntax p-article-get
+  (syntax-rules ()
+    ((p-article-get #:pos)
+     (vector-ref p-article 0))
+    ((p-article-get #:article)
+     (vector-ref p-article 1))
+    ((p-article-get #:aref)
+     (vector-ref p-article 2))
+    ((p-article-get #:xref)
+     (vector-ref p-article 3))
+    ((p-article-get #:topic)
+     (vector-ref p-article 4))))
+
+(define-syntax p-set
+  (syntax-rules ()
+    ((p-set key n val)
+     (vector-set! p-article n 
+                  (cond
+                   ((p-article-get key) =>
+                    (lambda (alst)
+                      (append alst (list val))))
+                   (else
+                    (list val)))))))
+    
+(define-syntax p-article-set
+  (syntax-rules ()
+    ((p-article-set #:pos val)
+     (vector-set! p-article 0 val))
+    ((p-article-set #:article val)
+     (p-set #:article 1 val)) 
+    ((p-article-set #:aref val)
+     (p-set #:aref 2 val))
+    ((p-article-set #:xref val)
+     (p-set #:xref 3 val))
+    ((p-article-set #:topic val)
+     (p-set #:topic 4 val))))
+
+
+;;; Node list
+(define node-list '())
+
+(define (push-node node)
+  (if (>= debug-level 100)
+      (begin
+        (write node)
+        (newline)))
+  (set! node-list (cons current-node node-list)))
+
+;;; Topic stack<