;;; This work is licensed under the Creative Commons
;;; Attribution-NonCommercial-ShareAlike 4.0 International License.
;;; To view a copy of this license, visit
;;; http://creativecommons.org/licenses/by-nc-sa/4.0/ or send a letter to
;;; Creative Commons, PO Box 1866, Mountain View, CA 94042, USA.

;;; Code developed after analysis of, and drawing on the content of, ACT-R code
;;; published by Lewis & Vasishth 2005 and Engelmann 2016
;;; https://github.com/felixengelmann/act-r-sentence-parser-em

;;; Procedural memory for lfgmodel.lisp
;;; Wrap-up productions

(p wrap-up-ap-reqd-ldd-obj
    !safe-eval!   (equal (type-of (chunk-slot-value-fct (chunk-in-buffer 'ap) 'dep1.gf)) 'cons)
    !safe-eval!   (equal (find-gf-match *ugflist* 'dep1.gf 'ap 'lddtype 'goal) 'obj)
    =goal>
      isa          parse
      goal-state   wrapup
      locus        ap
      lddopen      prov
    =ap>
      isa          f-rep
      dep1         =dep1chunk
      obj          reqd
    ==>
    =goal>
      lddopen      no
      lddtype      no
      ldd          no
      locus        vp
    =ap>
      obj          =dep1chunk
      dep1.gf      obj
    -ap>
  )




(p wrap-up-dep1-reqd
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      reqd
      dep1         =dep1chunk
      dep1.gf      =dep1gf
    ==>
    =vp>
      =dep1gf      =dep1chunk
  )

(p wrap-up-dep1-poss
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      poss
      dep1         =dep1chunk
      dep1.gf      =dep1gf
    ==>
    =vp>
      =dep1gf      =dep1chunk
)

(p wrap-up-dep1-orpro
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      orpro
      dep1         =dep1chunk
      dep1.gf      =dep1gf
    ==>
    =vp>
      =dep1gf      =dep1chunk
)

(p wrap-up-dep2-reqd
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      reqd
      dep2         =dep2chunk
      dep2.gf      =dep2gf
    ==>
    =vp>
      =dep2gf      =dep2chunk
  )

(p wrap-up-dep2-reqd-ldd-obj
    !safe-eval!   (equal (type-of (chunk-slot-value-fct (chunk-in-buffer 'vp) 'dep2.gf)) 'cons)
    !safe-eval!   (equal (find-gf-match *ugflist* 'dep2.gf 'vp 'lddtype 'goal) 'obj)
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
      lddopen      prov
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      obj          reqd
      dep2         =dep2chunk
    ==>
    =goal>
      lddopen      no
      lddtype      no
      ldd          no
    =vp>
      obj          =dep2chunk
      dep2.gf      obj
  )

(p wrap-up-dep2-poss
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      poss
      dep2         =dep2chunk
      dep2.gf      =dep2gf
    ==>
    =vp>
      =dep2gf      =dep2chunk
)

(p wrap-up-dep2-orpro
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      orpro
      dep2         =dep2chunk
      dep2.gf      =dep2gf
    ==>
    =vp>
      =dep2gf      =dep2chunk
)

(p wrap-up-dep2-alt
    !bind! =notalt (find-other-alt-in-buffer-chunk 'vp 'dep2.gf)
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      alt
      dep2         =dep2chunk
      dep2.gf      =dep2gf
    ==>
    =vp>
      =notalt      no
      =dep2gf      =dep2chunk
)

(p wrap-up-dep3-reqd
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      reqd
      dep3         =dep3chunk
      dep3.gf      =dep3gf
    ==>
    =vp>
      =dep3gf      =dep3chunk
  )

(p wrap-up-dep3-reqd-ldd-obj
    !safe-eval!   (equal (type-of (chunk-slot-value-fct (chunk-in-buffer 'vp) 'dep3.gf)) 'cons)
    !safe-eval!   (equal (find-gf-match *ugflist* 'dep3.gf 'vp 'lddtype 'goal) 'obj)
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
      lddopen      prov
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      obj          reqd
      dep3         =dep3chunk
    ==>
    =goal>
      lddopen      no
      lddtype      no
      ldd          no
    =vp>
      obj          =dep3chunk
      dep3.gf      obj
  )

(p wrap-up-dep3-poss
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      poss
      dep3         =dep3chunk
      dep3.gf      =dep3gf
    ==>
    =vp>
      =dep3gf      =dep3chunk
)

(p wrap-up-dep3-orpro
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      orpro
      dep3         =dep3chunk
      dep3.gf      =dep3gf
    ==>
    =vp>
      =dep3gf      =dep3chunk
)

(p wrap-up-dep3-alt
    !bind! =notalt (find-other-alt-in-buffer-chunk 'vp 'dep3.gf)
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      alt
      dep3         =dep3chunk
      dep3.gf      =dep3gf
    ==>
    =vp>
      =notalt      no
      =dep3gf      =dep3chunk
)

(p wrap-up-dep3-ldd
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      dep1         =dep1chunk
      dep1.gf      t
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      reqd
      dep3         nil
      dep3.gf      =dep3gf
    ==>
    =vp>
      df           =dep1chunk
      dep1.gf      df
      =dep3gf      =dep1chunk
      dep3         =dep1chunk
  )

(p wrap-up-dep4-reqd
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep4gf      reqd
      dep4         =dep4chunk
      dep4.gf      =dep4gf
    ==>
    =vp>
      =dep4gf      =dep4chunk
  )

(p wrap-up-dep4-poss
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep4gf      poss
      dep4         =dep4chunk
      dep4.gf      =dep4gf
    ==>
    =vp>
      =dep4gf      =dep4chunk
)

(p wrap-up-dep4-orpro
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep4gf      orpro
      dep4         =dep4chunk
      dep4.gf      =dep4gf
    ==>
    =vp>
      =dep4gf      =dep4chunk
)


(p wrap-up-dep4-alt
    !bind! =notalt (find-other-alt-in-buffer-chunk 'vp 'dep4.gf)
    =goal>
      isa          parse
      goal-state   wrapup
      locus        vp
    =vp>
      isa          f-rep
      =dep4gf      alt
      dep4         =dep4chunk
      dep4.gf      =dep4gf
    ==>
    =vp>
      =notalt      no
      =dep4gf      =dep4chunk
)

(p wrap-up-subj-prodrop-dep1
    !safe-eval! (prodrop 'subj 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      subj        orpro
      dep1        nil
      dep1.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      subj        =prochunk
      dep1        =prochunk
      dep1.gf     subj
)

(p wrap-up-subj-prodrop-dep2
    !safe-eval! (prodrop 'subj 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      subj        orpro
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      dep2        nil
      dep2.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      subj        =prochunk
      dep2        =prochunk
      dep2.gf     subj
)

(p wrap-up-subj-prodrop-dep3
    !safe-eval! (prodrop 'subj 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      subj        orpro
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      dep3        nil
      dep3.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      subj        =prochunk
      dep3        =prochunk
      dep3.gf     subj
)

(p wrap-up-subj-prodrop-dep4
    !safe-eval! (prodrop 'subj 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      subj        orpro
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      =dep3chunk
      dep3         =dep3chunk
      dep3.gf      =dep3gf
      dep4        nil
      dep4.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      subj        =prochunk
      dep4        =prochunk
      dep4.gf     subj
)


(p wrap-up-obj-prodrop-dep2
    !safe-eval! (prodrop 'obj 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      obj        orpro
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      dep2        nil
      dep2.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      obj         =prochunk
      dep2        =prochunk
      dep2.gf     obj
)

(p wrap-up-obj-prodrop-dep3
    !safe-eval! (prodrop 'obj 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      obj         orpro
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      dep3        nil
      dep3.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      obj         =prochunk
      dep3        =prochunk
      dep3.gf     obj
)

(p wrap-up-obj-prodrop-dep4
    !safe-eval! (prodrop 'obj 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      obj         orpro
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      =dep3chunk
      dep3         =dep3chunk
      dep3.gf      =dep3gf
      dep4        nil
      dep4.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      obj         =prochunk
      dep4        =prochunk
      dep4.gf     obj
)

(p wrap-up-obl-prodrop-dep3
    !safe-eval! (prodrop 'obl 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      obl         orpro
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      dep3        nil
      dep3.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      obl         =prochunk
      dep3        =prochunk
      dep3.gf     obl
)

(p wrap-up-obl-prodrop-dep4
    !safe-eval! (prodrop 'obl 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
      locus       vp
    =vp>
      isa         f-rep
      obl         orpro
      =dep1gf      =dep1chunk
      dep1         =dep1chunk
      dep1.gf      =dep1gf
      =dep2gf      =dep2chunk
      dep2         =dep2chunk
      dep2.gf      =dep2gf
      =dep3gf      =dep3chunk
      dep3         =dep3chunk
      dep3.gf      =dep3gf
      dep4        nil
      dep4.gf     nil
    ==>
    !bind! =prochunk (next-bigpro)
    =vp>
      obl         =prochunk
      dep4        =prochunk
      dep4.gf     obl
)





(p end-wrap-up-next-word-no-ldd
    !safe-eval! (compilable-empty 'retrieval)
    !safe-eval! (compilable-empty 'visual)
    =goal>
      isa          parse
      goal-state   wrapup
    - lddopen      prov
      locus        vp
    =vp>
      isa          f-rep
    - subj         reqd
    - subj         orpro
    - subj         alt
    - obj          reqd
    - obj          orpro
    - obj          alt
    - obl          reqd
    - obl          orpro
    - obl          alt
    - comp         reqd
    - comp         orpro
    - comp         alt
    ==>
    =goal>
      goal-state   find
    !safe-eval! (add-to-chunk-set 'vp); *f-rep-chunks*)
  )

(p end-wrap-up-clear-vp-no-ldd
;;; ACTION - expand vp GFs with bigger GF set
    =goal>
      isa         parse
      goal-state  wrapup
      ldd         no
    =vp>
      isa         f-rep
      - subj         reqd
      - subj         orpro
      - subj         alt
      - obj          reqd
      - obj          orpro
      - obj          alt
      - obl          reqd
      - obl          orpro
      - obl          alt
      - comp         reqd
      - comp         orpro
      - comp         alt
    =visual>
      isa         text
      value       "*"
    ==>
    =goal>
    =visual>
    !safe-eval! (add-to-chunk-set 'vp)
)

(p end-wrap-up-buffers-empty
    !safe-eval! (buffer-set-empty 'vp)
    =goal>
      isa         parse
      goal-state  wrapup
    ?vp>
      buffer      empty
    ?np>
      buffer      empty
    ?ap>
      buffer      empty
    ?aux>
      buffer      empty
    =visual>
      isa         text
      value       "*"
    ==>
    =goal>
      goal-state  finish
  )

(p continue-wrap-up-fill-vp-from-mbuffer
    !safe-eval! (not (buffer-set-empty 'vp))
    =goal>
      isa         parse
      goal-state  wrapup
    ?vp>
      buffer      empty
    ?np>
      buffer      empty
    ?ap>
      buffer      empty
    ?aux>
      buffer      empty
    =visual>
      isa         text
      value       "*"
    ==>
    =goal>
    =visual>
    !safe-eval! (fill-buffer-from-set 'vp)
  )

(p end-wrap-up-keep-processing-no-ldd
    =goal>
      isa          parse
      goal-state   wrapup
      ldd          no
    =retrieval>
    =vp>
      isa          f-rep
    - subj         reqd
    - obj          reqd
    - obl          reqd
    - comp         reqd
    ==>
    =goal>
      goal-state   create
    =retrieval>
    -vp>
    !safe-eval! (add-chunk-to-chunk-set =vp); *f-rep-chunks*)
)


(p fill-empty-vp
    !safe-eval! (one-chunk-in-buffer-set 'vp)
    !safe-eval! (compilable-empty 'vp)
    !safe-eval! (not (equal (chunk-slot-value-fct (chunk-in-buffer 'visual) 'value) "*"))
    =goal>
      isa          parse
      goal-state   wrapup
    ==>
    !safe-eval! (fill-buffer-from-set 'vp)
    =goal>
      goal-state   create
)

(p wrapup-ap-is-ma-of-np
  =goal>
    isa        parse
    goal-state wrapup
    locus      np
  =ap>
    isa        f-rep
    dep1       =np
  =np>
    isa        f-rep
    ma         =ap
  ==>
  =goal>
  =np>
)


(p wrapup-np-continue-np
  !safe-eval! (compilable-empty 'visual)
  !safe-eval! (compilable-empty 'ap)
  =goal>
    isa        parse
    goal-state wrapup
    locus      np
  =np>
    isa        f-rep
    adj.post   t
  ==>
  =goal>
    goal-state find
  =np>
)


(p wrapup-np-clear-np
  !safe-eval! (compilable-empty 'visual)
  !safe-eval! (compilable-empty 'ap)
  =goal>
    isa        parse
    goal-state wrapup
    locus      np
  =np>
    isa        f-rep
    adj.post   no
  ==>
  =goal>
    goal-state find
    locus      vp
  -np>
)

(p wrapup-at-end-np
  !safe-eval! (compilable-empty 'ap)
  =goal>
    isa        parse
    goal-state wrapup
    locus      np
  =np>
  =vp>
  =visual>
    isa        text
    value      "*"
  ==>
  =goal>
    locus      vp
  =vp>
  =visual>
)

(p wrapup-np-clear-no-vpred
  =goal>
    isa        parse
    goal-state wrapup
    locus      np
  =np>
    isa        f-rep
;    predreqd   nil
    adj.post   no
  =vp>
    isa        f-rep
    predreqd   t
  ==>
  =goal>
    goal-state find
    locus      vp
  =vp>
)
