;;; 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

(p gf-prec-is-ggf1-in-dep1-not-ldd
  !bind! =thisgf (find-gf-match *ugflist* 'ggf1 'vp 'dep1.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
    ldd no
  =vp>
    isa f-rep
    gf.prec ggf1
    ggf1.stat reqd
    dep1 =thischunk
    dep2 nil
  ==>
  =vp>
    ggf1.stat dep1
    gf.prec no
    dep1.gf =thisgf
)

(p gf-prec-is-ggf1-in-dep1-close-ldd
  !bind! =thisgf (find-gf-match *ugflist* 'ggf1 'vp 'dep1.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
    ldd  =relchunk
    lddopen open
  =vp>
    isa f-rep
    gf.prec ggf1
    ggf1.stat reqd
    dep1 =relchunk
    dep2 nil
  ==>
  =goal>
    ldd no
    lddopen no
  =vp>
    ggf1.stat dep1
    gf.prec no
    dep1.gf =thisgf
)

(p gf-prec-is-ggf1-in-dep1-ldd-open
  !bind! =thisgf (find-gf-match *ugflist* 'ggf1 'vp 'dep1.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
    ldd  =relchunk
    lddopen open
  =vp>
    isa f-rep
    gf.prec ggf1
    ggf1.stat reqd
  - dep1 =relchunk
    dep2 nil
  ==>
  =goal>
  =vp>
    ggf1.stat dep1
    gf.prec no
    dep1.gf =thisgf
)


(p gf-prec-is-ggf1-no-dep1
  !bind! =thisgf (find-gf-match *ugflist* 'ggf1 'vp 'ggf1 'vp)
  =goal>
    isa parse
    goal-state add-gfs
    lddopen no
  =vp>
    isa f-rep
    gf.prec ggf1
    ggf1.stat reqd
    dep1 nil
  ==>
  !bind! =prochunk (next-bigpro)
  =goal>
  =vp>
    ggf1.stat =prochunk
    dep1 =prochunk
    dep1.gf =thisgf
    gf.prec no
)


(p gf-prec-is-ggf1-in-dep2
  !safe-eval! (congruentp 'ggf1 'vp 'dep2.gf 'vp)
  !bind! =thisgf (find-gf-match *ugflist* 'ggf1 'vp 'dep2.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
  =vp>
    isa f-rep
    gf.prec ggf1
    ggf1.stat reqd
    dep1 =anychunk0
    dep2 =thischunk
    dep3 nil
  ==>
  =vp>
    ggf1.stat dep2
    gf.prec no
    df      =anychunk0
    dep1.gf df
    dep2.gf =thisgf
)

(p gf-prec-is-ggf1-in-dep3
  !safe-eval! (congruentp 'ggf1 'vp 'dep3.gf 'vp)
  !bind! =thisgf (find-gf-match *ugflist* 'ggf1 'vp 'dep3.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
  =vp>
    isa f-rep
    gf.prec ggf1
    ggf1.stat reqd
    dep1 =anychunk0
    dep2 =anychunk1
    dep3 =thischunk
    dep4 nil
  ==>
  =vp>
    ggf1.stat dep3
    gf.prec no
    df     =anychunk0
    dep1.gf df
    dep3.gf =thisgf
)

(p gf-prec-is-ggf1-in-dep4
  !safe-eval! (congruentp 'ggf1 'vp 'dep4.gf 'vp)
  !bind! =thisgf (find-gf-match *ugflist* 'ggf1 'vp 'dep4.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
  =vp>
    isa f-rep
    gf.prec ggf1
    ggf1.stat reqd
    dep1 =anychunk0
    dep2 =anychunk1
    dep3 =anychunk2
    dep4 =thischunk
  ==>
  =vp>
    ggf1.stat dep4
    gf.prec no
    df      =anychunk0
    dep1.gf df
    dep4.gf =thisgf
)


(p gf-prec-is-ggf2-in-dep1
  !safe-eval! (congruentp 'ggf2 'vp 'dep1.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
  =vp>
    isa f-rep
    gf.prec ggf2
    ggf2.stat reqd
    dep1 =thischunk
    dep2 nil
  ==>
  =vp>
    ggf2.stat dep1
    gf.prec no
)

(p gf-prec-is-ggf2-in-dep2
  !safe-eval! (congruentp 'ggf2 'vp 'dep2.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
  =vp>
    isa f-rep
    gf.prec ggf2
    ggf2.stat reqd
    dep1 =anychunk0
    dep2 =thischunk
    dep3 nil
  ==>
  =vp>
    ggf2.stat dep2
    gf.prec no
)

(p gf-prec-is-ggf2-in-dep3
  !safe-eval! (congruentp 'ggf2 'vp 'dep3.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
  =vp>
    isa f-rep
    gf.prec ggf2
    ggf2.stat reqd
    dep1 =anychunk0
    dep2 =anychunk1
    dep3 =thischunk
    dep4 nil
  ==>
  =vp>
    ggf2.stat dep3
    gf.prec no
)

(p gf-prec-is-ggf2-in-dep4
  !safe-eval! (congruentp 'ggf2 'vp 'dep4.gf 'vp)
  =goal>
    isa parse
    goal-state add-gfs
  =vp>
    isa f-rep
    gf.prec ggf2
    ggf2.stat reqd
    dep1 =anychunk0
    dep2 =anychunk1
    dep3 =anychunk2
    dep4 =thischunk
;  =retrieval>
  ==>
  =vp>
    ggf2.stat dep4
    gf.prec no
;  =retrieval>
)

(p add-gfpost1-as-dep1
    !bind! =word.gf.post1 (value-of-indexed-slot 'vp 'gf.post1)
    =goal>
      isa        parse
      goal-state add-gfs
    =vp>
      isa        f-rep
;      cat        Verb
      predreqd   nil
      gf.prec    no
    - gf.post1   no
      dep1       nil
      dep1.gf    nil
    ==>
    =goal>
    =vp>
     gf.post1    no
     dep1.gf     =word.gf.post1
  )

(p add-gfpost1-as-dep2
    !bind! =word.gf.post1 (value-of-indexed-slot 'vp 'gf.post1)
    =goal>
      isa        parse
      goal-state add-gfs
    =vp>
      isa        f-rep
;      cat        Verb
      predreqd   nil
      gf.prec    no
    - gf.post1   no
      dep1       =anychunk0
      dep2       nil
      dep2.gf    nil
    ==>
    =goal>
    =vp>
     gf.post1    no
     dep2.gf     =word.gf.post1
)

(p add-gfpost1-as-dep3
    !bind! =word.gf.post1 (value-of-indexed-slot 'vp 'gf.post1)
    =goal>
      isa        parse
      goal-state add-gfs
    =vp>
      isa        f-rep
;      cat        Verb
      predreqd   nil
      gf.prec    no
    - gf.post1   no
      dep1       =anychunk0
      dep2       =anychunk1
      dep3       nil
      dep3.gf    nil
    ==>
    =goal>
    =vp>
     gf.post1    no
     dep3.gf     =word.gf.post1
)

(p add-gfpost1-as-dep4
    !bind! =word.gf.post1 (value-of-indexed-slot 'vp 'gf.post1)
    =goal>
      isa        parse
      goal-state add-gfs
    =vp>
      isa        f-rep
;      cat        Verb
      predreqd   nil
      gf.prec    no
    - gf.post1   no
      dep1       =anychunk0
      dep2       =anychunk1
      dep3       =anychunk2
      dep4       nil
      dep4.gf    nil
    ==>
    =goal>
    =vp>
     gf.post1    no
     dep4.gf     =word.gf.post1
)

(p add-gfpost2-as-dep2
    !bind! =word.gf.post2 (value-of-indexed-slot 'vp 'gf.post2)
    =goal>
      isa        parse
      goal-state add-gfs
    =vp>
      isa        f-rep
;      cat        Verb
      predreqd   nil
      gf.prec    no
      gf.post1   no
    - gf.post2   no
      dep1.gf    =anychunk0
      dep2       nil
      dep2.gf    nil
    ==>
    =goal>
    =vp>
     gf.post2    no
     dep2.gf     =word.gf.post2
)

(p add-gfpost2-as-dep3
    !bind! =word.gf.post2 (value-of-indexed-slot 'vp 'gf.post2)
    =goal>
      isa        parse
      goal-state add-gfs
    =vp>
      isa        f-rep
;      cat        Verb
      predreqd   nil
      gf.prec    no
      gf.post1   no
    - gf.post2   no
      dep1.gf    =anychunk0
      dep2.gf    =anychunk1
      dep3       nil
      dep3.gf    nil
    ==>
    =goal>
    =vp>
     gf.post2    no
     dep3.gf     =word.gf.post2
)

(p add-gfpost2-as-dep4
    !bind! =word.gf.post2 (value-of-indexed-slot 'vp 'gf.post2)
    =goal>
      isa        parse
      goal-state add-gfs
    =vp>
      isa        f-rep
;      cat        Verb
      predreqd   nil
      gf.prec    no
      gf.post1   no
    - gf.post2   no
      dep1.gf    =anychunk0
      dep2.gf    =anychunk1
      dep3.gf    =anychunk2
      dep4       nil
      dep4.gf    nil
    ==>
    =goal>
    =vp>
     gf.post2    no
     dep4.gf     =word.gf.post2
)

(p vp-post-gfs-all-added-no-ldd
    =goal>
      isa        parse
      goal-state add-gfs
      locus      vp
      ldd        no
    =vp>
      isa        f-rep
      predreqd   nil
      gf.prec    no
      gf.post1   no
      gf.post2   no
    ==>
    =goal>
      goal-state attach
    =vp>
)

(p vp-post-gfs-all-added-prov-assign-ldd-dep2
    !safe-eval! (congruentp 'dep2.gf 'vp 'lddtype 'goal)
    =goal>
      isa        parse
      goal-state add-gfs
      locus      vp
      lddopen    open
      ldd        =lddchunk
    =vp>
      isa        f-rep
      predreqd   nil
      gf.prec    no
      gf.post1   no
      gf.post2   no
      deps       1
      dep2       nil
    ==>
    =goal>
      goal-state attach
      lddopen    prov
    =vp>
      dep2       =lddchunk
)

(p vp-post-gfs-all-added-prov-assign-ldd-dep3
    !safe-eval! (congruentp 'dep3.gf 'vp 'lddtype 'goal)
    =goal>
      isa        parse
      goal-state add-gfs
      locus      vp
      lddopen    open
      ldd        =lddchunk
    =vp>
      isa        f-rep
      predreqd   nil
      gf.prec    no
      gf.post1   no
      gf.post2   no
      deps       2
      dep3       nil
    ==>
    =goal>
      goal-state attach
      lddopen    prov
    =vp>
      dep3       =lddchunk
)

(p vp-post-gfs-all-added-ldd-not-dep3
    !safe-eval! (not (congruentp 'dep3.gf 'vp 'lddtype 'goal))
    =goal>
      isa        parse
      goal-state add-gfs
      locus      vp
      lddopen    open
    =vp>
      isa        f-rep
      predreqd   nil
      gf.prec    no
      gf.post1   no
      gf.post2   no
      deps       2
      dep3       nil
    ==>
    =goal>
      goal-state attach
    =vp>
)

(p ap-gf-prec-is-ggf1-in-dep1
  =goal>
    isa parse
    goal-state add-gfs
    locus ap
  =ap>
    isa f-rep
    gf.prec ggf1
    ggf1 =thisgf
    ggf1.stat reqd
    dep1 =thischunk
    gf.post1 no
;  =retrieval>
  ==>
  =goal>
    goal-state attach
  =ap>
    ggf1.stat dep1
    gf.prec no
    dep1.gf =thisgf
)

(p ap-gf-post1-is-ggf1-in-dep1-no-ldd
  =goal>
    isa parse
    goal-state add-gfs
    locus ap
    lddopen no
  =ap>
    isa f-rep
    ggf1 =thisgf
    gf.prec no
    gf.post1 ggf1
    dep1 nil
  ==>
  =goal>
    goal-state attach
  =ap>
    ggf1.stat reqd
    gf.post1 no
    dep1.gf =thisgf
)

(p ap-gf-post1-is-ggf1-in-dep1-assign-prov-ldd
  !safe-eval! (congruentp 'ggf1 'vp 'lddtype 'goal)
  =goal>
    isa parse
    goal-state add-gfs
    locus ap
    lddopen open
    ldd =thischunk
  =ap>
    isa f-rep
    ggf1 =thisgf
    gf.prec no
    gf.post1 ggf1
    dep1 nil
  ==>
  =goal>
    goal-state attach
    lddopen prov
  =ap>
    ggf1.stat reqd
    gf.post1 no
    dep1  =thischunk
    dep1.gf =thisgf
)

(p ap-gf-post1-is-ggf1-in-dep1-not-prov-ldd
  !safe-eval! (not (congruentp 'ggf1 'vp 'lddtype 'goal))
  =goal>
    isa parse
    goal-state add-gfs
    locus ap
    lddopen open
    ldd =thischunk
  =ap>
    isa f-rep
    ggf1 =thisgf
    gf.prec no
    gf.post1 ggf1
    dep1 nil
  ==>
  =goal>
    goal-state attach
  =ap>
    ggf1.stat reqd
    gf.post1 no
    dep1.gf =thisgf
)


(p undo-prov-ldd-vp-dep2
  !safe-eval! (congruentp 'dep2.gf 'vp 'post.ma.gf 'retrieval)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      vp
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =vp>
    isa        f-rep
    predreqd   nil
    dep2       =lddchunk
    deps       1
  ==>
  =goal>
    goal-state create
    lddopen    open
  =vp>
    dep2       nil
  =retrieval>
)

(p confirm-prov-ldd-vp-dep2
  !safe-eval! (not (congruentp 'dep2.gf 'vp 'post.ma.gf 'retrieval))
  !bind! =thisgf (find-gf-match *ugflist* 'lddtype 'goal 'dep2.gf 'vp)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      vp
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =vp>
    isa        f-rep
    predreqd   nil
    dep2       =lddchunk
    deps       1
  ==>
  =goal>
    goal-state create
    lddopen    no
    lddtype    no
    ldd        no
  =vp>
    dep2.gf    =thisgf
    deps       2
  =retrieval>
)

(p undo-prov-ldd-vp-dep3
  !safe-eval! (congruentp 'dep3.gf 'vp 'post.ma.gf 'retrieval)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      vp
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =vp>
    isa        f-rep
    predreqd   nil
    dep3       =lddchunk
    deps       2
  ==>
  =goal>
    goal-state create
    lddopen    open
  =vp>
    dep3       nil
  =retrieval>
)

(p confirm-prov-ldd-vp-dep3
  !safe-eval! (not (congruentp 'dep3.gf 'vp 'post.ma.gf 'retrieval))
  !bind! =thisgf (find-gf-match *ugflist* 'lddtype 'goal 'dep3.gf 'vp)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      vp
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =vp>
    isa        f-rep
    predreqd   nil
    dep3       =lddchunk
    deps       2
  ==>
  =goal>
    goal-state create
    lddopen    no
    lddtype    no
    ldd        no
  =vp>
    dep3.gf    =thisgf
    deps       3
  =retrieval>
)

(p undo-prov-ldd-vp-dep4
  !safe-eval! (congruentp 'dep4.gf 'vp 'post.ma.gf 'retrieval)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      vp
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =vp>
    isa        f-rep
    predreqd   nil
    dep4       =lddchunk
    deps       3
  ==>
  =goal>
    goal-state create
    lddopen    open
  =vp>
    dep4       nil
  =retrieval>
)

(p confirm-prov-ldd-vp-dep4
  !safe-eval! (not (congruentp 'dep4.gf 'vp 'post.ma.gf 'retrieval))
  !bind! =thisgf (find-gf-match *ugflist* 'lddtype 'goal 'dep4.gf 'vp)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      vp
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =vp>
    isa        f-rep
    predreqd   nil
    dep4       =lddchunk
    deps       3
  ==>
  =goal>
    goal-state create
    lddopen    no
    lddtype    no
    ldd        no
  =vp>
    dep4.gf    =thisgf
    deps       4
  =retrieval>
)


(p undo-prov-ldd-ap-dep1
  !safe-eval! (congruentp 'dep1.gf 'ap 'post.ma.gf 'retrieval)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      ap
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =ap>
    isa        f-rep
    predreqd   nil
    dep1       =lddchunk
  ==>
  =goal>
    goal-state create
    lddopen    open
  =ap>
    dep1       nil
  =retrieval>
)

(p confirm-prov-ldd-ap-dep1
  !safe-eval! (not (congruentp 'dep1.gf 'ap 'post.ma.gf 'retrieval))
  !bind! =thisgf (find-gf-match *ugflist* 'lddtype 'goal 'dep1.gf 'ap)
  =goal>
    isa        parse
    goal-state check-ldd
    ldd        =lddchunk
    lddopen    prov
    locus      ap
  =retrieval>
    isa        lex-ent
    post.ma.gf =word.post.ma.gf
  =ap>
    isa        f-rep
    predreqd   nil
    dep1       =lddchunk
  ==>
  =goal>
    goal-state create
    lddopen    no
    lddtype    no
    ldd        no
  =ap>
    dep1.gf    =thisgf
  =retrieval>
  -ap>
)

(p prosodic-clear-np
  =goal>
    isa         parse
    goal-state  break
    locus       np
  =np>
    isa         f-rep
    predreqd    nil
  ==>
  =goal>
    goal-state  find
    locus       vp
)

(p prosodic-clear-ap
  =goal>
    isa         parse
    goal-state  break
    locus       ap
  =ap>
    isa         f-rep
    predreqd    nil
  ==>
  =goal>
    goal-state  find
    locus       vp
)

(p prosodic-clear-vp-prehead
  !safe-eval! (compilable-empty 'np)
  =goal>
    isa         parse
    goal-state  break
    locus       vp
  =vp>
    isa         f-rep
    predreqd    t
  ==>
  =goal>
    goal-state  find
  @vp>
    isa         f-rep
    cat         ((v plus) (n minus) (adjcv minus) (adv minus) (p minus))
    predreqd    t
)
