;;;   -*- Mode: LISP; Package: CGP; BASE: 10; Syntax: ANSI-Common-Lisp; -*-

;; Copyright (C) Paul Meurer 1999, 2000. All rights reserved.
;; paul.meurer@hit.uib.no
;; HIT-centre, University of Bergen
;;
;; Version 0.8

;;-------------------------------------------------------------------------------------
;; TO DO:
;;
;; - optimize translation of features into Lisp keywords
;; - make split char a slot in the net
;; - <aux1/perf_part> -> <aux1/perf-part> etc.
;;
;; QUESTIONS:
;;
;;-------------------------------------------------------------------------------------

(in-package "CGP")

;;; compression

#-bit-vector-coding
(defparameter *bm-feature-table* (make-hash-table :test #'equal))
#+bit-vector-coding
(defparameter *bm-feature-table* (make-hash-table))

;; features statistics

(defparameter *statistics-table* (make-hash-table))
(defparameter *cg-statistics-table* (make-hash-table))

#+test
(let ((count 0))
  (clrhash *statistics-table*)
  (u:with-file-lines (line "projects:cgp;nets;bm-lexicon.txt")
    (destructuring-bind (fullform code inflection-nr lemma+features)
                        (u:string-parse line :whitespace ":")
      (declare (ignore code inflection-nr))
      (when (zerop (mod (incf count) 1000)) (print (list count fullform)))
      (destructuring-bind (lemma &rest features)
                          (u:string-parse lemma+features :whitespace " "
                                          :delimiter-pairs '((#\" . #\")))
        (declare (ignore lemma))
        (dolist (feature (abbreviate-features features))
          (incf (gethash feature *statistics-table* 0)))))))

#+test
(let ((features-list ()))
  (maphash (lambda (key value)
             (push (cons key value) features-list))
           *statistics-table*)
  (setf *bm-ordered-simplified-features*
        (mapcar #'car (sort features-list #'> :key #'cdr))))

#+test ;; old
(let ((count 0))
  (clrhash *statistics-table*)
  (u:with-file-lines (line "projects:cgp;nets;bm-lexicon.txt")
    (destructuring-bind (fullform code inflection-nr lemma+features)
                        (u:string-parse line :whitespace ":")
      (declare (ignore code inflection-nr))
      (when (zerop (mod (incf count) 1000)) (print (list count fullform)))
      (destructuring-bind (lemma &rest features)
                          (u:string-parse lemma+features :whitespace " "
                                          :delimiter-pairs '((#\" . #\")))
        (declare (ignore lemma))
        (dolist (feature features)
          (incf (gethash feature *statistics-table* 0)))))))

;; frequency ordering
;; DON'T CHANGE!
(defparameter *bm-ordered-simplified-features*
  '(subst appell ent ub be fl mask noeyt adj verb fem tr1 pos <perf-part> m/f pres inf i1 
    sup i2 tr11 perf-part pret imp <pres-part> pass komp pa1 rl4 d5 rl9 a3 prop pa4
    rl5 tr2 pa2 d1 a6 n pa5 tr11/til unorm tr10 a8 tr5 tr12 i4 d5/til rl6 tr9 a7 n1
    pa1/til a12 tr3 d4 adv rl9/til a11 fork pa3 tr6 uboey a4 a5 i3 pr8 rl14 rl1 d6/til
    pa3/til tr15 rl15 rl3/til prep pa2/til tr8 rl3 tr7 tr18 rl12 a9 pa4/til pr9 @adv
    rl11 <s-verb> rl13 pr7 tr13 n3 d6 pref d8/til pr6 rl2 tr4 rl10 interj det d3 <tittel>
    tr19 tr21 d2 pr3 rl8 tr12/til tr23 prep+subst <ordenstall> rl7 tr20 a2 d7/til n4/til
    a15 pr10 pr13 pa5/til tr14 tr16 tr rl14/til pr1 pr2 tr17 a14 d7 rl16 rl10/til kvant
    tr22 prob d4/til pr12 d8 <aux1/perf_part> rl17 pa/til pa pa6 pr4 a13 @tittel pa1refl4
    tr13/til pa7 pr4/til n2 d9/til symb rl18 sbu dem pron poss <aux1/inf> rl17/til rl16/til
    tr21/til <adj> rl12/til @s-pred @interj pers @<subst @o-pred d11/til tr5/til rl19 vei>
    pr11 d9 </paa> n4 pa11 pa8 adj+subst hum <aux1/infinitiv> konj+adj \3 <adv> forst prep+adj
    pr5 pr10/til hop> @loes-np @<p-utfyll @obj @subj det+subst prep+subst+prep konj
    prep+adj+subst nom akk subst+kon+subst hoeflig tr22/til i a16 rl145 rl11/til tr20/til
    rl20 a10 a17 k1 k2 suff prep+subst+kon+subst @fv sp prep+prop subst+verb @iv <romertall>
    prep+subst+subst subst+subst det+adj prep+det+subst res clb prep+prep @adv> interj+adv
    verb+det konj+adv+adj \2 subst+prep+subst pron+verb+verb \1 adj+verb konj+adv+prep @i-obj
    gen @det> prep+konj+prep + subst+prep adj+det prep+adv eint adv+prep verb+verb sbu+adj
    adv+adj prep+adj+adj interj+adj subst+konj+subst konj+det+adj adv+subst verb+det+subst
    prep+perf-part+subst prep+adv+subst v+v @kon @adj> prep+det+subst+kon+det+subst
    adj+prep+subst verb+subst subst+kvant prep+subst+prep+sbu adv+adv+prep mask/fem/noeyt
    prep+det+sbu ub/be inf-merke det+adj+det <spoerreartikkel> subst+prep+adj+subst pron+prep+adj
    det+subst+prep+subst mask/fem adj+kon+adj part+prep adv+prep+subst refl adj+adj inf/pres
    prep+subst+konj+subst adv+adj+prep fl/be subst+adj subst+v+subst subst+perf-part ent/fl
    
    ;; refl4 a1 t ;; those are fishy
    ;; added after calculation below
    ukjent <semi> <kolon> samset inter bu <overskrift> <anf> <strek> <dato> <komma> >>> @sbu <<<
    <parentes-slutt> <parentes-beg> <ellipse> @infmerke
    ;; fra multi-tagger.lisp
    <PUNKT> <UTROP> <SPM> ))
                


;; find out which features are added later in the CG parser
#+test
(let ((cg-features ()))
  (maphash (lambda (set definition)
             (declare (ignore set))
             (dolist (def definition)
               (when (atom def)
                 (setf def (list def)))
               (dolist (f def)
                 (unless (or (stringp f)
                             (find f *bm-ordered-simplified-features*))
                   (pushnew f cg-features)))))
           (set-declarations *cg*))
  cg-features)

;; frequency ordering
;; DON'T CHANGE!
(defparameter *bm-ordered-features*
  '("subst" "appell" "ent" "ub" "be" "fl" "mask" "noeyt" "adj" "verb" "fem"
    "<trans1>" "pos" "<perf-part>" "m/f" "pres" "inf" "<intrans1>" "sup"
    "<intrans2>" "perf-part" "pret" "imp" "<pres-part>" "pass" "komp" "<refl4>" 
    "<trans11/paa>" "<part1/opp>" "<trans11/med>" "<adv3>" "prop" "<refl5>" 
    "<part1/ut>" "<trans2>" "<ditrans1>" "<adv6>" "<part1/sammen>" "<nullv>" 
    "<part1/inn>" "<trans11/til>" "<ditrans5/for>" "unorm" "<adv8>" "<trans10>"
    "<trans11/om>" "<trans5>" "<part1/ned>" "<ditrans5/med>" "<intrans4>" 
    "<ditrans5/til>" "<refl6>" "<trans9>" "<trans11/etter>" "<adv7>" 
    "<ditrans5/fra>" "<part1/bort>" "<nullv1>" "<trans11/over>" "<part1/til>"
    "<part1/av>" "<adv12>" "<trans3>" "<part4/opp>" "<ditrans4>" "<trans11/for>" 
    "<refl9/med>" "adv" "<trans11/opp>" "<part2/opp>" "<refl9/til>" "<adv11>" "fork"
    "<trans6>" "<trans11/i>" "uboey" "<adv4>" "<refl9/paa>" "<adv5>" "<intrans3>" 
    "<predik8>" "<part4/ut>" "<part2/ut>" "<refl1>" "<ditrans5/i>" "<part5/opp>"
    "<trans11/mot>" "<ditrans6/til>" "<trans11/ut>" "<trans11/av>" "<part3/til>" 
    "<refl9/for>" "<part4/av>" "<refl3/til>" "<part4/ned>" "<ditrans5/paa>" "prep"
    "<part2/sammen>" "<part2/til>" "<ditrans5/om>" "<trans8>" "<part5/ut>"
    "<part1/fram>" "<refl15>" "<ditrans5/av>" "<part1/igjen>" "<trans7>"
    "<part1/vekk>" "<trans18>" "<refl9/mot>" "<refl9/over>" "<ditrans5/mot>" 
    "<part3/i>" "<adv9>" "<trans12/paa>" "<part4/til>" "<predik9>" "@adv" "<refl9/om>"
    "<part4/fram>" "<part1/fast>" "<s-verb>" "<refl14/av>" "<predik7>" "<part4/paa>"
    "<part4/bort>" "<part1/paa>" "<refl12/over>" "<trans15/etter>" "<part1/over>"
    "<refl9/i>" "<part4/over>" "<part3/fra>" "pref" "<part1/frem>" "<trans13/med>"
    "<trans11/borti>" "<refl11>" "<part4/inn>" "<refl14/paa>" "<ditrans8/til>" 
    "<nullv3/for>" "<trans12/fra>" "<trans12/av>" "<predik6>" "<part5/inn>"
    "<part2/bort>" "<part4/frem>" "<trans12/i>" "<refl2>" "<trans4>" "<part2/fast>"
    "<trans11/ut+med>" "<part5/fram>" "<part5/frem>" "interj" "<trans15/av>"
    "<part5/av>" "<part2/inn>" "<refl3/paa>" "<trans11/fra>" "<part1/sund>"
    "<ditrans5/etter>" "<refl9/fra>" "<part1/tilbake>" "<part5/paa>" "<part1/om>"
    "<trans11/mellom>" "det" "<refl13/paa>" "<ditrans3>" "<part4/sammen>" "<tittel>"
    "<ditrans2>" "<part1/istykker>" "<part2/vekk>" "<trans19>" "<trans11/opp+i>" 
    "<refl13/av>" "<part1/med>" "<trans11/inn>" "<refl8>" "<predik3>"
    "<part5/sammen>" "<part3/paa>" "<part2/loes>" "<trans12/til>" "<part1/unna>"
    "prep+subst" "<trans12/over>" "<ordenstall>" "<ditrans6/fra>" "<part5/ned>"
    "<adv2>" "<refl7>" "<refl3/for>" "<refl9/av>" "<refl12/med>" "<nullv4/til>" 
    "<trans12/for>" "<trans11/fram>" "<part2/fram>" "<ditrans7/til>"
    "<trans11/imot>" "<refl14/i>" "<adv15>" "<predik13>" "<refl10/i>"
    "<trans21/paa>" "<refl9/etter>" "<part5/til>" "<trans14>" "<trans16>" 
    "<trans11/ned>" "<trans11/under>" "<part1/igjennom>" "<part4/hen>" 
    "<refl14/til>" "<part2/ned>" "<part2/frem>" "<refl9/inn+i>" "<trans>" 
    "<part1/fra>" "<trans11/loes+paa>" "<trans12/ut+av>" "<part5/i>" "<refl14/med>"
    "<trans15/over>" "<predik1>" "<predik2>" "<ditrans5/over>" "<trans20/med>"
    "<trans11/opp+med>" "<trans11/unna>" "<trans17>" "<trans12/ut+i>" 
    "<trans11/ved>" "<part5/over>" "<trans15/for>" "<trans12/med>" "<ditrans6/om>"
    "<ditrans7>" "<part5/loes>" "<adv14>" "<refl16/over>" "<refl10/til>" "kvant"
    "prob" "<trans15/under>" "<part4/fast>" "<trans11/inn+paa>" "<trans13/paa>"
    "<ditrans4/til>" "<predik10>" "<trans11>" "<predik12>" "<aux1/perf_part>"
    "<part/opp>" "<refl9/innpaa>" "<part/til>" "<part5/unna>" "<part/av>"
    "<part1/gjennom>" "<part/ned>" "<refl9/under>" "<trans11/innpaa>" "<part1/loes>"
    "<refl11/for>" "<part1/inne>" "<trans12/om>" "<part3/med>" "<part5/etter>"
    "<refl14/fra>" "<ref15>" "<trans11/frem+med>" "<trans11/fram+med>" "<refl9>" 
    "<trans12/opp+til>" "<adv13>" "<part3/av>" "<part4/igjen>" "<part4/sund>"
    "<trans11/sammen>" "<refl9/inn>" "@tittel" "<trans12/mot>" "<trans12/mellom>"
    "<part5/igjen>" "<part1/borti>" "<part1refl4/inn>" "<part5/innom>" "<predik4/til>"
    "<part1/forbi>" "<part1refl4/sammen>" "<trans11/gjennom>" "<part4/loes>"
    "<ditrans6/i>" "<trans23/om>" "<part1refl4/opp>" "<ditrans9/til>" "<part1/i>"
    "<part4/om>" "<ditrans8>" "<trans13/til>" "<refl9/ved>" "<trans11/frem>"
    "<nullv2/for>" "<part2/paa>" "<refl3>" "<part4/utover>" "<part1/for>"
    "<part6/igjen>" "<trans12/etter>" "<refl10/etter>" "<trans11/inn+i>" 
    "<part5/fra>" "<trans15/paa>" "<part4/unna>" "symb" "<part5/bort>" "<part5/om>"
    "<part2>" "<part4/vekk>" "<trans12/ved>" "<trans12/av+fra>" "<part4/ved>"
    "<trans22/paa>" "<refl15/i>" "<refl18/i>" "<predik10/for>" "<part1/fri>"
    "<refl9/opp+til>" "<part1/imot>" "sbu" "dem" "pron" "poss" "<trans12/ut>"
    "<part1/utover>" "<refl9/ut+for>" "<trans12/av+for>" "<part1/igang>"
    "<trans12/bort+fra>" "<trans12/ut+gjennom>" "<refl17/over>" "<part4/fri>"
    "<refl11/med>" "<part5/vekk>" "<refl9/ut>" "<part5/innpaa>" "<trans11/opp+til>"
    "<trans11/innom>" "<trans12/over+av>" "<predik4/for>" "<part2/sund>" 
    "<part6/tilbake>" "<trans11/etter+for>" "<part7/i>" "<ditrans6>" "<refl12/til>"
    "<trans23/med>" "<aux1/inf>" "<part4/istykker>" "<refl17/med>" "<trans1/med>"
    "<refl17/til>" "<part5/imot>" "<trans21/til>" "<trans20/for>" "<adj>"
    "<trans11/utover>" "<part3/over>" "<refl9/opp>" "<refl10>" "<part5/under>" 
    "<ditrans5/forpart2over>" "<refl16/til>" "<part2/for>" "<refl3/ut+for>"
    "<part6/frem>" "<trans11/av+med>" "<part1/rundt>" "<part6/fram>" "<part4/etter>"
    "<trans21/i>" "@s-pred" "<trans22/i>" "@interj" "pers" "@<subst" "@o-pred"
    "<part5/forbi>" "<nullv4/over>" "<trans21/av>" "<refl3/etter>" "<trans12/opp+mot>"
    "<trans12/opp>" "<part11/opp>" "<part4/under>" "<trans11/vekk+fra>"
    "<refl19/med>" "<part5/frampaa>" "<trans11/inn+for>" "<trans11/inn+is>"
    "<part4/igjennom>" "<trans23/for>" "<part4/inne>" "<refl13>" "<ditrans11/til>"
    "<trans12/ut+mot>" "<nullv3/i>" "<part1/trans11paa>" "<ditrans9/etter>"
    "<ref9/til>" "<part2/utovert>" "<ref9/over>" "</paa>" "<part4/med>"
    "<trans11/sammen+med>" "<trans11/igjennom>" "<ditrans8/for>" "<trans21/for>"
    "vei>" "<part2/tilbake>" "<trans23/paa>" "<trans11/rundt+med>" "<part4/av9>"
    "<part2/om>" "<part8/imot>" "<refl14/under>" "<trans11/ut+for>" "<trans11/opp+om>"
    "<part5/i" "<trans11/frempaa+om>" "<refl3/med>" "<refl9/inn+paa>" "<part1/i+hop>"
    "<ditrans5/refl5>" "<trans5/til>" "<part1/ned+paa>" "<trans11/frampaa+om>"
    "<nullv3/paa>" "<ref9/med>" "<trans11/av+paa>" "<trans23/etter>" "<part1/etter>"
    "<trans22/av>" "<part1/naer>" "<refl12/for>" "<trans11/ned+paa>" "<part2/unna>"
    "<trans12/bakover>" "<ditrans9/fra>" "<part5/rundt>" "<trans12/framover>"
    "<trans11/bort+fra>" "<part4/akterut>" "<part1/av+paa>" "<part5/mot>" "<part5/frempaa>"
    "<refl9/ut+i>" "<refl9/ned+i>" "<ditrans4/av>" "<part4/utfor>" "<part4/rundt>"
    "<refl3/mot>" "<refl9/bort>" "adj+subst" "hum" "<aux1/infinitiv>" "konj+adj"
    "3" "forst" "<adv>" "prep+adj" "<part1/>" "<ditrans6/med>" "<part5/gjennom>"
    "<refl9/fram+til>" "<trans12/under>" "<part4/ut+av>" "<refl3/fra>"
    "<part5/omkring>" "<trans12/hos>" "<part7/fra>" "<trans11/opp+under>"
    "<trans11/paa+med>" "<refl9/fast+i>" "<part2/igjennom>" "<refl13/fra>"
    "<predik5>" "<part1/i" "<trans11/opp+etter>" "<trans12/igjen>"
    "<trans12/inne+med>" "<trans11/ut+om>" "<refl9/frem+til>" "<part6/imot>" 
    "<ditrans1/med>" "<part5/igjennom>" "hop>" "<ditrans6/for>" "<trans11/til+med>"
    "<predik11/igjennom>" "<trans11/opp+paa>" "<refl9/av+med>" "<part5/inn+i>"
    "<trans12/opp+for>" "<refl9/opp+paa>" "<predik10/til>" "<part5/unnatrans11forbi>"
    "<predik11/gjennom>" "<predik4/i>" "<part5/inne>" "<part4/fra>" "<refl9/til+med>"
    "@<p-utfyll" "<trans5/med>" "@loes-np" "<trans15/med>" "@obj" "<trans15/ved>"
    "@subj" "det+subst" "prep+subst+prep" "konj" "<trans12/imot>" "akk"
    "<ditrans5/imot>" "nom" "<part6/tibake>" "prep+adj+subst" "subst+kon+subst"
    "hoeflig" "<trans12/sammen>" "<refl9/inn+blandt>" "<ditrans4/om>" "<part2/igjen>"
    "<adv10>" "<trans11/tilbake>" "<predik4/med>" "<trans22/om>" "<part5/tilbake>"
    "<trans23/i>" "<ditrans5/ut+av>" "<part1/mot>" "<trans11/inn+til>" "<refl3/om>"
    "<part1/veekk>" "<part5/i+gang>" "<trans5/fra>" "<part1/|opp>"
    "<trans11/frem+til>" "<refl11/til>" "<trans20/paa>" "<ditrans5/foran>"
    "<trans11/rundt>" "<refl20/etter>" "<adv17/om>" "<trans11/ut+av>"
    "<ditrans5/framfor>" "<part1/opp+for>" "<trans12/fast+i>" "<intrans>" "<trans12/opp+med>"
    "<refl9/till>" "<trans22/til>" "<refl9/ut+gjennom>" "<part4/ned+i>"
    "<trans11/igjen>" "<trans12/unna+for>" "<refl11/paa>" "<trans23/i+med>"
    "<part2/rundt>" "<trans20/til>" "<trans19/paa>" "<part1/samme>"
    "<refl9/opp+i>" "<refl10/for>" "<trans11/fram+til>" "<ditrans5/fremfor>"
    "<refl3/ved>" "<ditrans5/mellom>" "<predik11/frem>" "<part1/ute>"
    "<ditrans5/ut+fra>" "<adv16>" "<trans11/fra+om>" "<predik11/fram>"
    "<refl10/fra>" "<refl9/fraa>" "<refl145/fra>" "<refl10/paa>" "<refl11/over>"
    "<ditrans5/under>" "<part2/fri>" "<ditrans5/inn+til>" "suff" "<kaus1>"
    "<kaus2>" "prep+subst+kon+subst" "sp" "@fv" "@iv" "subst+verb"
    "prep+prop" "prep+subst+subst" "<romertall>" "res" "prep+det+subst"
    "det+adj" "subst+subst" "clb" "<trans22/med>" "prep+prep" "verb+det"
    "interj+adv" "subst+prep+subst" "1" "konj+adv+adj" "2" "pron+verb+verb"
    "konj+adv+prep" "@adv>" "adj+verb" "@i-obj" "+" "@det>" "prep+konj+prep"
    "adj+det" "prep+adv" "subst+prep" "gen" "v+v" "interj+adj" "sbu+adj"
    "prep+adv+subst" "@kon" "eint" "subst+konj+subst" "prep+adj+adj" "@adj>"
    "prep+perf-part+subst" "adv+subst" "perf-part." "adv+prep" "verb+verb"
    "verb+det+subst" "konj+det+adj" "adv+adj" "pron+prep+adj" "prep+det+sbu"
    "ub/be" "det+subst+prep+subst" "det+adj+det" "adv+prep+subst" "adj+prep+subst"
    "mask/fem/noeyt" "adv+adv+prep" "prep+subst+konj+subst" "part+prep" "fl/be"
    "subst+v+subst" "prep+subst+prep+sbu" "inf-merke" "verb+subst" 
    "<spoerreartikkel>" "adj+kon+adj" "prep+det+subst+kon+det+subst" "subst+adj"
    "mask/fem" "adj+adj" "adv+adj+prep" "ent/fl" "subst+perf-part"
    "subst+prep+adj+subst" "subst+kvant" "refl" "inf/pres"))

;; ordered by frequency
#-bit-vector-coding
(loop for i from 0
      for feature in ;; 71
      *bm-ordered-features*
      do (setf (gethash (string-downcase feature) *bm-feature-table*) i))

#+bit-vector-coding
(loop for i from 0
      for feature in ;; 71
      *bm-ordered-simplified-features*
      do (setf (gethash feature *bm-feature-table*) i))

#-bit-vector-coding
(defun feature-code (feature)
  (let ((feature-name (string-downcase (if (stringp feature)
                                         feature
                                         (symbol-name feature)))))
    (gethash feature-name *bm-feature-table*)))

#+bit-vector-coding
(defun feature-code (feature)
  (gethash feature *bm-feature-table*))

;; inverse of previous
(defparameter *bm-feature-vector* (make-array (hash-table-count *bm-feature-table*)))
(maphash (lambda (cat code) (setf (aref *feature-vector* code) cat))
         *bm-feature-table*)

(defparameter *code-vector-length* (length *feature-vector*))

(defparameter *code-vector-sort-array* (make-array *code-vector-length*))

(defun code-feature (code)
  (svref *feature-vector* code))

;(code-feature (feature-code 'konj))

(defun has-feature-p (feature-vector feature)
  (= 1 (sbit feature-vector (the fixnum (feature-code feature)))))

(defun has-features-p (feature-vector features)
  (loop for feature in features
        always (has-feature-p feature-vector feature)))

(defun thereis-feature-p (feature-vector features)
  "Checks if FEATURE-VECTOR has at least one of features"
  (loop for feature in features
        thereis (has-feature-p feature-vector feature)))

(defun has-feature-code-p (feature-vector code)
  (declare (fixnum code))
  (= 1 (the fixnum (sbit feature-vector code))))

(defun has-feature-codes-p (feature-vector codes)
  (loop for code fixnum in codes
        always (has-feature-code-p feature-vector code)))

(defun thereis-feature-code-p (feature-vector codes)
  (loop for code fixnum in codes
        thereis (has-feature-code-p feature-vector code)))

(defparameter *simplify-subcats-p* t)

#+test
(length (code-features (make-array 679 :element-type 'bit :initial-element 1))) ; -> 309

(defparameter *string-to-symbol-table* (make-hash-table :test #'equal))

(defun %intern (string)
  (or (gethash string *string-to-symbol-table*)
      (setf (gethash string *string-to-symbol-table*)
            (intern (string-upcase string) :cgp))))

#-bit-vector-coding
(defun code-features (code-bv)
  "Returns a list of features, in order determined by *CODE-VECTOR-SORT-ARRAY*. Abbreviates some features."
  (let ((used-abbrevs ()))
    (macrolet ((has-feature-p (features) ; true if has one of the features
                 `(find-if (lambda (f) (= 1 (sbit code-bv (feature-code f))))
                           ,features))
               (starts-with-p (pfx string) ;; pfx has to be a constant!
                  `(let ((pfx-length (length ,pfx)))
                     (and (<= pfx-length (length ,string))
                          (string= ,pfx ,string :end2 pfx-length))))
               (abbreviate-feature (pfx abbr fstr)
                  `(when (and (starts-with-p ,pfx ,fstr)
                              (string/= ,fstr "<ADV>"))
                     (let* ((pfx-length (length ,pfx))
                            (slash-pos (position #\/ ,fstr))
                            (angle-pos (position #\> ,fstr))
                            (feature-sfx (cond ((null slash-pos)
                                                (subseq ,fstr pfx-length angle-pos))
                                               ((string= ,fstr "TIL" :start1 (1+ slash-pos) :end1 angle-pos)
                                                (subseq ,fstr pfx-length angle-pos))
                                               (t
                                                (subseq ,fstr pfx-length slash-pos))))
                            (abbreviation (%intern (u:concat ,abbr feature-sfx))))
                       (unless (find abbreviation used-abbrevs) ; don't collect an abbrev twice
                         (u:collect abbreviation)
                         (push abbreviation used-abbrevs))
                       (return-from abbreviate)))))
      (u:collecting
        (loop for pos across *code-vector-sort-array* for bit = (sbit code-bv pos)
              do
              (when (= bit 1)
                (let* ((feature-string (string-upcase (code-feature pos)))
                       (feature (%intern feature-string)))
                  (declare (dynamic-extent feature-string))
                  (cond ((not *simplify-subcats-p*)
                         (u:collect feature))
                        (t
                         (block abbreviate
                           (mapc (lambda (prefix abbr) (abbreviate-feature prefix abbr feature-string))
                                 '("<DITRANS" "<INTRANS" "<KAUS" "<NULLV" "<PART" "<PREDIK" "<REF15" "<REF9" "<REFL" "<TRANS" "<ADV")
                                 '("D" "I" "K" "N" "PA" "PR" "RL15" "RL9" "RL" "TR" "A"))
                           ;; collect feature only if feature was not abbreviated; in the case of abbreviation 
                           ;; we jumped out in the macro
                           (u:collect feature)))))))))))

#+bit-vector-coding
(defun code-features (code-bv)
  "Returns a list of features, in order determined by *CODE-VECTOR-SORT-ARRAY* ."
  (u:collecting
    (loop for pos across *code-vector-sort-array*
          for bit = (sbit code-bv pos)
          do (when (= bit 1) (u:collect (code-feature pos))))))

(defun abbreviate-features (features)
  (let ((used-abbrevs ()))
    (macrolet ((starts-with-p (pfx string) ;; pfx has to be a constant!
                 `(let ((pfx-length (length ,pfx)))
                    (and (<= pfx-length (length ,string))
                         (string= ,pfx ,string :end2 pfx-length))))
               (abbreviate-feature (pfx abbr fstr)
                 `(when (and (starts-with-p ,pfx ,fstr)
                             (string/= ,fstr "<ADV>"))
                    (let* ((pfx-length (length ,pfx))
                           (slash-pos (position #\/ ,fstr))
                           (angle-pos (position #\> ,fstr))
                           (feature-sfx (cond ((null slash-pos)
                                               (subseq ,fstr pfx-length angle-pos))
                                              ((string= ,fstr "TIL" :start1 (1+ slash-pos) :end1 angle-pos)
                                               (subseq ,fstr pfx-length angle-pos))
                                              (t
                                               (subseq ,fstr pfx-length slash-pos))))
                           (abbreviation (%intern (u:concat ,abbr feature-sfx))))
                      (unless (find abbreviation used-abbrevs) ; don't collect an abbrev twice
                        (u:collect abbreviation)
                        (push abbreviation used-abbrevs))
                      (return-from abbreviate)))))
      (u:collecting
        (loop for feature-string in features
              do
              (let* ((feature (%intern (string-trim "." feature-string))))
                (cond ((not *simplify-subcats-p*)
                       (u:collect feature))
                      (t
                       (block abbreviate
                         (mapc (lambda (prefix abbr) (abbreviate-feature prefix abbr (string-upcase feature-string)))
                               '("<DITRANS" "<INTRANS" "<KAUS" "<NULLV" "<PART" "<PREDIK" "<REF15" "<REF9" "<REFL" "<TRANS" "<ADV")
                               '("D" "I" "K" "N" "PA" "PR" "RL15" "RL9" "RL" "TR" "A"))
                         ;; collect feature only if feature was not abbreviated; in the case of abbreviation 
                         ;; we jumped out in the macro
                         (u:collect feature))))))))))

#+old
(defun code-features (code-bv)
  "Returns a list of features, in order determined by *CODE-VECTOR-SORT-ARRAY*"
  (macrolet ((has-feature-p (features) ; true if has one of the features
               `(find-if (lambda (f) (= 1 (sbit code-bv (feature-code f))))
                         ,features)))
    (u:collecting
      (loop for pos across *code-vector-sort-array* for bit = (sbit code-bv pos)
            do
            (let ((feature (intern (string-upcase (code-feature pos)) :cgp)))
              (cond ((= bit 1)
                     (cond ((eq feature 'm/f)
                            nil)
                           (
                            )
                           (t
                            (u:collect feature))))
                    ((and (find feature '(mask fem))
                          (has-feature-p '(m/f)))
                     (u:collect feature))
                    ((and (has-feature-p '(adj))
                          ;; if gender, number or definiteness are not determined, 
                          ;; add all possibilities in proper order
                          (or (and (find feature '(ent fl))
                                   (not (has-feature-p '(ent fl))))
                              (and (find feature '(ub be))
                                   (not (has-feature-p '(ub be))))
                              (and (find feature '(mask fem noeyt))
                                   (not (has-feature-p '(mask fem noeyt m/f fl))))))
                     (u:collect feature))
                    (t nil)))))))

#+old
(defun code-features (code-bv)
  "Returns a list of features, in order determined by *CODE-VECTOR-SORT-ARRAY*"
  (let ((features
         (u:collecting
           (loop for pos across *code-vector-sort-array* for bit = (aref code-bv pos)
                 when (= bit 1)
                 do (let ((feature (intern (string-upcase (code-feature pos)) :cgp)))
                      (case feature
                        ('m/f
                         (u:collect 'mask) (u:collect 'fem))
                        (otherwise
                         (u:collect feature))))))))
    ;; if gender, number or definiteness are not determined, add all possibilities
    (when (find 'adj features)
      (unless (find-if (lambda (f) (find f '(ent fl))) features)
        (setf features (append features (list 'ent 'fl))))
      (unless (find-if (lambda (f) (find f '(ub be))) features)
        (setf features (append features (list 'ub 'be))))
      ;; not necessary for plural
      (unless (find-if (lambda (f) (find f '(mask fem noeyt fl))) features)
        (setf features (append features (list 'mask 'fem 'noeyt)))))
    features))

#+old
(defun code-features (code-bv)
  "Returns a list of features"
  (let ((features
         (u:collecting
           (loop for bit across code-bv
                 and i from 0
                 when (= bit 1)
                 do (let ((feature (intern (string-upcase (code-feature i)))))
                      (case feature
                        ('m/f
                         (u:collect 'mask) (u:collect 'fem))
                        (otherwise
                         (u:collect feature))))))))
    ;; if gender, number or definiteness are not determined, add all possibilities
    (when (find 'adj features)
      (unless (find-if (lambda (f) (find f '(ent fl))) features)
        (setf features (list* 'ent 'fl features)))
      (unless (find-if (lambda (f) (find f '(ub be))) features)
        (setf features (list* 'ub 'be features)))
      ;; not necessary for plural
      (unless (find-if (lambda (f) (find f '(mask fem noeyt fl))) features)
        (setf features (list* 'mask 'fem 'noeyt features))))
    features))

;; features order

#+only-once
(defparameter *features-order-table* (make-hash-table))

;; calculate feature order in database
#+only-once
(let ((count 0))
  (u:with-file-lines (line "projects:cgp;multitagger;bm-lexicon.txt")
    (destructuring-bind (word code inflection-nr lemma+features)
                        (u:string-parse line :whitespace ":")
      (declare (ignore code inflection-nr))
      (destructuring-bind (lemma &rest features)
                          (u:string-parse lemma+features :whitespace " "
                                          :delimiter-pairs '((#\" . #\")))
        (declare (ignore lemma))
        (loop for (f . rest)
              on (u:collecting
                   (loop for f in features
                         do (cond ((string= f "m/f")
                                   (u:collect 'mask) (u:collect 'fem))
                                  (t
                                   (u:collect (intern (string-upcase f) :cgp))))))
              do (loop for rf in rest
                       do (pushnew rf (gethash f *features-order-table*))))
        (when (zerop (mod (incf count) 1000))
          (format t "~%~5d ~a" count word))))))

;; does not work because there is no partial ordering among the features
#+ignore
(defun sort-features (features)
  (stable-sort features
               (lambda (f1 f2)
                 (let ((to-the-right (gethash (intern (string-upcase f1)) *features-order-table*))
                       (to-the-left (gethash (intern (string-upcase f2)) *features-order-table*)))
                   (and (or (find (intern (string-upcase f2)) to-the-right)
                            (not (find (intern (string-upcase f1)) to-the-left))))))))

;; ordered by hand
#-bit-vector-coding
(loop for i from 0 and f across
      #("fork" "symb" "subst" "adj" "verb" "prep" "adv" "sbu" "konj" "det" "dem" "kvant"
        "prob" "pron" "pers" "poss" "refl" "pos" "komp" "sup" "res" "<adj>" "<perf-part>" 
        "<pres-part>" "1" "2" "3" "mask" "fem" "noeyt" "m/f" "mask/fem" "appell" "prop" 
        "ub" "be" "ent" "fl" "ent/fl" "uboey" "inf" "pres" "inf/pres" "perf-part" "pret"
        "imp" "pass" "hum" "nom" "akk"  "<trans1>" "<intrans1>" "<intrans2>" "<refl4>" "<trans11/paa>"
        "<part1/opp>" "<trans11/med>" "<adv3>" "<refl5>" "<part1/ut>" "<trans2>" "<ditrans1>"
        "<adv6>" "<part1/sammen>" "<nullv>" "<part1/inn>" "<trans11/til>" "<ditrans5/for>" 
        "<adv8>" "<trans10>" "<trans11/om>" "<trans5>" "<part1/ned>" "<ditrans5/med>" 
        "<intrans4>" "<ditrans5/til>" "<refl6>" "<trans9>" "<trans11/etter>" "<adv7>"
        "<ditrans5/fra>" "<part1/bort>" "<nullv1>" "<trans11/over>" "<part1/til>" "<part1/av>"
        "<adv12>" "<trans3>" "<part4/opp>" "<ditrans4>" "<trans11/for>" "<refl9/med>" 
        "<trans11/opp>" "<part2/opp>" "<refl9/til>" "<adv11>" "<trans6>" "<trans11/i>" 
        "<adv4>" "<refl9/paa>" "<adv5>" "<intrans3>" "<predik8>" "<part4/ut>" "<part2/ut>"
        "<refl1>" "<ditrans5/i>" "<part5/opp>" "<trans11/mot>" "<ditrans6/til>" "<trans11/ut>"
        "<trans11/av>" "<part3/til>" "<refl9/for>" "<part4/av>" "<refl3/til>" "<part4/ned>"
        "<ditrans5/paa>" "<part2/sammen>" "<part2/til>" "<ditrans5/om>" "<trans8>" "<part5/ut>" 
        "<part1/fram>" "<refl15>" "<ditrans5/av>" "<part1/igjen>" "<trans7>" "<part1/vekk>"
        "<trans18>" "<refl9/mot>" "<refl9/over>" "<ditrans5/mot>" "<part3/i>" "<adv9>"
        "<trans12/paa>" "<part4/til>" "<predik9>" "@adv" "<refl9/om>" "<part4/fram>"
        "<part1/fast>" "<s-verb>" "<refl14/av>" "<predik7>" "<part4/paa>" "<part4/bort>"
        "<part1/paa>" "<refl12/over>" "<trans15/etter>" "<part1/over>" "<refl9/i>" "<part4/over>"
        "<part3/fra>" "pref" "<part1/frem>" "<trans13/med>" "<trans11/borti>" "<refl11>"
        "<part4/inn>" "<refl14/paa>" "<ditrans8/til>" "<nullv3/for>" "<trans12/fra>"
        "<trans12/av>" "<predik6>" "<part5/inn>" "<part2/bort>" "<part4/frem>" "<trans12/i>"
        "<refl2>" "<trans4>" "<part2/fast>" "<trans11/ut+med>" "<part5/fram>" "<part5/frem>"
        "interj" "<trans15/av>" "<part5/av>" "<part2/inn>" "<refl3/paa>" "<trans11/fra>"
        "<part1/sund>" "<ditrans5/etter>" "<refl9/fra>" "<part1/tilbake>" "<part5/paa>"
        "<part1/om>" "<trans11/mellom>" "<refl13/paa>" "<ditrans3>" "<part4/sammen>" "<tittel>"
        "<ditrans2>" "<part1/istykker>" "<part2/vekk>" "<trans19>" "<trans11/opp+i>"
        "<refl13/av>" "<part1/med>" "<trans11/inn>" "<refl8>" "<predik3>" "<part5/sammen>"
        "<part3/paa>" "<part2/loes>" "<trans12/til>" "<part1/unna>" "prep+subst" "<trans12/over>"
        "<ordenstall>" "<ditrans6/fra>" "<part5/ned>" "<adv2>" "<refl7>" "<refl3/for>"
        "<refl9/av>" "<refl12/med>" "<nullv4/til>" "<trans12/for>" "<trans11/fram>"
        "<part2/fram>" "<ditrans7/til>" "<trans11/imot>" "<refl14/i>" "<adv15>" "<predik13>"
        "<refl10/i>" "<trans21/paa>" "<refl9/etter>" "<part5/til>" "<trans14>" "<trans16>"
        "<trans11/ned>" "<trans11/under>" "<part1/igjennom>" "<part4/hen>" "<refl14/til>" 
        "<part2/ned>" "<part2/frem>" "<refl9/inn+i>" "<trans>" "<part1/fra>" "<trans11/loes+paa>"
        "<trans12/ut+av>" "<part5/i>" "<refl14/med>" "<trans15/over>" "<predik1>" "<predik2>"
        "<ditrans5/over>" "<trans20/med>" "<trans11/opp+med>" "<trans11/unna>" "<trans17>" 
        "<trans12/ut+i>" "<trans11/ved>" "<part5/over>" "<trans15/for>" "<trans12/med>"
        "<ditrans6/om>" "<ditrans7>" "<part5/loes>" "<adv14>" "<refl16/over>" "<refl10/til>"
        "<trans15/under>" "<part4/fast>" "<trans11/inn+paa>" "<trans13/paa>" "<ditrans4/til>"
        "<predik10>" "<trans11>" "<predik12>" "<aux1/perf_part>" "<part/opp>" "<refl9/innpaa>"
        "<part/til>" "<part5/unna>" "<part/av>" "<part1/gjennom>" "<part/ned>" "<refl9/under>"
        "<trans11/innpaa>" "<part1/loes>" "<refl11/for>" "<part1/inne>" "<trans12/om>"
        "<part3/med>" "<part5/etter>" "<refl14/fra>" "<ref15>" "<trans11/frem+med>"
        "<trans11/fram+med>" "<refl9>" "<trans12/opp+til>" "<adv13>" "<part3/av>"
        "<part4/igjen>" "<part4/sund>" "<trans11/sammen>" "<refl9/inn>" "@tittel"
        "<trans12/mot>" "<trans12/mellom>" "<part5/igjen>" "<part1/borti>" "<part1refl4/inn>" 
        "<part5/innom>" "<predik4/til>" "<part1/forbi>" "<part1refl4/sammen>"
        "<trans11/gjennom>" "<part4/loes>" "<ditrans6/i>" "<trans23/om>" "<part1refl4/opp>"
        "<ditrans9/til>" "<part1/i>" "<part4/om>" "<ditrans8>" "<trans13/til>" "<refl9/ved>"
        "<trans11/frem>" "<nullv2/for>" "<part2/paa>" "<refl3>" "<part4/utover>" "<part1/for>" 
        "<part6/igjen>" "<trans12/etter>" "<refl10/etter>" "<trans11/inn+i>" "<part5/fra>"
        "<trans15/paa>" "<part4/unna>" "<part5/bort>" "<part5/om>" "<part2>" "<part4/vekk>"
        "<trans12/ved>" "<trans12/av+fra>" "<part4/ved>" "<trans22/paa>" "<refl15/i>" 
        "<refl18/i>" "<predik10/for>" "<part1/fri>" "<refl9/opp+til>" "<part1/imot>"
        "<trans12/ut>" "<part1/utover>" "<refl9/ut+for>" "<trans12/av+for>" "<part1/igang>"
        "<trans12/bort+fra>" "<trans12/ut+gjennom>" "<refl17/over>" "<part4/fri>" "<refl11/med>"
        "<part5/vekk>" "<refl9/ut>" "<part5/innpaa>" "<trans11/opp+til>" "<trans11/innom>"
        "<trans12/over+av>" "<predik4/for>" "<part2/sund>" "<part6/tilbake>"
        "<trans11/etter+for>" "<part7/i>" "<ditrans6>" "<refl12/til>" "<trans23/med>"
        "<aux1/inf>" "<part4/istykker>" "<refl17/med>" "<trans1/med>" "<refl17/til>"
        "<part5/imot>" "<trans21/til>" "<trans20/for>" "<trans11/utover>" "<part3/over>"
        "<refl9/opp>" "<refl10>" "<part5/under>" "<ditrans5/forpart2over>" "<refl16/til>"
        "<part2/for>" "<refl3/ut+for>" "<part6/frem>" "<trans11/av+med>" "<part1/rundt>"
        "<part6/fram>" "<part4/etter>" "<trans21/i>" "@s-pred" "<trans22/i>" "@interj"
        "@<subst" "@o-pred" "<part5/forbi>" "<nullv4/over>" "<trans21/av>" "<refl3/etter>"
        "<trans12/opp+mot>" "<trans12/opp>" "<part11/opp>" "<part4/under>" "<trans11/vekk+fra>"
        "<refl19/med>" "<part5/frampaa>" "<trans11/inn+for>" "<trans11/inn+is>" "<part4/igjennom>"
        "<trans23/for>" "<part4/inne>" "<refl13>" "<ditrans11/til>" "<trans12/ut+mot>" 
        "<nullv3/i>" "<part1/trans11paa>" "<ditrans9/etter>" "<ref9/til>" "<part2/utovert>"
        "<ref9/over>" "</paa>" "<part4/med>" "<trans11/sammen+med>" "<trans11/igjennom>"
        "<ditrans8/for>" "<trans21/for>" "vei>" "<part2/tilbake>" "<trans23/paa>"
        "<trans11/rundt+med>" "<part4/av9>" "<part2/om>" "<part8/imot>" "<refl14/under>"
        "<trans11/ut+for>" "<trans11/opp+om>" "<part5/i" "<trans11/frempaa+om>" "<refl3/med>" 
        "<refl9/inn+paa>" "<part1/i+hop>" "<ditrans5/refl5>" "<trans5/til>" "<part1/ned+paa>"
        "<trans11/frampaa+om>" "<nullv3/paa>" "<ref9/med>" "<trans11/av+paa>" "<trans23/etter>"
        "<part1/etter>" "<trans22/av>" "<part1/naer>" "<refl12/for>" "<trans11/ned+paa>"
        "<part2/unna>" "<trans12/bakover>" "<ditrans9/fra>" "<part5/rundt>" "<trans12/framover>"
        "<trans11/bort+fra>" "<part4/akterut>" "<part1/av+paa>" "<part5/mot>" "<part5/frempaa>"
        "<refl9/ut+i>" "<refl9/ned+i>" "<ditrans4/av>" "<part4/utfor>" "<part4/rundt>"
        "<refl3/mot>" "<refl9/bort>" "adj+subst" "<aux1/infinitiv>" "konj+adj" "forst" "<adv>"
        "prep+adj" "<part1/>" "<ditrans6/med>" "<part5/gjennom>" "<refl9/fram+til>"
        "<trans12/under>" "<part4/ut+av>" "<refl3/fra>" "<part5/omkring>" "<trans12/hos>"
        "<part7/fra>" "<trans11/opp+under>" "<trans11/paa+med>" "<refl9/fast+i>" 
        "<part2/igjennom>" "<refl13/fra>" "<predik5>" "<part1/i" "<trans11/opp+etter>"
        "<trans12/igjen>" "<trans12/inne+med>" "<trans11/ut+om>" "<refl9/frem+til>" 
        "<part6/imot>" "<ditrans1/med>" "<part5/igjennom>" "hop>" "<ditrans6/for>"
        "<trans11/til+med>" "<predik11/igjennom>" "<trans11/opp+paa>" "<refl9/av+med>"
        "<part5/inn+i>" "<trans12/opp+for>" "<refl9/opp+paa>" "<predik10/til>"
        "<part5/unnatrans11forbi>" "<predik11/gjennom>" "<predik4/i>" "<part5/inne>"
        "<part4/fra>" "<refl9/til+med>" "@<p-utfyll" "<trans5/med>" "@loes-np" "<trans15/med>"
        "@obj" "<trans15/ved>" "@subj" "det+subst" "prep+subst+prep" "<trans12/imot>"
        "<ditrans5/imot>" "<part6/tibake>" "prep+adj+subst" "subst+kon+subst" "hoeflig"
        "<trans12/sammen>" "<refl9/inn+blandt>" "<ditrans4/om>" "<part2/igjen>" "<adv10>"
        "<trans11/tilbake>" "<predik4/med>" "<trans22/om>" "<part5/tilbake>" "<trans23/i>"
        "<ditrans5/ut+av>" "<part1/mot>" "<trans11/inn+til>" "<refl3/om>" "<part1/veekk>"
        "<part5/i+gang>" "<trans5/fra>" "<part1/|opp>" "<trans11/frem+til>" "<refl11/til>"
        "<trans20/paa>" "<ditrans5/foran>" "<trans11/rundt>" "<refl20/etter>" "<adv17/om>"
        "<trans11/ut+av>" "<ditrans5/framfor>" "<part1/opp+for>" "<trans12/fast+i>"
        "<intrans>" "<trans12/opp+med>" "<refl9/till>" "<trans22/til>" "<refl9/ut+gjennom>"
        "<part4/ned+i>" "<trans11/igjen>" "<trans12/unna+for>" "<refl11/paa>" "<trans23/i+med>"
        "<part2/rundt>" "<trans20/til>" "<trans19/paa>" "<part1/samme>" "<refl9/opp+i>"
        "<refl10/for>" "<trans11/fram+til>" "<ditrans5/fremfor>" "<refl3/ved>"
        "<ditrans5/mellom>" "<predik11/frem>" "<part1/ute>" "<ditrans5/ut+fra>" "<adv16>"
        "<trans11/fra+om>" "<predik11/fram>" "<refl10/fra>" "<refl9/fraa>" "<refl145/fra>"
        "<refl10/paa>" "<refl11/over>" "<ditrans5/under>" "<part2/fri>" "<ditrans5/inn+til>"
        "suff" "<kaus1>" "<kaus2>" "prep+subst+kon+subst" "sp" "@fv" "@iv" "subst+verb"
        "prep+prop" "prep+subst+subst" "<romertall>" "prep+det+subst" "det+adj"
        "subst+subst" "clb" "<trans22/med>" "prep+prep" "verb+det" "interj+adv"
        "subst+prep+subst" "konj+adv+adj" "pron+verb+verb" "konj+adv+prep" "@adv>"
        "adj+verb" "@i-obj" "+" "@det>" "prep+konj+prep" "adj+det" "prep+adv"
        "subst+prep" "gen" "v+v" "interj+adj" "sbu+adj" "prep+adv+subst" "@kon" "eint"
        "subst+konj+subst" "prep+adj+adj" "@adj>" "prep+perf-part+subst" "adv+subst"
        "perf-part." "adv+prep" "verb+verb" "verb+det+subst" "konj+det+adj" "adv+adj"
        "pron+prep+adj" "prep+det+sbu" "ub/be" "det+subst+prep+subst" "det+adj+det"
        "adv+prep+subst" "adj+prep+subst" "mask/fem/noeyt" "adv+adv+prep" "prep+subst+konj+subst"
        "part+prep" "fl/be" "subst+v+subst" "prep+subst+prep+sbu" "inf-merke" "verb+subst"
        "<spoerreartikkel>" "adj+kon+adj" "prep+det+subst+kon+det+subst" "subst+adj" "adj+adj"
        "adv+adj+prep" "subst+perf-part" "subst+prep+adj+subst" "subst+kvant" "unorm")
      do (setf (aref *code-vector-sort-array* i)
               (position f *feature-vector* :test #'string-equal)))

;; ordered by hand
#+bit-vector-coding
(let ((ordered-simplified-features ()))
  (loop for i from 0 to (1- (length *code-vector-sort-array*))
        do (setf (aref *code-vector-sort-array* i) i))
  (loop for f across
      #("fork" "symb" "subst" "adj" "verb" "prep" "adv" "sbu" "konj" "det" "dem" "kvant"
        "prob" "pron" "pers" "poss" "refl" "pos" "komp" "sup" "res" "<adj>" "<perf-part>" 
        "<pres-part>" "1" "2" "3" "mask" "fem" "noeyt" "m/f" "mask/fem" "appell" "prop" 
        "ub" "be" "ent" "fl" "ent/fl" "uboey" "inf" "pres" "inf/pres" "perf-part" "pret"
        "imp" "pass" "hum" "nom" "akk"  "<trans1>" "<intrans1>" "<intrans2>" "<refl4>" "<trans11/paa>"
        "<part1/opp>" "<trans11/med>" "<adv3>" "<refl5>" "<part1/ut>" "<trans2>" "<ditrans1>"
        "<adv6>" "<part1/sammen>" "<nullv>" "<part1/inn>" "<trans11/til>" "<ditrans5/for>" 
        "<adv8>" "<trans10>" "<trans11/om>" "<trans5>" "<part1/ned>" "<ditrans5/med>" 
        "<intrans4>" "<ditrans5/til>" "<refl6>" "<trans9>" "<trans11/etter>" "<adv7>"
        "<ditrans5/fra>" "<part1/bort>" "<nullv1>" "<trans11/over>" "<part1/til>" "<part1/av>"
        "<adv12>" "<trans3>" "<part4/opp>" "<ditrans4>" "<trans11/for>" "<refl9/med>" 
        "<trans11/opp>" "<part2/opp>" "<refl9/til>" "<adv11>" "<trans6>" "<trans11/i>" 
        "<adv4>" "<refl9/paa>" "<adv5>" "<intrans3>" "<predik8>" "<part4/ut>" "<part2/ut>"
        "<refl1>" "<ditrans5/i>" "<part5/opp>" "<trans11/mot>" "<ditrans6/til>" "<trans11/ut>"
        "<trans11/av>" "<part3/til>" "<refl9/for>" "<part4/av>" "<refl3/til>" "<part4/ned>"
        "<ditrans5/paa>" "<part2/sammen>" "<part2/til>" "<ditrans5/om>" "<trans8>" "<part5/ut>" 
        "<part1/fram>" "<refl15>" "<ditrans5/av>" "<part1/igjen>" "<trans7>" "<part1/vekk>"
        "<trans18>" "<refl9/mot>" "<refl9/over>" "<ditrans5/mot>" "<part3/i>" "<adv9>"
        "<trans12/paa>" "<part4/til>" "<predik9>" "@adv" "<refl9/om>" "<part4/fram>"
        "<part1/fast>" "<s-verb>" "<refl14/av>" "<predik7>" "<part4/paa>" "<part4/bort>"
        "<part1/paa>" "<refl12/over>" "<trans15/etter>" "<part1/over>" "<refl9/i>" "<part4/over>"
        "<part3/fra>" "pref" "<part1/frem>" "<trans13/med>" "<trans11/borti>" "<refl11>"
        "<part4/inn>" "<refl14/paa>" "<ditrans8/til>" "<nullv3/for>" "<trans12/fra>"
        "<trans12/av>" "<predik6>" "<part5/inn>" "<part2/bort>" "<part4/frem>" "<trans12/i>"
        "<refl2>" "<trans4>" "<part2/fast>" "<trans11/ut+med>" "<part5/fram>" "<part5/frem>"
        "interj" "<trans15/av>" "<part5/av>" "<part2/inn>" "<refl3/paa>" "<trans11/fra>"
        "<part1/sund>" "<ditrans5/etter>" "<refl9/fra>" "<part1/tilbake>" "<part5/paa>"
        "<part1/om>" "<trans11/mellom>" "<refl13/paa>" "<ditrans3>" "<part4/sammen>" "<tittel>"
        "<ditrans2>" "<part1/istykker>" "<part2/vekk>" "<trans19>" "<trans11/opp+i>"
        "<refl13/av>" "<part1/med>" "<trans11/inn>" "<refl8>" "<predik3>" "<part5/sammen>"
        "<part3/paa>" "<part2/loes>" "<trans12/til>" "<part1/unna>" "prep+subst" "<trans12/over>"
        "<ordenstall>" "<ditrans6/fra>" "<part5/ned>" "<adv2>" "<refl7>" "<refl3/for>"
        "<refl9/av>" "<refl12/med>" "<nullv4/til>" "<trans12/for>" "<trans11/fram>"
        "<part2/fram>" "<ditrans7/til>" "<trans11/imot>" "<refl14/i>" "<adv15>" "<predik13>"
        "<refl10/i>" "<trans21/paa>" "<refl9/etter>" "<part5/til>" "<trans14>" "<trans16>"
        "<trans11/ned>" "<trans11/under>" "<part1/igjennom>" "<part4/hen>" "<refl14/til>" 
        "<part2/ned>" "<part2/frem>" "<refl9/inn+i>" "<trans>" "<part1/fra>" "<trans11/loes+paa>"
        "<trans12/ut+av>" "<part5/i>" "<refl14/med>" "<trans15/over>" "<predik1>" "<predik2>"
        "<ditrans5/over>" "<trans20/med>" "<trans11/opp+med>" "<trans11/unna>" "<trans17>" 
        "<trans12/ut+i>" "<trans11/ved>" "<part5/over>" "<trans15/for>" "<trans12/med>"
        "<ditrans6/om>" "<ditrans7>" "<part5/loes>" "<adv14>" "<refl16/over>" "<refl10/til>"
        "<trans15/under>" "<part4/fast>" "<trans11/inn+paa>" "<trans13/paa>" "<ditrans4/til>"
        "<predik10>" "<trans11>" "<predik12>" "<aux1/perf_part>" "<part/opp>" "<refl9/innpaa>"
        "<part/til>" "<part5/unna>" "<part/av>" "<part1/gjennom>" "<part/ned>" "<refl9/under>"
        "<trans11/innpaa>" "<part1/loes>" "<refl11/for>" "<part1/inne>" "<trans12/om>"
        "<part3/med>" "<part5/etter>" "<refl14/fra>" "<ref15>" "<trans11/frem+med>"
        "<trans11/fram+med>" "<refl9>" "<trans12/opp+til>" "<adv13>" "<part3/av>"
        "<part4/igjen>" "<part4/sund>" "<trans11/sammen>" "<refl9/inn>" "@tittel"
        "<trans12/mot>" "<trans12/mellom>" "<part5/igjen>" "<part1/borti>" "<part1refl4/inn>" 
        "<part5/innom>" "<predik4/til>" "<part1/forbi>" "<part1refl4/sammen>"
        "<trans11/gjennom>" "<part4/loes>" "<ditrans6/i>" "<trans23/om>" "<part1refl4/opp>"
        "<ditrans9/til>" "<part1/i>" "<part4/om>" "<ditrans8>" "<trans13/til>" "<refl9/ved>"
        "<trans11/frem>" "<nullv2/for>" "<part2/paa>" "<refl3>" "<part4/utover>" "<part1/for>" 
        "<part6/igjen>" "<trans12/etter>" "<refl10/etter>" "<trans11/inn+i>" "<part5/fra>"
        "<trans15/paa>" "<part4/unna>" "<part5/bort>" "<part5/om>" "<part2>" "<part4/vekk>"
        "<trans12/ved>" "<trans12/av+fra>" "<part4/ved>" "<trans22/paa>" "<refl15/i>" 
        "<refl18/i>" "<predik10/for>" "<part1/fri>" "<refl9/opp+til>" "<part1/imot>"
        "<trans12/ut>" "<part1/utover>" "<refl9/ut+for>" "<trans12/av+for>" "<part1/igang>"
        "<trans12/bort+fra>" "<trans12/ut+gjennom>" "<refl17/over>" "<part4/fri>" "<refl11/med>"
        "<part5/vekk>" "<refl9/ut>" "<part5/innpaa>" "<trans11/opp+til>" "<trans11/innom>"
        "<trans12/over+av>" "<predik4/for>" "<part2/sund>" "<part6/tilbake>"
        "<trans11/etter+for>" "<part7/i>" "<ditrans6>" "<refl12/til>" "<trans23/med>"
        "<aux1/inf>" "<part4/istykker>" "<refl17/med>" "<trans1/med>" "<refl17/til>"
        "<part5/imot>" "<trans21/til>" "<trans20/for>" "<trans11/utover>" "<part3/over>"
        "<refl9/opp>" "<refl10>" "<part5/under>" "<ditrans5/forpart2over>" "<refl16/til>"
        "<part2/for>" "<refl3/ut+for>" "<part6/frem>" "<trans11/av+med>" "<part1/rundt>"
        "<part6/fram>" "<part4/etter>" "<trans21/i>" "@s-pred" "<trans22/i>" "@interj"
        "@<subst" "@o-pred" "<part5/forbi>" "<nullv4/over>" "<trans21/av>" "<refl3/etter>"
        "<trans12/opp+mot>" "<trans12/opp>" "<part11/opp>" "<part4/under>" "<trans11/vekk+fra>"
        "<refl19/med>" "<part5/frampaa>" "<trans11/inn+for>" "<trans11/inn+is>" "<part4/igjennom>"
        "<trans23/for>" "<part4/inne>" "<refl13>" "<ditrans11/til>" "<trans12/ut+mot>" 
        "<nullv3/i>" "<part1/trans11paa>" "<ditrans9/etter>" "<ref9/til>" "<part2/utovert>"
        "<ref9/over>" "</paa>" "<part4/med>" "<trans11/sammen+med>" "<trans11/igjennom>"
        "<ditrans8/for>" "<trans21/for>" "vei>" "<part2/tilbake>" "<trans23/paa>"
        "<trans11/rundt+med>" "<part4/av9>" "<part2/om>" "<part8/imot>" "<refl14/under>"
        "<trans11/ut+for>" "<trans11/opp+om>" "<part5/i" "<trans11/frempaa+om>" "<refl3/med>" 
        "<refl9/inn+paa>" "<part1/i+hop>" "<ditrans5/refl5>" "<trans5/til>" "<part1/ned+paa>"
        "<trans11/frampaa+om>" "<nullv3/paa>" "<ref9/med>" "<trans11/av+paa>" "<trans23/etter>"
        "<part1/etter>" "<trans22/av>" "<part1/naer>" "<refl12/for>" "<trans11/ned+paa>"
        "<part2/unna>" "<trans12/bakover>" "<ditrans9/fra>" "<part5/rundt>" "<trans12/framover>"
        "<trans11/bort+fra>" "<part4/akterut>" "<part1/av+paa>" "<part5/mot>" "<part5/frempaa>"
        "<refl9/ut+i>" "<refl9/ned+i>" "<ditrans4/av>" "<part4/utfor>" "<part4/rundt>"
        "<refl3/mot>" "<refl9/bort>" "adj+subst" "<aux1/infinitiv>" "konj+adj" "forst" "<adv>"
        "prep+adj" "<part1/>" "<ditrans6/med>" "<part5/gjennom>" "<refl9/fram+til>"
        "<trans12/under>" "<part4/ut+av>" "<refl3/fra>" "<part5/omkring>" "<trans12/hos>"
        "<part7/fra>" "<trans11/opp+under>" "<trans11/paa+med>" "<refl9/fast+i>" 
        "<part2/igjennom>" "<refl13/fra>" "<predik5>" "<part1/i" "<trans11/opp+etter>"
        "<trans12/igjen>" "<trans12/inne+med>" "<trans11/ut+om>" "<refl9/frem+til>" 
        "<part6/imot>" "<ditrans1/med>" "<part5/igjennom>" "hop>" "<ditrans6/for>"
        "<trans11/til+med>" "<predik11/igjennom>" "<trans11/opp+paa>" "<refl9/av+med>"
        "<part5/inn+i>" "<trans12/opp+for>" "<refl9/opp+paa>" "<predik10/til>"
        "<part5/unnatrans11forbi>" "<predik11/gjennom>" "<predik4/i>" "<part5/inne>"
        "<part4/fra>" "<refl9/til+med>" "@<p-utfyll" "<trans5/med>" "@loes-np" "<trans15/med>"
        "@obj" "<trans15/ved>" "@subj" "det+subst" "prep+subst+prep" "<trans12/imot>"
        "<ditrans5/imot>" "<part6/tibake>" "prep+adj+subst" "subst+kon+subst" "hoeflig"
        "<trans12/sammen>" "<refl9/inn+blandt>" "<ditrans4/om>" "<part2/igjen>" "<adv10>"
        "<trans11/tilbake>" "<predik4/med>" "<trans22/om>" "<part5/tilbake>" "<trans23/i>"
        "<ditrans5/ut+av>" "<part1/mot>" "<trans11/inn+til>" "<refl3/om>" "<part1/veekk>"
        "<part5/i+gang>" "<trans5/fra>" "<part1/|opp>" "<trans11/frem+til>" "<refl11/til>"
        "<trans20/paa>" "<ditrans5/foran>" "<trans11/rundt>" "<refl20/etter>" "<adv17/om>"
        "<trans11/ut+av>" "<ditrans5/framfor>" "<part1/opp+for>" "<trans12/fast+i>"
        "<intrans>" "<trans12/opp+med>" "<refl9/till>" "<trans22/til>" "<refl9/ut+gjennom>"
        "<part4/ned+i>" "<trans11/igjen>" "<trans12/unna+for>" "<refl11/paa>" "<trans23/i+med>"
        "<part2/rundt>" "<trans20/til>" "<trans19/paa>" "<part1/samme>" "<refl9/opp+i>"
        "<refl10/for>" "<trans11/fram+til>" "<ditrans5/fremfor>" "<refl3/ved>"
        "<ditrans5/mellom>" "<predik11/frem>" "<part1/ute>" "<ditrans5/ut+fra>" "<adv16>"
        "<trans11/fra+om>" "<predik11/fram>" "<refl10/fra>" "<refl9/fraa>" "<refl145/fra>"
        "<refl10/paa>" "<refl11/over>" "<ditrans5/under>" "<part2/fri>" "<ditrans5/inn+til>"
        "suff" "<kaus1>" "<kaus2>" "prep+subst+kon+subst" "sp" "@fv" "@iv" "subst+verb"
        "prep+prop" "prep+subst+subst" "<romertall>" "prep+det+subst" "det+adj"
        "subst+subst" "clb" "<trans22/med>" "prep+prep" "verb+det" "interj+adv"
        "subst+prep+subst" "konj+adv+adj" "pron+verb+verb" "konj+adv+prep" "@adv>"
        "adj+verb" "@i-obj" "+" "@det>" "prep+konj+prep" "adj+det" "prep+adv"
        "subst+prep" "gen" "v+v" "interj+adj" "sbu+adj" "prep+adv+subst" "@kon" "eint"
        "subst+konj+subst" "prep+adj+adj" "@adj>" "prep+perf-part+subst" "adv+subst"
        "perf-part." "adv+prep" "verb+verb" "verb+det+subst" "konj+det+adj" "adv+adj"
        "pron+prep+adj" "prep+det+sbu" "ub/be" "det+subst+prep+subst" "det+adj+det"
        "adv+prep+subst" "adj+prep+subst" "mask/fem/noeyt" "adv+adv+prep" "prep+subst+konj+subst"
        "part+prep" "fl/be" "subst+v+subst" "prep+subst+prep+sbu" "inf-merke" "verb+subst"
        "<spoerreartikkel>" "adj+kon+adj" "prep+det+subst+kon+det+subst" "subst+adj" "adj+adj"
        "adv+adj+prep" "subst+perf-part" "subst+prep+adj+subst" "subst+kvant" "unorm")
      do (pushnew (car (abbreviate-features (list f))) ordered-simplified-features))
  (loop for i from 0 and f in
        (nreverse ordered-simplified-features)
        do (setf (aref *code-vector-sort-array* i)
                 (position f *feature-vector* :test #'string-equal))))

(defun encode-features (&rest features)
  (let ((feature-code (make-array *code-vector-length* :element-type 'bit :initial-element 0)))
    (dolist (feature features)
      (let* ((code (feature-code feature)))
        (when code (setf (sbit feature-code code) 1))))
    feature-code))

(defun translate-feature (feature)
  (declare (ignore feature)))

#|
(time (dotimes (i 10000)
        (make-array *code-vector-length* :element-type 'bit :initial-element 0)))

(time
 (let* ((bit-vector (make-array *code-vector-length* :element-type 'bit :initial-element 0))
        (codes '(1 6 9 30)))
   (dolist (i '(6 9 30 50 40)) (setf (sbit bit-vector i) 1))
   (dotimes (i 10000)
     (loop for i fixnum in codes always (= (sbit bit-vector i) 1)))))

(time 
 (let ((features '(zuzu gaga fifi roro loeloe)))
   (dotimes (i 10000)
     (loop for c in '(gaga fifi roro loeloe)
           always (find c features)))))
|#

#-bit-vector-coding
(defun code-from-features (features)
  "Translates a list of features into a bit vector."
  (let ((feature-code (make-array *code-vector-length* :element-type 'bit :initial-element 0)))
    (dolist (feature features)
      (let* ((f (string-downcase feature))
             (code (gethash f *bm-feature-table*)))
        (if code
          (setf (sbit feature-code code) 1)
          (warn "Could not find code for ~s" f))))
    feature-code))

#+bit-vector-coding
(defun code-from-features (features)
  "Translates a list of features into a bit vector."
  (setf features (mapcar #'%convert-string features))
  (let ((feature-code (make-array *code-vector-length* :element-type 'bit :initial-element 0)))
    (dolist (feature (abbreviate-features features))
      (let ((code (gethash feature *bm-feature-table*)))
        (if code
          (setf (sbit feature-code code) 1)
          (warn "Could not find code for ~s" feature))))
    feature-code))

(defun set-feature (bit-vector feature)
  (setf (sbit bit-vector (feature-code feature)) 1)
  bit-vector)

;(abbreviate-features '("mask" "fem" "noeyt"))
;(code-from-features '("mask" "fem" "noeyt"))

;(code-from-features '("mask" "fem"))

(defun features-statistics (features code-vector)
  (dolist (feature features)
    (let* ((f (string-downcase (symbol-name feature)))
           (f-list (translate-feature f)))
      (cond (f-list
             (dolist (f f-list)
               (let ((code (gethash f *bm-feature-table*)))
                 (when code
                   (incf (aref code-vector code))))))
            (t 
             (let ((code (gethash f *bm-feature-table*)))
               (when code
                 (incf (aref code-vector code)))))))))

(defparameter *code-vector*
  (make-array *code-vector-length* :element-type 'fixnum :initial-element 0))

#+old
(defun bit-vector-to-string (cv)
  (let ((string (make-string (ceiling (/ (length cv) 8))))
        (byte 0))
    (loop for bit across cv
          with i = 0 and pos = 0
          do
          (when (= bit 1)
            (setf byte (logxor byte (ash 1 i))))
          (when (= (incf i) 8)
               (setf i 0 (char string pos) (code-char byte) byte 0)
               (incf pos))
          ;finally (setf (char string pos) (code-char byte))
          )
    ;; *** SOMEWHAT BUGGY
    (let ((last-non-null (position-if-not (lambda (c) (char= c #\Null))
                                      string :from-end t)))
      (if last-non-null
        (subseq string 0 (1+ last-non-null))
        ""))))

(defun bit-vector-to-string (cv)
  (let ((string (make-string (ceiling (/ (length cv) 8))))
        (byte 0))
    (loop for bit across cv
          with i = 0 and pos = 0
          do
          (when (= bit 1)
            (setf byte (logxor byte (ash 1 i))))
          (when (= (incf i) 8)
               (setf i 0
                     (char string pos) (code-char byte)
                     byte 0)
               (incf pos))
          finally (unless (zerop i)
                    (setf (char string pos) (code-char byte))))
    ;; *** SOMEWHAT BUGGY?
    (let ((last-non-null (position-if-not (lambda (c) (char= c #\Null))
                                          string :from-end t)))
      (if last-non-null
        (subseq string 0 (1+ last-non-null))
        ""))))

(defun string-to-bit-vector (string)
  (declare (optimize (speed 3) (safety 0)))
  (let ((bv (make-array *code-vector-length* :element-type 'bit :initial-element 0)))
    (loop for c across string
          for i fixnum from 0
          do (let ((byte (the fixnum (char-code c))))
               (dotimes (j 8)
                 (declare (fixnum j))
                 (unless (zerop (the fixnum (logand byte (the fixnum (ash 1 j)))))
                   (setf (sbit bv (the fixnum (+ (the fixnum (* i 8)) j))) 1)))))
    bv))

(defun array-to-bit-vector (array)
  (declare (optimize (speed 3) (safety 0)))
  (let ((bv (make-array *code-vector-length* :element-type 'bit :initial-element 0)))
    (loop for byte fixnum across array
          for i fixnum from 0
          do (dotimes (j 8)
               (declare (fixnum j))
               (unless (zerop (the fixnum (logand byte (the fixnum (ash 1 j)))))
                 (setf (sbit bv (the fixnum (+ (the fixnum (* i 8)) j))) 1))))
    bv))

#+unoptimized
(defun string-to-bit-vector (string)
  (let ((bv (make-array *code-vector-length* :element-type 'bit :initial-element 0)))
    (loop for c across string
          for i from 0
          do (let ((byte (char-code c)))
               (dotimes (j 8)
                 (unless (zerop (logand byte (ash 1 j)))
                   (setf (sbit bv (+ (* i 8) j)) 1)))))
    bv))

(defun split (string char &optional count)
  "COUNT is max number of returned chunks."
  (labels ((walk (pos)
             (let ((next-pos (position char string :start pos)))
               (if (and next-pos (or (null count) (not (zerop (decf count)))))
                 (cons (subseq string pos next-pos) (walk (1+ next-pos)))
                 (list (subseq string pos))))))
    (walk 0)))

;(split "asdf:qwer:tyui:xcvb" #\: 3)

;(pushnew :bit-vectors *features*)

(defun fullform-values (word)
  (let ((values (string-values *bm-code-lexicon* word)))
    (mapcar (lambda (value)
              (destructuring-bind (code+inflection-nr compressed-lemma feature-vector)
                                  (split value #\: 3) ;; OBS: feature vector might contain split char!
                (list* (multiple-value-call #'decimal-to-alpha 
                                            (%decode-str code+inflection-nr)) 
                       (decompress-string compressed-lemma word)
                       #-bit-vectors(code-features (string-to-bit-vector feature-vector))
                       #+bit-vectors(string-to-bit-vector feature-vector))))
            values)))

#+test
(time (dotimes (i 1000) (fullform-values "kommet")))
; #-bit-vectors (2.590 seconds, 6,424,056 bytes) 
; #+bit-vectors (2.352 seconds, 5,712,056 bytes) 

;; returns a list of feature lists
(defun fullform-features (word &optional (net *bm-lexicon*))
  (let ((values (string-values net word)))
    (mapcar (lambda (value)
              (destructuring-bind (compressed-lemma feature-vector)
                                  (split value #\: 2)
                (declare (ignore compressed-lemma))
                #-bit-vectors(code-features (string-to-bit-vector feature-vector))
                #+bit-vectors(string-to-bit-vector feature-vector)))
            values)))

#+test
(time (dotimes (i 1000) (fullform-features "kommet")))
;#-bit-vectors (0.939 seconds, 2,456,016 bytes)
;#+bit-vectors (0.796 seconds, 2,032,016 bytes) (0.948 seconds without optimizing of string-to-bit-vector)

;(lemma-and-features "se")

#+test
(time (dotimes (i 1000) (lemma-and-features "kommet")))
; 0.921 seconds, 2,256,016 bytes
#+old+old
(defun lemma-and-features (word &key decompress-base (net *bm-lexicon*))
  (declare (optimize (speed 3) (safety 0))
           (string word))
  (let ((values (string-values net word)))
    (mapcar (lambda (value)
              (destructuring-bind (compressed-lemma feature-vector)
                                  (split value #\: 2)
                (cons (decompress-string compressed-lemma (or decompress-base word))
                      #-bit-vectors(code-features (string-to-bit-vector feature-vector))
                      #+bit-vectors(string-to-bit-vector feature-vector))))
            values)))

#+old
(defun lemma-and-features (word &key decompress-base (net *bm-lexicon*))
  (declare (optimize (speed 3) (safety 0)) (string word))
  (u:collecting
    (nmap-string-values 
     net word
     (lambda (value)
       (destructuring-bind (compressed-lemma feature-vector)
                           (split value #\: 2)
         (u:collect
           (cons (decompress-string compressed-lemma (or decompress-base word))
                 #-bit-vectors(code-features (string-to-bit-vector feature-vector))
                 #+bit-vectors(string-to-bit-vector feature-vector))))))))

(defvar *%strings* (make-array 0 :adjustable t :fill-pointer t))
(defvar *%byte-arrays* (make-array 0 :adjustable t :fill-pointer t))

(defun %vector-pop (vector)
  (let* ((fill (fill-pointer vector)))
    (declare (fixnum fill))
    (unless (zerop fill) 
      (decf fill)
      (setf (fill-pointer vector) fill)
      (aref vector fill))))

(defmacro %with-string ((string) &body body)
  `(let ((,string (or (%vector-pop *%strings*)
                      (make-array 0 :element-type #+mcl 'base-character #-mcl 'character 
                                  :adjustable t :fill-pointer t))))
     (unwind-protect (progn ,@body)
       (setf (fill-pointer ,string) 0)
       (vector-push-extend ,string *%strings*))))

(defmacro %with-byte-array ((array) &body body)
  `(let ((,array (or (%vector-pop *%byte-arrays*)
                     (make-array 0 :element-type '(unsigned-byte 8) :adjustable t
                                 :fill-pointer t))))
     (unwind-protect (progn ,@body)
       (setf (fill-pointer ,array) 0)
       (vector-push-extend ,array *%byte-arrays*))))

(defun lemma-and-features (word &key decompress-base (net *bm-lexicon*))
  (declare (optimize (speed 3) (safety 0)) (string word))
  (%with-string (%string)
    (%with-byte-array (%array)
      (u:collecting
        (nmap-string+array-values
         net word
         (lambda (compressed-lemma feature-vector)
           (u:collect
             (cons (decompress-string compressed-lemma (or decompress-base word))
                   #-bit-vectors(code-features (array-to-bit-vector feature-vector))
                   #+bit-vectors(array-to-bit-vector feature-vector))))
         %string %array)))))

(defun %alpha-to-decimal (code)
  (multiple-value-bind (code form) (alpha-to-decimal code)
    (let ((int (+ (* code 16) form)))
      (with-output-to-string (stream)
        (loop with i = int
              until (zerop i)
              do (write-char (code-char (logand i 255)) stream)
              (setf i (ash i -8)))))))

(defun %decode-str (str)
  (declare (optimize (speed 3) (debug 0)))
  (let ((code 0))
    (declare (fixnum code))
    (loop for i fixnum from 0 and c across str
          do (setf code (the fixnum (+ code (the fixnum (ash (the fixnum (char-code c)) 
                                                             (the fixnum (* 8 i))))))))
    (floor code 16)))

#+old
(defun %decode-str (str)
  (let ((code 0))
    (loop for i from 0 and c across str
          do (setf code (+ code (ash (char-code c) (* 8 i)))))
    (floor code 16)))


;(time (dotimes (i 10000) (%decode-str (%alpha-to-decimal "200:3"))))

;(alpha-to-decimal "200:3")

;(multiple-value-call #'decimal-to-alpha (alpha-to-decimal "200:3"))

#| ; features frequency
826310 subst
820674 appell
540346 ent
515119 ub
471557 be
453587 fl
379957 mask
363895 noeyt
250145 adj
125571 verb
120919 fem
112882 <trans1>
 91021 pos
 83339 <perf-part>
 43586 m/f
 41796 pres
 41784 inf
 41037 <intrans1>
 36545 sup
 27363 <intrans2>
 20949 perf-part
 20945 pret
 20928 imp
 20843 <pres-part>
 20841 pass
 18279 komp
 12155 <refl4>
  8767 <trans11/paa>
  7439 <part1/opp>
  7252 <trans11/med>
  5863 <adv3>
  5103 prop
  4950 <refl5>
  4764 <part1/ut>
  4678 <trans2>
  3890 <ditrans1>
  3622 <adv6>
  3158 <part1/sammen>
  3155 <nullv>
  2982 <part1/inn>
  2948 <trans11/til>
  2926 <ditrans5/for>
  2734 unorm
  2662 <adv8>
  2662 <trans10>
  2518 <trans11/om>
  2377 <trans5>
  2321 <part1/ned>
  2271 <ditrans5/med>
  2250 <intrans4>
  2222 <ditrans5/til>
  2181 <refl6>
  2069 <trans9>
  1958 <trans11/etter>
  1848 <adv7>
  1826 <ditrans5/fra>
  1793 <part1/bort>
  1771 <nullv1>
  1710 <trans11/over>
  1639 <part1/til>
  1595 <part1/av>
  1584 <adv12>
  1553 <trans3>
  1529 <part4/opp>
  1496 <ditrans4>
  1485 <trans11/for>
  1485 <refl9/med>
  1320 adv
  1309 <trans11/opp>
  1298 <part2/opp>
  1265 <refl9/til>
  1233 <adv11>
  1200 fork
  1188 <trans6>
  1166 <trans11/i>
  1154 uboey
  1134 <adv4>
  1133 <refl9/paa>
  1099 <adv5>
  1085 <intrans3>
  1078 <predik8>
  1034 <part4/ut>
  1023 <part2/ut>
  1012 <refl1>
  1001 <ditrans5/i>
   979 <part5/opp>
   968 <trans11/mot>
   963 <ditrans6/til>
   891 <trans11/ut>
   869 <trans11/av>
   858 <part3/til>
   847 <refl9/for>
   759 <part4/av>
   737 <refl3/til>
   726 <part4/ned>
   715 <ditrans5/paa>
   706 prep
   704 <part2/sammen>
   704 <part2/til>
   704 <ditrans5/om>
   703 <trans8>
   693 <part5/ut>
   685 <part1/fram>
   682 <refl15>
   682 <ditrans5/av>
   674 <part1/igjen>
   649 <trans7>
   638 <part1/vekk>
   595 <trans18>
   594 <refl9/mot>
   572 <refl9/over>
   550 <ditrans5/mot>
   550 <part3/i>
   550 <adv9>
   539 <trans12/paa>
   531 <part4/til>
   517 <predik9>
   509 @ADV
   506 <refl9/om>
   495 <part4/fram>
   463 <part1/fast>
   456 <s-verb>
   440 <refl14/av>
   429 <predik7>
   418 <part4/paa>
   418 <part4/bort>
   397 <part1/paa>
   396 <refl12/over>
   390 <trans15/etter>
   385 <part1/over>
   385 <refl9/i>
   385 <part4/over>
   385 <part3/fra>
   369 pref
   333 <part1/frem>
   330 <trans13/med>
   330 <trans11/borti>
   330 <refl11>
   330 <part4/inn>
   330 <refl14/paa>
   319 <ditrans8/til>
   319 <nullv3/for>
   308 <trans12/fra>
   308 <trans12/av>
   308 <predik6>
   308 <part5/inn>
   308 <part2/bort>
   308 <part4/frem>
   302 <trans12/i>
   297 <refl2>
   297 <trans4>
   286 <part2/fast>
   286 <trans11/ut+med>
   286 <part5/fram>
   286 <part5/frem>
   283 interj
   279 <trans15/av>
   275 <part5/av>
   275 <part2/inn>
   275 <refl3/paa>
   264 <trans11/fra>
   264 <part1/sund>
   264 <ditrans5/etter>
   253 <refl9/fra>
   253 <part1/tilbake>
   243 <part5/paa>
   243 <part1/om>
   242 <trans11/mellom>
   242 det
   242 <refl13/paa>
   231 <ditrans3>
   231 <part4/sammen>
   225 <tittel>
   220 <ditrans2>
   220 <part1/istykker>
   220 <part2/vekk>
   210 <trans19>
   209 <trans11/opp+i>
   209 <refl13/av>
   209 <part1/med>
   198 <trans11/inn>
   198 <refl8>
   198 <predik3>
   198 <part5/sammen>
   190 <part3/paa>
   187 <part2/loes>
   187 <trans12/til>
   187 <part1/unna>
   184 prep+subst
   177 <trans12/over>
   176 <ordenstall>
   176 <ditrans6/fra>
   176 <part5/ned>
   176 <adv2>
   176 <refl7>
   176 <refl3/for>
   165 <refl9/av>
   165 <refl12/med>
   165 <nullv4/til>
   165 <trans12/for>
   165 <trans11/fram>
   165 <part2/fram>
   165 <ditrans7/til>
   165 <trans11/imot>
   154 <refl14/i>
   154 <adv15>
   154 <predik13>
   154 <refl10/i>
   143 <trans21/paa>
   143 <refl9/etter>
   143 <part5/til>
   143 <trans14>
   143 <trans16>
   143 <trans11/ned>
   143 <trans11/under>
   143 <part1/igjennom>
   132 <part4/hen>
   132 <refl14/til>
   132 <part2/ned>
   132 <part2/frem>
   132 <refl9/inn+i>
   132 <trans>
   132 <part1/fra>
   132 <trans11/loes+paa>
   132 <trans12/ut+av>
   132 <part5/i>
   132 <refl14/med>
   131 <trans15/over>
   127 <predik1>
   125 <predik2>
   121 <ditrans5/over>
   121 <trans20/med>
   121 <trans11/opp+med>
   121 <trans11/unna>
   121 <trans17>
   121 <trans12/ut+i>
   121 <trans11/ved>
   121 <part5/over>
   114 <trans15/for>
   111 <trans12/med>
   110 <ditrans6/om>
   110 <ditrans7>
   110 <part5/loes>
   110 <adv14>
   110 <refl16/over>
   110 <refl10/til>
   104 kvant
   104 prob
    99 <trans15/under>
    99 <part4/fast>
    99 <trans11/inn+paa>
    99 <trans13/paa>
    99 <ditrans4/til>
    99 <predik10>
    99 <trans11>
    99 <predik12>
    91 <aux1/perf_part>
    88 <part/opp>
    88 <refl9/innpaa>
    88 <part/til>
    88 <part5/unna>
    88 <part/av>
    88 <part1/gjennom>
    88 <part/ned>
    88 <refl9/under>
    88 <trans11/innpaa>
    88 <part1/loes>
    88 <refl11/for>
    88 <part1/inne>
    81 <trans12/om>
    77 <part3/med>
    77 <part5/etter>
    77 <refl14/fra>
    77 <ref15>
    77 <trans11/frem+med>
    77 <trans11/fram+med>
    77 <refl9>
    77 <trans12/opp+til>
    77 <adv13>
    77 <part3/av>
    77 <part4/igjen>
    77 <part4/sund>
    77 <trans11/sammen>
    77 <refl9/inn>
    74 @TITTEL
    67 <trans12/mot>
    66 <trans12/mellom>
    66 <part5/igjen>
    66 <part1/borti>
    66 <part1refl4/inn>
    66 <part5/innom>
    66 <predik4/til>
    66 <part1/forbi>
    66 <part1refl4/sammen>
    66 <trans11/gjennom>
    66 <part4/loes>
    66 <ditrans6/i>
    66 <trans23/om>
    66 <part1refl4/opp>
    66 <ditrans9/til>
    66 <part1/i>
    66 <part4/om>
    66 <ditrans8>
    66 <trans13/til>
    66 <refl9/ved>
    66 <trans11/frem>
    66 <nullv2/for>
    66 <part2/paa>
    66 <refl3>
    66 <part4/utover>
    66 <part1/for>
    58 <part6/igjen>
    57 <trans12/etter>
    55 <refl10/etter>
    55 <trans11/inn+i>
    55 <part5/fra>
    55 <trans15/paa>
    55 <part4/unna>
    55 symb
    55 <part5/bort>
    55 <part5/om>
    55 <part2>
    55 <part4/vekk>
    55 <trans12/ved>
    55 <trans12/av+fra>
    55 <part4/ved>
    55 <trans22/paa>
    55 <refl15/i>
    55 <refl18/i>
    55 <predik10/for>
    55 <part1/fri>
    55 <refl9/opp+til>
    55 <part1/imot>
    52 sbu
    50 dem
    47 pron
    46 poss
    44 <trans12/ut>
    44 <part1/utover>
    44 <refl9/ut+for>
    44 <trans12/av+for>
    44 <part1/igang>
    44 <trans12/bort+fra>
    44 <trans12/ut+gjennom>
    44 <refl17/over>
    44 <part4/fri>
    44 <refl11/med>
    44 <part5/vekk>
    44 <refl9/ut>
    44 <part5/innpaa>
    44 <trans11/opp+til>
    44 <trans11/innom>
    44 <trans12/over+av>
    44 <predik4/for>
    44 <part2/sund>
    44 <part6/tilbake>
    44 <trans11/etter+for>
    44 <part7/i>
    44 <ditrans6>
    44 <refl12/til>
    44 <trans23/med>
    44 <aux1/inf>
    44 <part4/istykker>
    44 <refl17/med>
    44 <trans1/med>
    44 <refl17/til>
    44 <part5/imot>
    44 <trans21/til>
    44 <trans20/for>
    44 <adj>
    44 <trans11/utover>
    44 <part3/over>
    44 <refl9/opp>
    44 <refl10>
    44 <part5/under>
    44 <ditrans5/forpart2over>
    44 <refl16/til>
    44 <part2/for>
    44 <refl3/ut+for>
    44 <part6/frem>
    44 <trans11/av+med>
    44 <part1/rundt>
    44 <part6/fram>
    44 <part4/etter>
    44 <trans21/i>
    41 @S-PRED
    38 <trans22/i>
    37 @INTERJ
    37 pers
    34 @<SUBST
    34 @O-PRED
    33 <part5/forbi>
    33 <nullv4/over>
    33 <trans21/av>
    33 <refl3/etter>
    33 <trans12/opp+mot>
    33 <trans12/opp>
    33 <part11/opp>
    33 <part4/under>
    33 <trans11/vekk+fra>
    33 <refl19/med>
    33 <part5/frampaa>
    33 <trans11/inn+for>
    33 <trans11/inn+is>
    33 <part4/igjennom>
    33 <trans23/for>
    33 <part4/inne>
    33 <refl13>
    33 <ditrans11/til>
    33 <trans12/ut+mot>
    33 <nullv3/i>
    33 <part1/trans11paa>
    33 <ditrans9/etter>
    33 <ref9/til>
    33 <part2/utovert>
    33 <ref9/over>
    33 </paa>
    33 <part4/med>
    33 <trans11/sammen+med>
    33 <trans11/igjennom>
    33 <ditrans8/for>
    33 <trans21/for>
    33 vei>
    33 <part2/tilbake>
    33 <trans23/paa>
    33 <trans11/rundt+med>
    33 <part4/av9>
    33 <part2/om>
    33 <part8/imot>
    33 <refl14/under>
    33 <trans11/ut+for>
    33 <trans11/opp+om>
    33 <part5/i
    33 <trans11/frempaa+om>
    33 <refl3/med>
    33 <refl9/inn+paa>
    33 <part1/i+hop>
    33 <ditrans5/refl5>
    33 <trans5/til>
    33 <part1/ned+paa>
    33 <trans11/frampaa+om>
    33 <nullv3/paa>
    33 <ref9/med>
    33 <trans11/av+paa>
    33 <trans23/etter>
    33 <part1/etter>
    33 <trans22/av>
    33 <part1/naer>
    33 <refl12/for>
    33 <trans11/ned+paa>
    33 <part2/unna>
    33 <trans12/bakover>
    33 <ditrans9/fra>
    33 <part5/rundt>
    33 <trans12/framover>
    33 <trans11/bort+fra>
    33 <part4/akterut>
    33 <part1/av+paa>
    33 <part5/mot>
    33 <part5/frempaa>
    33 <refl9/ut+i>
    33 <refl9/ned+i>
    33 <ditrans4/av>
    33 <part4/utfor>
    33 <part4/rundt>
    33 <refl3/mot>
    33 <refl9/bort>
    30 adj+subst
    29 hum
    28 <aux1/infinitiv>
    26 konj+adj
    26 3
    25 forst
    25 <adv>
    25 prep+adj
    22 <part1/>
    22 <ditrans6/med>
    22 <part5/gjennom>
    22 <refl9/fram+til>
    22 <trans12/under>
    22 <part4/ut+av>
    22 <refl3/fra>
    22 <part5/omkring>
    22 <trans12/hos>
    22 <part7/fra>
    22 <trans11/opp+under>
    22 <trans11/paa+med>
    22 <refl9/fast+i>
    22 <part2/igjennom>
    22 <refl13/fra>
    22 <predik5>
    22 <part1/i
    22 <trans11/opp+etter>
    22 <trans12/igjen>
    22 <trans12/inne+med>
    22 <trans11/ut+om>
    22 <refl9/frem+til>
    22 <part6/imot>
    22 <ditrans1/med>
    22 <part5/igjennom>
    22 hop>
    22 <ditrans6/for>
    22 <trans11/til+med>
    22 <predik11/igjennom>
    22 <trans11/opp+paa>
    22 <refl9/av+med>
    22 <part5/inn+i>
    22 <trans12/opp+for>
    22 <refl9/opp+paa>
    22 <predik10/til>
    22 <part5/unnatrans11forbi>
    22 <predik11/gjennom>
    22 <predik4/i>
    22 <part5/inne>
    22 <part4/fra>
    22 <refl9/til+med>
    21 @<P-UTFYLL
    21 <trans5/med>
    21 @LoeS-NP
    20 <trans15/med>
    20 @OBJ
    20 <trans15/ved>
    17 @SUBJ
    17 det+subst
    16 prep+subst+prep
    15 konj
    14 <trans12/imot>
    14 akk
    14 <ditrans5/imot>
    14 nom
    14 <part6/tibake>
    14 prep+adj+subst
    13 subst+kon+subst
    12 hoeflig
    11 <trans12/sammen>
    11 <refl9/inn+blandt>
    11 <ditrans4/om>
    11 <part2/igjen>
    11 <adv10>
    11 <trans11/tilbake>
    11 <predik4/med>
    11 <trans22/om>
    11 <part5/tilbake>
    11 <trans23/i>
    11 <ditrans5/ut+av>
    11 <part1/mot>
    11 <trans11/inn+til>
    11 <refl3/om>
    11 <part1/veekk>
    11 <part5/i+gang>
    11 <trans5/fra>
    11 <part1/|opp>
    11 <trans11/frem+til>
    11 <refl11/til>
    11 <trans20/paa>
    11 <ditrans5/foran>
    11 <trans11/rundt>
    11 <refl20/etter>
    11 <adv17/om>
    11 <trans11/ut+av>
    11 <ditrans5/framfor>
    11 <part1/opp+for>
    11 <trans12/fast+i>
    11 <intrans>
    11 <trans12/opp+med>
    11 <refl9/till>
    11 <trans22/til>
    11 <refl9/ut+gjennom>
    11 <part4/ned+i>
    11 <trans11/igjen>
    11 <trans12/unna+for>
    11 <refl11/paa>
    11 <trans23/i+med>
    11 <part2/rundt>
    11 <trans20/til>
    11 <trans19/paa>
    11 <part1/samme>
    11 <refl9/opp+i>
    11 <refl10/for>
    11 <trans11/fram+til>
    11 <ditrans5/fremfor>
    11 <refl3/ved>
    11 <ditrans5/mellom>
    11 <predik11/frem>
    11 <part1/ute>
    11 <ditrans5/ut+fra>
    11 <adv16>
    11 <trans11/fra+om>
    11 <predik11/fram>
    11 <refl10/fra>
    11 <refl9/fraa>
    11 <refl145/fra>
    11 <refl10/paa>
    11 <refl11/over>
    11 <ditrans5/under>
    11 <part2/fri>
    11 <ditrans5/inn+til>
    10 suff
    10 <kaus1>
    10 <kaus2>
     9 prep+subst+kon+subst
     9 sp
     9 @FV
     8 @IV
     8 subst+verb
     8 prep+prop
     7 prep+subst+subst
     7 <romertall>
     6 res
     6 prep+det+subst
     6 det+adj
     6 subst+subst
     5 CLB
     5 <trans22/med>
     5 prep+prep
     4 verb+det
     4 interj+adv
     4 subst+prep+subst
     4 1
     4 konj+adv+adj
     4 2
     4 pron+verb+verb
     4 konj+adv+prep
     4 @ADV>
     4 adj+verb
     3 @I-OBJ
     3 +
     3 @DET>
     3 prep+konj+prep
     3 adj+det
     3 prep+adv
     3 subst+prep
     3 gen
     2 v+v
     2 interj+adj
     2 sbu+adj
     2 prep+adv+subst
     2 @KON
     2 eint
     2 subst+konj+subst
     2 prep+adj+adj
     2 @ADJ>
     2 prep+perf-part+subst
     2 adv+subst
     2 perf-part.
     2 adv+prep
     2 verb+verb
     2 verb+det+subst
     2 konj+det+adj
     2 adv+adj
     1 pron+prep+adj
     1 prep+det+sbu
     1 ub/be
     1 det+subst+prep+subst
     1 det+adj+det
     1 adv+prep+subst
     1 adj+prep+subst
     1 mask/fem/noeyt
     1 adv+adv+prep
     1 prep+subst+konj+subst
     1 part+prep
     1 fl/be
     1 subst+v+subst
     1 prep+subst+prep+sbu
     1 inf-merke
     1 verb+subst
     1 <spoerreartikkel>
     1 adj+kon+adj
     1 prep+det+subst+kon+det+subst
     1 subst+adj
     1 mask/fem
     1 adj+adj
     1 adv+adj+prep
     1 ent/fl
     1 subst+perf-part
     1 subst+prep+adj+subst
     1 subst+kvant
     1 refl
     1 inf/pres
|#