;;
;; chicken-link-grammar: Scheme bindings to the link grammar parsing system
;;
;; Copyright © 2017  David Ireland. 
;; All rights reserved. 
;;
;; | --------------------------------------------------------------------- |
;; | Use of the link grammar parsing system is subject to the terms of the | 
;; | license set forth in the LICENSE file included with this software.    |
;; | This license allows free redistribution and use in source and binary  |
;; | forms, with or without modification, subject to certain conditions.   |
;; | --------------------------------------------------------------------- |                                                                       
(module link-grammar 
 *
 (import foreign chicken scheme)

 (foreign-declare "#include \"link-grammar/link-includes.h\"")
 (foreign-declare "#include \"link-grammar/link-features.h\"")
 (foreign-declare "#include \"link-grammar/dict-api.h\"")
 (foreign-declare "#include \"link-grammar/dict-structures.h\"")

 ;; ----------------------------------------------------------------------------- ;;
 ;;                                   FOREIGN TYPES                               ;;
 ;; ----------------------------------------------------------------------------- ;;
 (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")))

 ;; ----------------------------------------------------------------------------- ;;
 ;;                               SYSTEM INITIALIZATION                           ;;
 ;; ----------------------------------------------------------------------------- ;;
 (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*))

 ;; ----------------------------------------------------------------------------- ;;
 ;;                           DEFINITIONS TO DISPLAY RESULTS                      ;;
 ;; ----------------------------------------------------------------------------- ;;
 (define NO-DISPLAY   0)
 (define MULTI-LINE   1)
 (define BRACKET-TREE 2)
 (define SINGLE-LINE  3)
 (define 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*))

 ;; ----------------------------------------------------------------------------- ;;
 ;;                           DEFINITIONS FOR ERROR HANDLING                      ;;
 ;; ----------------------------------------------------------------------------- ;;
 (define FATAL 1)
 (define ERROR 2)
 (define WARN  3)
 (define INFO  4)
 (define DEBUG 5)
 (define TRACE 6)
 (define NONE  7)

 ;; ----------------------------------------------------------------------------- ;;
 ;;                                   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-max-parse-time!
   (foreign-lambda void "parse_options_set_max_parse_time" parse-options* int))

 (define set-islands-ok!
   (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* ))

 ;; ----------------------------------------------------------------------------- ;;
 ;;                       FUNCTIONS TO MANIPULATE DICTIONARY                      ;;
 ;; ----------------------------------------------------------------------------- ;;
 (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-dictionary-from-utf8
   (foreign-lambda dictionary* "dictionary_create_from_utf8" c-string))

 ;; ----------------------------------------------------------------------------- ;;
 ;;                        FUNCTIONS TO MANIPULATE SENTENCES                      ;;
 ;; ----------------------------------------------------------------------------- ;;
 (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))
                        
 ;; ----------------------------------------------------------------------------- ;;
 ;;                        FUNCTIONS TO MANIPULATE LINKAGES                       ;;
 ;; ----------------------------------------------------------------------------- ;;
 (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 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-length
   (foreign-lambda int "linkage_get_link_length" 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 disjunct-str
   (foreign-lambda c-string "linkage_get_disjunct_str" linkage* size_t))

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

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

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

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

 (define delete-constituents!
   (foreign-lambda void "linkage_free_constituent_tree_str" c-string))

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

 (define delete-diagram
   (foreign-lambda void "linkage_free_diagram" c-string))

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

 (define delete-postscript
   (foreign-lambda void "linkage_free_postscript" c-string))

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

 (define delete-disjuncts
   (foreign-lambda void "linkage_free_disjuncts" c-string))

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

 (define delete-links-domains
   (foreign-lambda void "linkage_free_links_and_domains" c-string))

 (define get-pp-msgs
   (foreign-lambda c-string "linkage_print_pp_msgs" linkage*))

 (define free-pp-pmsgs
   (foreign-lambda void "linkage_free_pp_msgs" c-string))

 (define get-senses
   (foreign-lambda c-string "linkage_print_senses" linkage*))

 (define free-senses
   (foreign-lambda void "linkage_free_senses" c-string))

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

 (define disjunct-cost
   (foreign-lambda double "linkage_disjunct_cost" linkage*))

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

 (define corpus-cost
   (foreign-lambda double "linkage_corpus_cost" linkage*))

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