;;;  __  __
;;; |  \/  | __ _  ___ _ __ ___  ___
;;; | |\/| |/ _` |/ __| '__/ _ \/ __|
;;; | |  | | (_| | (__| | | (_) \__ \
;;; |_|  |_|\__,_|\___|_|  \___/|___/

(define-syntax do-while
  (syntax-rules ()
    ((_ test? xpr xpr1 ...)
     (let loop ()
       (if test?
           (begin
             xpr xpr1 ...
             (loop)))))))

;;;  _____              _               _____                      
;;; |  ___|__  _ __ ___(_) __ _ _ __   |_   _|   _ _ __   ___  ___ 
;;; | |_ / _ \| '__/ _ \ |/ _` | '_ \    | || | | | '_ \ / _ \/ __|
;;; |  _| (_) | | |  __/ | (_| | | | |   | || |_| | |_) |  __/\__ \
;;; |_|  \___/|_|  \___|_|\__, |_| |_|   |_| \__, | .__/ \___||___/
;;;                       |___/              |___/|_|              

(define-foreign-type parse-options (c-pointer (struct "Parse_Options_s")))
(define-foreign-type cmd-options   (c-pointer (struct "Command_Options_s")))
(define-foreign-type cost-model    (c-pointer (struct "Cost_Model_s")))
(define-foreign-type resources     (c-pointer (struct "Resources_s")))
(define-foreign-type dictionary    (c-pointer (struct "Dictionary_s")))
(define-foreign-type linkage       (c-pointer (struct "Linkage_s")))
(define-foreign-type sub-linkage   (c-pointer (struct "Sublinkage_s")))
(define-foreign-type sentence      (c-pointer (struct "Sentence_s")))

;;;  ____  _                 _           _    ____ ___
;;; / ___|(_)_ __ ___  _ __ | | ___     / \  |  _ \_ _|
;;; \___ \| | '_ ` _ \| '_ \| |/ _ \   / _ \ | |_) | |
;;;  ___) | | | | | | | |_) | |  __/  / ___ \|  __/| |
;;; |____/|_|_| |_| |_| .__/|_|\___| /_/   \_\_|  |___|
;;;                   |_|

(define (parse-with-default text)
  (when (not *DEFAULT-DICTIONARY*)
    (set! *DEFAULT-DICTIONARY* (create-default-dictionary)))

  (when (not *DEFAULT-OPTS*)
    (set! *DEFAULT-OPTS* (create-default-opts)))

  (let* ((sentence     (create-sentence text *DEFAULT-DICTIONARY*))
         (num-linkages (parse-sentence sentence *DEFAULT-OPTS*)))
    (when (= num-linkages 0)
      (begin
        (set-min-null-count! *DEFAULT-OPTS*  1)
        (set-max-null-count! *DEFAULT-OPTS* (sentence-length sentence))
        (set! num-linkages (parse-sentence sentence *DEFAULT-OPTS*))))
    
    (let loop ((words       (list))
               (links       (list))
               (diagrams    (list))
               (postscripts (list))
               (index    0))
      (let-values (((w l d p) (find-linkage sentence *DEFAULT-OPTS* index)))
        (if (>= (+ index 1) num-linkages)
            (begin
              (delete-sentence! sentence)
              (values (append words       w)
                      (append links       l)
                      (append diagrams    d)
                      (append postscripts p)))
            (loop (append words       w)
                  (append links       l)
                  (append diagrams    d)
                  (append postscripts p)
                  (+ index 1)))))))

(define *DEFAULT-DICTIONARY* #f)
(define *DEFAULT-OPTS*       #f)

(define (delete-default-dictionary!)
  (delete-dictionary! *DEFAULT-DICTIONARY*))

(define (delete-default-opts!)
  (delete-parse-options! *DEFAULT-OPTS*))

(define (split-word-tags str)
  (let* ((val (string-split str "."))
         (len (length val)))
    (if (> len 1)
	(cons (car val) (cadr val))
	(cons (car val) "-"))))

(define (linkage->sexp linkage index)
  (let* ((left-index  (get-lword linkage index))
         (right-index (get-rword linkage index))
         (left        (get-word linkage left-index))
         (right       (get-word linkage right-index))
         (num-words   (num-words linkage))
         (words       (get-words linkage))
         (label       (link-label linkage index))
         (opt         (list->string
                       (filter char-upper-case?
                               (string->list label))))
         (args        (list->string
                       (filter char-lower-case? 
                               (string->list label))))
         (left-word   (split-word-tags left))
         (right-word  (split-word-tags right))
         (result     `((,opt         . ,args)
                       (,left-index  . ,(cdr  left-word ))
                       (,right-index . ,(cdr right-word)))))
    (list result)))

(define (find-linkage sentence *DEFAULT-OPTS* index)
  (let* ((links-found (linkages-found sentence))
         (linkage     (create-linkage index sentence *DEFAULT-OPTS*)))
    (if linkage
	(let* ((links        (list))
               (constituents (get-constituents linkage display-single-line))
               (diagram      (get-diagram linkage #t 100))
               (len          (num-links linkage))
               (cnt          0)
               (words        (get-words linkage)))
          (do-while (< cnt len)
                    (set! links (append links (linkage->sexp linkage cnt)))
                    (set! cnt (+ cnt 1)))
          (values (list words)
                  (list links)
                  (list diagram)
                  (list (get-postscript linkage #t #t))))
	(values (list)
		(list)
		(list)
		(list)))))

(define (create-default-opts)
  (let ((opts (init-opts)))
    (set-linkage-limit!  opts 1000)
    (set-short-length!   opts 10)
    (set-verbosity!      opts 1)
    (set-max-parse-time! opts 30)
    (set-linkage-limit!  opts 1000)
    (set-min-null-count! opts 0)
    (set-max-null-count! opts 0)
    (set-short-length!   opts 16)
    (set-islands-ok!     opts #f)
    opts))

;;;  ____             _                           
;;; / ___|  ___ _ __ | |_ ___ _ __   ___ ___  ___ 
;;; \___ \ / _ \ '_ \| __/ _ \ '_ \ / __/ _ \/ __|
;;;  ___) |  __/ | | | ||  __/ | | | (_|  __/\__ \
;;; |____/ \___|_| |_|\__\___|_| |_|\___\___||___/

(define create-sentence
  (foreign-lambda sentence "sentence_create" c-string dictionary))

(define delete-sentence!
  (foreign-lambda void "sentence_delete" sentence))

(define split-sentence
  (foreign-lambda int "sentence_split" sentence parse-options))

(define parse-sentence
  (foreign-lambda int "sentence_parse" sentence parse-options))

(define sentence-length
  (foreign-lambda int "sentence_length" sentence))

(define sentence-null-count
  (foreign-lambda int "sentence_null_count" sentence))

(define linkages-found
  (foreign-lambda int "sentence_num_linkages_found" sentence))

(define valid-linkages
  (foreign-lambda int "sentence_num_valid_linkages" sentence))

(define linkages-post-processed 
  (foreign-lambda int "sentence_num_linkages_post_processed" sentence))

(define linkages-violated
  (foreign-lambda int "sentence_num_violations" sentence int))

(define sentence-disjunct-cost 
  (foreign-lambda int "sentence_disjunct_cost" sentence int))

(define sentence-link-cost
  (foreign-lambda int "sentence_link_cost" sentence int))

;;;               ____  _      _   _                              
;;;              |  _ \(_) ___| |_(_) ___  _ __   __ _ _ __ _   _ 
;;;              | | | | |/ __| __| |/ _ \| '_ \ / _` | '__| | | |
;;;              | |_| | | (__| |_| | (_) | | | | (_| | |  | |_| |
;;;              |____/|_|\___|\__|_|\___/|_| |_|\__,_|_|   \__, |
;;;                                                         |___/ 

(define create-dictionary-with-language 
  (foreign-lambda dictionary "dictionary_create_lang" c-string))

(define create-default-dictionary
  (foreign-lambda dictionary "dictionary_create_default_lang"))

(define get-dictionary-language
  (foreign-lambda c-string "dictionary_get_lang" dictionary))

(define delete-dictionary!
  (foreign-lambda void "dictionary_delete" dictionary))

(define set-dictionary-data-dir!
  (foreign-lambda void "dictionary_set_data_dir" (const c-string))) 

(define get-dictionary-data-dir
  (foreign-lambda c-string "dictionary_get_data_dir")) 


;;;  _     _       _                         
;;; | |   (_)_ __ | | ____ _  __ _  ___  ___ 
;;; | |   | | '_ \| |/ / _` |/ _` |/ _ \/ __|
;;; | |___| | | | |   < (_| | (_| |  __/\__ \
;;; |_____|_|_| |_|_|\_\__,_|\__, |\___||___/
;;;                          |___/           

(define create-linkage
  (foreign-lambda linkage "linkage_create" size_t sentence parse-options))

(define delete-linkage! 
  (foreign-lambda void "linkage_delete" linkage))

(define num-words
  (foreign-lambda size_t "linkage_get_num_words" linkage))

(define num-links
  (foreign-lambda size_t "linkage_get_num_links" linkage))

(define link-length
  (foreign-lambda int "linkage_get_link_length" linkage size_t))

(define get-lword
  (foreign-lambda size_t "linkage_get_link_lword" linkage size_t))

(define get-rword
  (foreign-lambda size_t "linkage_get_link_rword" linkage size_t))

(define link-label
  (foreign-lambda c-string "linkage_get_link_label" linkage size_t))

(define link-llabel
  (foreign-lambda c-string "linkage_get_link_llabel" linkage size_t))

(define link-rlabel
  (foreign-lambda c-string "linkage_get_link_rlabel" linkage size_t))

(define num-domains
  (foreign-lambda int "linkage_get_link_num_domains" linkage size_t))

(define link-domain-names
  (foreign-safe-lambda* scheme-object ((linkage links) (int index))
    "const char** words = linkage_get_link_domain_names(links, index);"
    "C_word lst = C_SCHEME_END_OF_LIST, len, str, *a;"
    "int num_words = linkage_get_link_num_domains(links, index);"
    "int i;"
    "for (i = num_words - 1; i >= 0; i--) {"
    "len = strlen(words[i]);"
    "a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));"
    "str = C_string(&a, len, words[i]);"
    "lst = C_a_pair(&a, str, lst);"
    "}"
    "C_return(lst);\n"))

(define get-words
  (foreign-safe-lambda* scheme-object ((linkage links))
    "const char** words = linkage_get_words(links);"
    "C_word lst = C_SCHEME_END_OF_LIST, len, str, *a;"
    "int num_words = linkage_get_num_words(links);"
    "int i;"
    "for (i = num_words - 1; i >= 0; i--) {"
    "len = strlen(words[i]);"
    "a = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(len));"
    "str = C_string(&a, len, words[i]);"
    "lst = C_a_pair(&a, str, lst);"
    "}"
    "C_return(lst);\n"))

(define get-word
  (foreign-lambda c-string "linkage_get_word" linkage size_t))

(define disjunct-str
  (foreign-lambda c-string "linkage_get_disjunct_str" linkage size_t))

(define disjunct-cost
  (foreign-lambda number "linkage_get_disjunct_cost" linkage size_t))

(define disjunct-corpus-score
  (foreign-lambda number "linkage_get_disjunct_corpus_score" linkage size_t))

(define get-constituents
  (foreign-lambda c-string "linkage_print_constituent_tree" linkage int)) 

(define get-diagram
  (foreign-lambda c-string "linkage_print_diagram" linkage bool size_t))

(define get-postscript 
  (foreign-lambda c-string "linkage_print_postscript" linkage bool bool))

(define get-disjuncts 
  (foreign-lambda c-string "linkage_print_disjuncts" linkage))

(define get-links-domains
  (foreign-lambda c-string "linkage_print_links_and_domains" linkage))

(define unused-word-cost
  (foreign-lambda int "linkage_unused_word_cost" linkage))

(define disjunct-cost
  (foreign-lambda number "linkage_disjunct_cost" linkage))

(define link-cost
  (foreign-lambda int "linkage_link_cost" linkage))

(define corpus-cost
  (foreign-lambda number "linkage_corpus_cost" linkage))

(define get-violation-name
  (foreign-lambda c-string "linkage_get_violation_name" linkage))

(define (linkage->eps-file filename postscript)
  (with-output-to-file filename
    (lambda ()
      (format #t "~A~%" postscript))))


;;;  ____            _
;;; / ___| _   _ ___| |_ ___ _ __ ___  
;;; \___ \| | | / __| __/ _ \ '_ ` _ \ 
;;;  ___) | |_| \__ \ ||  __/ | | | | |
;;; |____/ \__, |___/\__\___|_| |_| |_|
;;;  ___       _ _   _       _ _          _   _             
;;; |_ _|_ __ (_) |_(_) __ _| (_)______ _| |_(_) ___  _ __  
;;;  | || '_ \| | __| |/ _` | | |_  / _` | __| |/ _ \| '_ \ 
;;;  | || | | | | |_| | (_| | | |/ / (_| | |_| | (_) | | | |
;;; |___|_| |_|_|\__|_|\__,_|_|_/___\__,_|\__|_|\___/|_| |_|


(define get-version
  (foreign-lambda c-string "linkgrammar_get_version"))

(define get-dictionary-version
  (foreign-lambda c-string "linkgrammar_get_dict_version" dictionary))

(define get-dictionary-locale
  (foreign-lambda c-string "linkgrammar_get_dict_locale" dictionary))

;;;  ____  _           _               ____                 _ _       
;;; |  _ \(_)___ _ __ | | __ _ _   _  |  _ \ ___  ___ _   _| | |_ ___ 
;;; | | | | / __| '_ \| |/ _` | | | | | |_) / _ \/ __| | | | | __/ __|
;;; | |_| | \__ \ |_) | | (_| | |_| | |  _ <  __/\__ \ |_| | | |_\__ \
;;; |____/|_|___/ .__/|_|\__,_|\__, | |_| \_\___||___/\__,_|_|\__|___/
;;;             |_|            |___/                                  

(define display-off          0) 
(define display-multi-line   1)
(define display-bracket-tree 2)
(define display-single-line  3)
(define display-max-styles   3)

(define set-display-morphology!
  (foreign-lambda void "parse_options_set_display_morphology" parse-options int))

(define get-display-morphology 
  (foreign-lambda int "parse_options_get_display_morphology" parse-options))

;;;  ____                        ___        _   _                 
;;; |  _ \ __ _ _ __ ___  ___   / _ \ _ __ | |_(_) ___  _ __  ___ 
;;; | |_) / _` | '__/ __|/ _ \ | | | | '_ \| __| |/ _ \| '_ \/ __|
;;; |  __/ (_| | |  \__ \  __/ | |_| | |_) | |_| | (_) | | | \__ \
;;; |_|   \__,_|_|  |___/\___|  \___/| .__/ \__|_|\___/|_| |_|___/
;;;                                  |_|                          

(define init-opts
  (foreign-lambda parse-options "parse_options_create"))

(define set-max-parse-time!
  (foreign-lambda void "parse_options_set_max_parse_time" parse-options int))

(define set-linkage-limit!
  (foreign-lambda void "parse_options_set_linkage_limit" parse-options int))

(define set-short-length! 
  (foreign-lambda void "parse_options_set_short_length" parse-options int))

(define set-disjunct-cost!
  (foreign-lambda void "parse_options_set_disjunct_cost" parse-options int))

(define set-min-null-count!
  (foreign-lambda void "parse_options_set_min_null_count" parse-options int))

(define set-max-null-count!
  (foreign-lambda void "parse_options_set_max_null_count" parse-options int))

(define reset-resources!
  (foreign-lambda void "parse_options_reset_resources" parse-options))

(define resources-exhausted?
  (foreign-lambda int "parse_options_resources_exhausted" parse-options))

(define memory-exhausted?
  (foreign-lambda int "parse_options_memory_exhausted" parse-options))

(define timer-expired?
  (foreign-lambda int "parse_options_timer_expired" parse-options))

(define set-islands-ok!
  ;;; For example, the following linkage has an island:   
  ;;;
  ;;; +------Wd-----+"
  ;;; |     +--Dsu--+---Ss--+-Paf-+      +--Dsu--+---Ss--+--Pa-+
  ;;; |     |       |       |     |      |       |       |     |
  ;;; (this sentence.n is.v false.a this sentence.n is.v true.a)
  (foreign-lambda void "parse_options_set_islands_ok" parse-options bool))

(define set-verbosity!
  (foreign-lambda void "parse_options_set_verbosity" parse-options int))

(define get-verbosity
  (foreign-lambda int "parse_options_get_verbosity" parse-options))

(define delete-parse-options!
  (foreign-lambda int "parse_options_delete" parse-options ))