;;; -*- Mode: Lisp; Package: User; Syntax: Common-Lisp; Base: 10; VSP: 0 -*-
;;; Created by sgr at Dopey.MIT.EDU on Monday, 24 February at 17:02pm.

(in-package 'user)

;;;
;;; Cleaned-up version of Lucid CL/PCKimmo interface.
;;;

#-:Lucid
(error "I can only interface Lucid CL to PCKimmo; you're using something else.")

(def-foreign-function (load-language-c (:return-type :signed-32bit)
				       (:name load_language)
				       (:language :c))
  ;; load-language-c loads a language description 
  (language :simple-string)
  (aut-name :simple-string)
  (dic-name :simple-string))

(def-foreign-function (load-rules-c (:return-type :signed-32bit)
				    (:name load_kimmo_rules)
				    (:language :c))
  ;; load-rules-c loads just the language's rules
  (language :simple-string)
  (aut-name :simple-string))

(def-foreign-function (load-lexicon-c (:return-type :signed-32bit)
				      (:name load_kimmo_lexicon)
				      (:language :c))
  ;; load-lexicon-c loads just the language's lexicon
  (language :simple-string)
  (dic-name :simple-string))

(def-foreign-function (do-recognition-c (:return-type :signed-32bit)
					(:name do_recognition)
					(:language :c))
  ;; do-recognition-c does recognition of a surface form.
  (language :simple-string)
  (word :simple-string)
  (trace :signed-32bit))

(def-foreign-function (do-generation-c (:return-type :signed-32bit)
				       (:name do_generation)
				       (:language :c))
  ;; do-generation-c does generation from a lexical form.
  (language :simple-string)
  (word :simple-string)
  (trace :signed-32bit))

(def-foreign-function (get-result-str1 (:return-type :simple-string)
				       (:name get_result_str1)
				       (:language :c))
  ;; get the string part of the last recognition or generation.
  )

(def-foreign-function (get-result-str2 (:return-type :simple-string)
				       (:name get_result_str2)
				       (:language :c))
  ;; get the feature string of the current result.
  )

(def-foreign-function (increment-result (:return-type :signed-32bit)
					(:name increment_result)
					(:language :c))
  ;; move along to the next result of the generation or recognition.
  )

;;;
;;; The above defines the interface; now we load the code.
;;;

(load-foreign-files '("/mit/6.863/pckimmo-interface/kimmo.o")) ;*** Glaah.

;;;
;;; Here's a slightly more reasonable interface.  We return a list of results.
;;;

(defun lower-casify (thing) 
  ;; change thing to a lower-case string
  (string-downcase (string thing)))

(defun kimmo-success-p (thing)
  ;; 0 means success, anything else failure.
  (and (numberp thing) (zerop thing)))

(defun sample-feature-analyzer (feature-string)
  ;; Given a feature string from Kimmo, bust it up into Lispy data structures.
  ;; Here we assume the form "[ cat(gloss)features ]"
  (let (category gloss features index (length (length feature-string)))
    (with-input-from-string (s feature-string :index index)
       ;; read things from the string, with paranoia set high.
       (assert (char= (read-char s) #\[))
       (setq category (read s))
       (assert (symbolp category))
       (setq gloss (read s))
       (assert (and (listp gloss)
		    (= (length gloss) 1)
		    (symbolp (first gloss))))
       (setq gloss (first gloss)))
    ;; ok, we've read the category and gloss; index now points at next char.
    (assert (char= (aref feature-string (1- length)) #\]))
    (assert (char= (aref feature-string (- length 2)) #\Space))
    (setq features (subseq feature-string index (- length 2)))
    ;; return a plist of values
    (list :category category :gloss gloss :features features)))
      
(defun recognize-word (surface-word language &optional feature-analyzer)
  ;; do all possible recognitions of surface-word in language.  (C isn't
  ;; prepared for coroutining, of course!)  Returns alist of lexical
  ;; words & features.
  (when (kimmo-success-p (do-recognition-c (lower-casify language)
					   (lower-casify surface-word)
					   0))
    ;; succeeded in finding something.
    (loop for lexical-word = (get-result-str1)
	  for lexical-str  = (get-result-str2)
	  when feature-analyzer 
	    do (setq lexical-str (funcall feature-analyzer lexical-str))
	  collecting (list lexical-word lexical-str)
	  until (zerop (increment-result)))))

(defun generate-word (lexical-word language)
  ;; do all possible generations of lexical-word in language.  (C isn't
  ;; prepared for coroutining, of course!)  Returns list of strings.
  (when (kimmo-success-p (do-generation-c (lower-casify language)
					  (lower-casify lexical-word)
					  0))
    ;; succeeded in finding something
    (loop collecting (get-result-str1)
	  until (zerop (increment-result)))))