% Minimalist Machine
% (c) Sandiway Fong, University of Arizona 2013, 2014, 2015
% 2016: added verbalizer, merges in morphology space only
% 2019: ec_disallow_piedpiping for to-d_rel-N, d_rel ec
% 2020: probegoal into edge of phase (recursively)
% 2020: relational adjectives: e.g. proud
% 2020: noun-noun compounding

% action(stream,stack,SO,stream',stack',SO')
% (stream x stack x SO) -> (stream' x stack' x SO')
% Machine State: stream, stack, syntactic object (SO)

% phase completion (TOS) (with optional pied-piping)
action(L,ST,SO,L,STp,SO,Step) :-
    tos_complete_phase(ST,SO,Xp),
    !,				% red
    step(Step),
    printPhaseCompleted(Xp),
    (search_release(Xp,ST,ST1,RL) ->
	 succeed(releaseL_to_stack(RL,Xp,ST1,STp),
		 'TOS mark Local Extent boundary with release',
		 'TOS mark Local Extent boundary, release failed') % 0:PC stk push
     ;   succeed(mark_completed_phase(Xp,ST,STp),
		 'TOS mark Local Extent boundary',
		 ['TOS mark Local Extent boundary ~p failed',[Xp]])). % 0:PC stk

% phase completion (SO)
action(L,ST,SO,L,STp,SO,Step) :-
    so_complete_phase(SO),
    !, 				% red
    step(Step),
    printPhaseCompleted(SO),
    (search_release(SO,ST,ST1,RL) ->
	 succeed(releaseL_to_stack(RL,SO,ST1,STp),
		 'SO mark Local Extent boundary with release',
		 'SO mark Local Extent boundary, release failed') % 0:PC SO push
     ;   succeed(mark_completed_phase(SO,ST,STp),
		 'SO mark Local Extent boundary',
		 'SO mark Local Extent boundary failed')). % 0:PC SO

action([X|L],ST,[],L,ST,X,Step) :-
    step(Step),
    !,				% red
    succeed(printInitial(X),
	    'Initial SO is head of stream',
	    'Initial SO is head of stream failed').

% merge stream d with SO (normally N)
% [d [d] SO] is a phase, adjust stack
% updated: inherent Case and Theta from N to D
action([X|L],ST,SO,L,STp,XSO,Step) :-
    stream_d_so_n(X,SO),
    !,				% red
    step(Step),
    succeed((merge(X,SO,XSO,_Hd),
	     ((share_iFs_opt(X,SO,[f(theta,Role)]), nonvar(Role)) ->
	      uF(X,f(case,obq,_))
	     ;
	      true),
	     (agreeDN(X,SO,Us) ->
		  pushL_hd(Us,ST,STp)
	      ;  opush(SO,ST,STp))),
	    'Merge stream D with SO',
	    ['Merge stream D ~p with SO ~p failed',[X,SO]]). % 1b:D+cN

% merge stream d with d SO (nested Ds)
% share uCase and uN
% Not dc merge
action([X|L],ST,SO,L,STp,XSO,Step) :-
    nested_d(X,SO),
    !,				% red
    step(Step),
    succeed((merge(X,SO,XSO,_Hd),
	     share_uFs(X,SO,[f(case,_,_),f('N',_),f(scope,_)]),
	     share_iFs_opt(X,SO,[f(theta,_)]),
	     (agreeDN(X,SO,Us) ->
		  pushL_hd(Us,ST,STp)
	      ;  opush(SO,ST,STp))),
	    'Merge stream D with D SO',
	    ['Merge stream D ~p with D SO ~p failed',[X,SO]]). % 1b:D+D

% DC merge external X[dc] with SO
% inactive_push parameter on:
%   nonhead of pair gets pushed onto stack, wrapped with inactive
% inactive_push parameter off:
%   no push
% X must have dc feature
% X may have unify(List), List of feature specifications
%   to be unified with its complement
action([X_DC|L],ST,SO,L,STp,XSO,Step) :-
    dc_merge(X_DC),
    output("Doubling Constitutent (DC) merge"),
    !,				% red
    step(Step),
    succeed((merge(X_DC,SO,XSO,_Hd),
%	     (f(X_DC,unify(Fs)) -> unifyFL(Fs,X_DC,SO) ; true),
	     (inactive_push -> opush(inactive(SO),ST,STp) ; STp = ST)),
	    'DC merge',
	    ['DC merge ~p with SO ~p failed',[X_DC,SO]]). % DCm

% competition: T EF external vs. internal?
% T EF (external merge for expletive only)
action([X|L],ST,SO,L,STp,SOp,Step) :-
    extm_expletive(X,SO),
    output("External merge"),
    !,
    step(Step),
    succeed((merge(SO,X,SOp,_Hd),
	     use_edge(SOp),		% no iteration
	     opush(X,ST,STp)),
	    'Merge external expletive to edge of T',
	    ['Merge external expletive ~p to edge of ~p failed',[X,SO]]). % 2a:T 2m ext
% T EF (internal merge)
action(L,ST,SO,L,STp,SOp,Step) :- % STp
    intm_t(SO,F),
    !,
    step(Step),
    succeed((rel_tos(ST,X,F,STp),
	     printInternalMerge,
	     merge(SO,X,SOp,_Hd),
	     use_edge(SOp)),		% no iteration
	    'Internal merge to edge of T',
	    ['Internal merge to edge of ~p failed',[SO]]). % 2b:T 2m int
% V or A select theta object 
action([V|L],ST,SO,L,STp,SOp,Step) :-
    thm_VA(V,SO),
    !,
    step(Step),
    succeed((merge(V,SO,SOp,_Hd),
	     theta_mark(SO),
	     opush(SO,ST,STp)),
	    'Theta merge for {V|A}',
	    ['Theta merge for {V|A} ~p and ~p failed',[V,SO]]). % 3:V/a 1m

% p select theta object
% for lexical p head pied-piping, whole PP goes on the stack
% zero P: no pied-piping
% [An] EC [Empty Category] disallows pied-piping (Chomsky, 2001:28)
%
%
% P with spellout and theta object is wh:
%   pied-piping or no pied-piping
% two types of P:
% 1. uPhi: assign Case via stack
% 2. no uPhi: assign inherent Case to SO (the object)

action([P|L],ST,SO,L,STp,SOp,Step) :-
    thm_p(P,SO),
    !,
    step(Step),
    succeed((merge(P,SO,SOp,_Hd),
	     theta_mark(SO),
	     (uF(P,f(phi,_,_)) ->
		  probegoal_once(P,ST,_) % uPhi: use stack
	      ;  probegoal_once(P,[SO],_)), % inherent case: don't use stack
	     (is_complete_phase(SO) ->
		  printPhaseCompleted(SO),
		  (search_release(SO,ST,ST1,RL) ->
		       releaseL_to_stack(RL,SO,ST1,STp) % 0:PC stream push
		   ;   mark_completed_phase(SO,ST,ST1)) % 0:PC stream
	     ;  ST1 = ST),
	     
	     (pushable(SO) ->	% HACK for inherent Case object
	      ((label(P,X), no_spellout(X)) ->
	       push(SO,ST1,STp) % zero P, no pied-piping
	      ;
	       (ec_disallow_piedpiping(SO) -> % Chomsky
		push(SO,ST1,STp)
	       ; (push(SO,ST1,STp) ;	  % lexical P, no pied-piping
		  push(SOp,ST1,STp)))	  % lexical P, pied-piping
	      )
	     ; STp = ST1)),
	    'Merge p and object',
	    ['Merge p ~p and object ~p failed',[P,SO]]). % 4:P 1m
% p/a EF (external merge only)
action([X|L],ST,SO,L,STp,SOp,Step) :-
    extm_pa(SO,X,F),
    !,
    step(Step),
    succeed((merge(SO,X,SOp,_Hd),
	     edge_theta_mark(F,X),
	     (f(SO,edge_case) ->
		  probegoal_once(SO,[X],_) % don't use stack
	      ;  true),
	     use_edge(SOp),	% no iteration
	     mergeDelayedStack(X,ST,ST1),
	     opush(X,ST1,STp)),
	    'External merge to edge of p|a',
	    ['Merge stream head ~p to edge of ~p failed',[X,SO]]). % 5:P|A 2m
% p EF (internal merge)
% repushes rel TOS
action(L,ST,SO,L,STp,SOp,Step) :-
    intm_p(SO,F),
    !,
    step(Step),
    succeed((rel_tos(ST,X,F,ST1),
	     printInternalMerge,
	     merge(SO,X,SOp,_Hd),
	     edge_theta_mark(F,X),
	     repush(X,ST1,STp),		% backwards binding
	     use_edge(SOp)),		% no iteration
	    'Internal merge to edge of p',
	    ['Internal merge to edge of ~p failed',[SO]]). % 5b:P 2m int

% d with external theta role
action([X|L],ST,SO,L,STp,SOp,Step) :-
    extm_d(X,SO),
    !,
    step(Step),
    succeed((theta_mark(X),
	     inherentGenCase(SO,X),
	     merge(SO,X,SOp,_Hd),
	     use_edge(SOp),		% no iteration
	     ST1 = ST,
	     (is_complete_phase(X) ->
		  printPhaseCompleted(X),
		  (search_release(X,ST1,ST1p,RL) ->
		       releaseL_to_stack(RL,X,ST1p,STp) % 0:PC stream push
		   ;   mark_completed_phase(X,ST1,STp)) % 0:PC stream
	     ;
	      mergeDelayedStack(X,ST1,ST2),
	      opush(X,ST2,STp))),
	    'Merge SO d with theta-bearing stream',
	    ['Merge SO d ~p with theta-bearing stream ~p failed',[SO,X]]). % 7b:d 2m (stream)

% competition: v EF from stream or internal merge
% Default: stream over internal merge
% lexical parameter: edge_preference(stack/stream)
%
% v EF (merges from the stream)
% v EF (internal merge)
% D assigns inherent Genitive case
% repush rel TOS

action(L,ST,SO,Lp,STp,SOp,Step) :-
    v_ef(SO,F),
    !,				% red
    step(Step),
    (f(SO,edge_preference(stack)) ->
	 (succeed((rel_tos(ST,X,F,ST1),		% v~unacc
		   printInternalMerge,
		   merge(SO,X,SOp,_Hd),
		   edge_theta_mark(F,X),
		   use_edge(SOp),		% no iteration
		   repush(X,ST1,STp)), % H. found a picture [of herself]
		  'Internal merge for v') *->
		printEdgePreference(SO),
	  	Lp = L
	  ;  succeed((L = [X|Lp],
		      externalMerge(F),
		      checkfeature(X,F), \+ projects(X),
		      merge(SO,X,SOp,_Hd),
		      edge_theta_mark(F,X),
		      use_edge(SOp),		% no iteration
		      opush(X,ST,STp)),
		     'Merge stream to edge of v',
		     ['Merge stream to edge of v ~p failed',[SO]])) % 7b:v 2m (stream)
     ; % default preference: stream over internal merge
     ((L = [X|Lp],
       externalMerge(F),
       checkfeature(X,F), \+ projects(X)) ->
	  succeed((merge(SO,X,SOp,_Hd),
		   edge_theta_mark(F,X),
		   use_edge(SOp),		% no iteration
		   mergeDelayedStack(X,ST,ST1),
		   opush(X,ST1,STp)),
		  'Merge stream to edge of v',
		  ['Merge stream ~p to edge of v ~p failed',[X,SO]]) % 7b:v 2m (stream)
      ;  succeed((rel_tos(ST,X,F,ST1),		% v~unacc
		  printInternalMerge,
		  merge(SO,X,SOp,_Hd),
		  edge_theta_mark(F,X),
		  use_edge(SOp),		% no iteration
		  repush(X,ST1,STp)), % H. found a picture [of herself]
		 'Internal merge for v',
		 ['Internal merge for v ~p failed',[SO]]),
	 Lp = L)).

action(L,ST,SO,L,STp,SOp,Step) :-
    intm_AD(SO,F),
    !,
    step(Step),
    succeed((rel_tos(ST,X,F,ST1), % v~unacc
	     (label(SO,type(d)) -> inherentGenCase(SO,X) ; true),
	     printInternalMerge,
	     merge(SO,X,SOp,_Hd),
	     edge_theta_mark(F,X),
	     use_edge(SOp),		% no iteration
	     repush(X,ST1,STp)), % H. found a picture [of herself]
	    'Internal merge for {a|d}',
	    ['Internal merge for {a|d} ~p failed',[SO]]). % 7a:a/d 2m int

% v select V
% does v have the possibility of going on the stack? PRT
% multiple probing for v? implemented
% pop delayed
action([Lv|L],ST,SO,L,STp,SOp,Step) :-
    stream_v(Lv,SO),
    !,			% red
    step(Step),
    succeed((merge(Lv,SO,SOp,_Hd),
	     probegoal_m(Lv,ST,_ST1,_G),
	     opush(Lv,ST,STp)),	% probe itself could be a goal
	    'Merge stream v and SO',
	    ['Merge stream v ~p and SO ~p failed',[Lv,SO]]). % 6:v 1m

% T select v 
% T probes (possibly repeatedly)
% T may have multiple uFs
% OFF: first matching goal G is stack fronted
% NOTE: calls both probegoal_m and m_probegoal
action([T|L],ST,SO,L,STp,SOp,Step) :-
    stream_t(T,SO),
    !,
    step(Step),
    succeed((merge(T,SO,SO1,_Hd),
	     probegoal_m(T,ST,_ST1,_G),
	     m_probegoal(T,ST,SO,Gs),
	     (edge(SO1,R) -> m_EFmove(Gs,ST,ST1,R,SO1,SOp) ; SOp = SO1, ST1 = ST),
	     (so_complete_phase(SO) ->
		  printPhaseCompleted(SO),
		  (search_release(SO,ST1,ST2,RL) ->
		       releaseL_to_stack(RL,SO,ST2,ST3) % 0:PC SO push
		   ;   mark_completed_phase(SO,ST1,ST3)) % 0:PC SO
	      ;   ST3 = ST),
%	     frontStack(G,ST3,STp)),
	     STp = ST3),
	    'Merge stream T with SO',
	    ['Merge stream T ~p with SO ~p failed',[T,SO]]). % 8:T 1m
% {mood,indic} EF (internal merge)
action(L,ST,SO,L,STp,SOp,Step) :- % STp
    intm_NM(SO,F),
    !,
    step(Step),
    succeed((tos(ST,X,STp), checkfeature(X,F),
	     printInternalMerge,
	     merge(SO,X,SOp,_Hd),
	     use_edge(SOp)),		% no iteration
	    'Internal merge to the edge of neg/mood',
	    ['Internal merge to the edge of neg/mood ~p failed',[SO]]). % 13:mood,neg 2m int
action([XP|L],ST,SO,L,ST,SOp,Step) :- % formSet
	parallel(XP,SO),	       % allow iteration of set
	!,
	step(Step),
	succeed((formSet(XP,SO,SOp), printFormSet(XP,SO)),
		'FormSet',
		['FormSet ~p and ~p failed',[XP,SO]]).
		
% c select T + c EF (internal merge)
% NEW: 
% unintended: works with CP CP - should be pre-emptied by formSet
action([C|L],ST,SO,L,STp,SOp,Step) :-
    stream_c(C),
    !,
    step(Step),
    succeed((merge(C,SO,SO1,_Hd),
	     m_probegoal(C,ST,SO,Gs)), % specific to c
	     'Merge stream C and SO',

	     ['Merge stream C ~p and SO ~p failed',[C,SO]]), % 9:c 1m
    (edge(SO1,R) ->
	 succeed((printInternalMerge,
		  m_EFmove(Gs,ST,STp,R,SO1,SOp), use_edge(SOp)),
		 'Internal merge to edge of C',
		 ['Internal merge to edge of C ~p failed',[SO1]])
     ;  SOp = SO1, STp = ST). % 10:c 2m/none

%%% NEW: pair and set merge XP YP possibilities
%%% HACK: value unvalued Case if necessary
%%% problem is how to ensure set merge version ends up with raising.
%%% solution: let c_rel value Case
%%% NEWER: rule out <{dedicate, {to who person}}, the building>
%%% by checking theta
action([XP|L],ST,SO,L,STp,SOp,Step) :- % pair merge
    pm(XP,SO),			       % pre-condition for PM
    !,
    step(Step),
    (succeed((pair_merge(XP,SO,SOp),
	      (iF(XP,f(theta,TV)) ->
	       (var(TV) ->
		printPMNoTheta(XP),
		fail
	       ;
		printPMTheta(XP))
	      ;
	       true),
	      ((uF(XP,f(case,V,_)), var(V)) -> % hack
	       V = obq,
	       printPMInherentCase(XP)
	      ;
	       true),		  
	     (lastSSStack(SST) -> % NOT ASSERTED ANYMORE!
		  (append(SST,STp,ST) ->
		       printUndoSStackMerge(SST)
		   ;  STp = ST)
	      ; STp = ST)),
	    'Pair merge stream and SO',
	     ['Pair merge stream ~p and SO ~p failed',[XP,SO]]) % 13: pm
    ;
     succeed((printRetry(Step),
	      merge_special(XP,SO,SOp),
	      mergeDelayedStack(XP,ST,ST1),
	      label_complex(SOp,C),
	      push(XP,[C|ST1],STp)),
	     'Merge XP stream and YP SO',
	     ['Merge XP stream ~p and YP SO ~p failed',[XP,SO]])).

% specific case: relative clause
% construction-specific! NO good
% promote via IM to new head
action([D|L],ST,SO,[D|L],STp,SOp,Step) :-
	rel_c(D,ST,SO,X,STp),
	!,			% red
	step(Step),
	succeed(merge(X,SO,SOp,_Hd),
	    'Merge from stack to head SO',
	    ['Merge from stack ~p to head SO ~p failed',[X,SO]]).

action([D|L],ST,SO,[D|L],ST,SOp,Step) :-
	rel_c_set(D,SO,X),
	!,			% red
	step(Step),
	succeed(merge(X,SO,SOp,_Hd),
		'Re-Merge head',
		['Re-Merge head ~p to SO set ~p failed',[X,SO]]).

% head-head compounding
%%% NEW
action([X|L],ST,SO,L,ST,SOp,Step) :-
	compounding(X,SO),
	!,			% red
	step(Step),
	succeed((merge(X,SO,SOp,headfinal), % compounding head-final
		 value_uF(X,'D'),
		 printCompoundingValuation(X)),
		'Merge stream to head SO',
		['Merge stream ~p to head SO ~p failed',[X,SO]]).

%%% DEFAULT if all other actions preconditions fail.
action([X|L],ST,SO,L,STp,SOp,Step) :-
    step(Step),
    succeed((merge(X,SO,SOp,Hd), % 2nd
	     ((head(X), X == Hd) ->
		  probegoal_m(X,ST,_,_),
		  opush(SO,ST,STp)
	      ;   ((head(SO), SO == Hd) ->
		       probegoal_m(SO,ST,_,_),
		       opush(X,ST,STp)
		   ;  true))),
	    'Merge SO head and stream',
	    ['Merge SO head ~p and stream ~p failed',[SO,X]]).

%% pushable HACK for p-obj (inherent Case) without unvalued Case
%%% NEW: option to check iRel through edge
pushable(X) :-
	(iF(X,f(wh)) -> true
	;
	 (iF(X,f(rel)) -> true
	 ;
	  ((recursive_edge(X,Y), iF(Y,f(rel))) -> true
	  ;
	   unvalued_uF(X)))).

% [An] EC [Empty Category] disallows pied-piping (Chomsky, 2001:28)
ec_disallow_piedpiping(SO) :-
	head(SO, Hd),
	label(Hd,C),
	no_spellout(C).

%% action preconditions
%    spy: useful for debugging

parallel(XP,YP) :-
	label(XP,C),
	(functor(YP,set,_) ->
	 arg(1,YP,List),
	 parallel_list([XP|List],C)
	;
	 parallel_list([XP,YP],C)).

parallel_list([],_).
parallel_list([X|L],C) :- label(X,C), parallel_list(L,C).

formSet(XP,set(L),set(Lp)) :-
	!,			% red
	append(L,[XP],Lp).
formSet(XP,YP,set([YP,XP])).

% N1!D N2!D
compounding(N1,N2) :-
	unvalued_uF(N2,'D'),
	unvalued_uF(N1,'D').
	
tos_complete_phase(ST,SO,Xp) :-
    SO \== [],
    ST = [X|_],
    (  is_complete_phase(X),
       Xp=X
     ; complement(X,Xp),
       is_complete_phase(Xp)).

so_complete_phase(X) :-
    X \== [], is_complete_phase(X).

v_ef(X,F) :-
    label(X,type(v)), edge(X,F).

stream_d_so_n(X,SO) :-
    (label(X,type(d)) ; verbalizer(X)),
    unvalued_uF(SO,'D').

% nest D's only when D has uN
% nested Ds:   D[uN] D[uN]
% distinct Ds: D     D[uN]
% other exception is for doubling constituents
nested_d(X,SO) :-
    label(X,type(d)), head(X),
    uF(X,f('N',_)),
    \+ f(X,dc),
    label(SO,type(d)).

dc_merge(X) :-
    head(X), f(X,dc).

extm_expletive(X,SO) :-
    label(SO,type('T')), edge(SO), 
    \+ projects(X), expl(X).

intm_t(SO,F) :-
    label(SO,type('T')), edge(SO,F).

thm_VA(X,SO) :-
    (label(X,type('V')) ; label(X,type(a))), syntactic_head(X),
    \+ projects(SO).

thm_p(P,SO) :-
    \+ projects(SO),
    label(P,type(p)), head(P).

extm_pa(SO,X,F) :-
	(label(SO,type(p)) ; label(SO,type(a))),
	edge(SO,F),
	checkfeature(X,F), \+ projects(X).

intm_p(SO,F) :-
    label(SO,type(p)), edge(SO,F),
    internalMerge(F).

stream_v(LV,SO) :-
    label(LV,type(v)), \+ projects(SO).

extm_v(X,SO,F) :-
    label(SO,type(v)), edge(SO,F),
    externalMerge(F),	% compatible with external merge
    checkfeature(X,F), \+ projects(X).

extm_d(X,SO) :-
    label(SO,type(d)), edge(SO,unvalued_iF(theta)),
    checkfeature(X,unvalued_iF(theta)), \+ projects(X).

intm_AD(SO,F) :-
    label(SO,type([v,a,d])), edge(SO,F).

stream_t(T,SO) :-
    label(T,type('T')),
    \+ projects(SO).		% SO must finish projecting

intm_NM(SO,F) :-
    label(SO,type([neg,mood])),	edge(SO,F).

stream_c(C) :-
    label(C,type(c)).

pm(X,SO) :-
    \+ head(X), \+ projects(X),
    \+ head(SO), \+ projects(SO).

% previous TOS head restriction causes problems
% the [[picture of himself] [that Bill likes <>]]
%%% NEW: person for us to visit
%%% stack: d_rel person, person
rel_c(D,ST,SO,H,STp) :-
     \+ projects(SO),
     (tos(ST,X,STp),
      head(X,H),
      agreeDN_test(D,H)
     ;
      tos2(ST,X,Y,STp), proper_subC(Y,X,_), head(Y,H),
      agreeDN_test(D,H)).

%%% stack not available after reinsertion into input
%%% hardcoded {{D,H},{c_rel, ...}}
rel_c_set(D,SO,H) :-
	SO = set(List),
	forall(member(X,List),c_rel_d_rel_n(X,_)),
	List = [One|Others],
	c_rel_d_rel_n(One,H),
	unify_n(Others,H),
	agreeDN_test(D,H).

%% {{D,N},{c_rel,...}}
c_rel_d_rel_n(X,N) :-
	label(X,c_rel),
	cs(X,[D,Z]),
	label(D,type(d)),
	cs(D,[D0,N]),
	label(D0,type(d)),
	label(N,type(n)),
	unvalued_uF(N,'D'),	
	label(Z,c_rel).

unify_n([],_N).
unify_n([CP|List],N) :-	unify1_n(CP,N),	unify_n(List,N).

unify1_n(CP,N) :- c_rel_d_rel_n(CP,N).

inherentGenCase(SO,X) :-
    uF(X,f(case,V,_)),
    value_case(V,gen,SO,X).

% probe goal: single goal, possible multiple goals
% NOTE: used for T,v and general case. NOT for c, see m_probegoal
%%% NEW: used for c_rel
probegoal_m(P,ST,STp,G) :-
    probegoal_once(P,ST,G),	% probe once
    opop1f(ST,ST1),
    (ST == ST1 ->		% stack changes?
	 STp = ST
     ;   probegoalR(P,ST1,STp)).

% iterate probe P on stack ST until P is no longer active
probegoalR(P,ST,ST) :- \+ active(P), !.
probegoalR(P,ST,STp) :- 
    probegoal_once(P,ST,_), 
    opop1f(ST,ST1), 
    (ST == ST1 -> 
	 STp = ST
     ;   probegoalR(P,ST1,STp)).

% probegoal_once(P,ST,G)
% P = probe, ST = stack (goal G will be TOS)
% cases:
% 1. probe p values obq case on goal G
% 2. probe v,
%   a. if v and G have phi-features, G values uF phi on v
%   b. if v is phi-complete, v values acc case on G
%   c. if G has uF phi, unify T and G phi-features
%   d. if v has uF case, unify v and G case feature
% 3. probe a,
%    
% 4. probe T,
%   a. if G has uF phi, unify T and G phi-features
%   b. if G has iF phi, G values uF phi on T
%   c. if T is phi-complete, T values nom case on G
    
probegoal_once(P,Gs,G) :-
    label(P,type('v~')),
    !,				% red
    tos_ncp(Gs,G),
    theta(G),
    printProbegoal(P,G,'checks theta on').
probegoal_once(P,Gs,Gp) :-
    label(P,type(p)),
    \+ unvalued_uF(P,phi),	% uPhi
    \+ f(P,nocase),
    !,				% red
    tos_ncp(Gs,G),
    ((label(G,X), label(P,X)) ->
	 complement(G,Gp)	% pied-piping
     ;  Gp = G),
    case_parameter(p,Case),	% lexicon
    value_case(C,Case,P,Gp) if uF(Gp,f(case,C,_)).
% v* has uPhi
% PRT has uPhi, uCase
% modal kaan (Arabic) has uPhi but nocase
% v T and p with uPhi to be valued by the goal
probegoal_once(P,Gs,G) :-	     
    unvalued_uF(P,phi),	     % uF phi/case may be unified
    !,			     % red
    (f(P,case(C)) ->
	 true
     ; case_type(P,C)),
    pgPhi(P,Gs,C,G).
probegoal_once(_P,_Gs,_G).	% vacuous

% v => acc
% T => nom
% p => obq
% c => obq 
case_type(P,acc) :-
    label(P,type(v)),
    !.				% red
case_type(P,nom) :-
    label(P,type('T')),
    !.				% red
case_type(P,obq) :-
	label(P,type(p)),
	!.			% red
case_type(P,obq) :-
	label(P,type(c)).

% pied piping support for goal G
pgPhi(P,Gs,Case,G) :-
    tos_ncp(Gs,G),
    uF(P,f(phi,V,_)),
    iF_piedp(G,f(phi,W,_)),
    printProbegoal(G,P,'values uPhi on'),
    value_phi(V,W),
    !,			% red: most local
    pgCase(P,G,Case) if \+ f(P,nocase).
pgPhi(P,Gs,Case,G) :-
    tos_ncp(Gs,G),
    uF(P,f(phi,V,_)),
    uF_piedp(G,f(phi,W,_)),
    unify_phi(V,W),
    printProbegoalUnify(P,G,'phi'),
    !,			% red: most local
    pgCase(P,G,Case) if \+ f(P,nocase).
pgPhi(P,[_|Gs],Case,G) :- pgPhi(P,Gs,Case,G).

pgCase(P,G,_Case) :-
    nullCase(P),
    value_null_case(P,G),
    !. 				% red
pgCase(P,G,Case) :-
    uF_piedp(G,f(case,C,_)),
    phi_complete(P),
    !,				% red
    value_case(C,Case,P,G).
pgCase(P,G,_Case) :-
    uF_piedp(G,f(case,C,_)),
    uF(P,f(case,PC,_)),
    !,				% red
    printProbegoalUnify(P,G,'case'),
    PC = unifed(C).
pgCase(_P,_G,_Case).

nullCase(P) :- f(P,nullCase).

% assume there is a case slot null(V), V unvalued
% if slot is a variable,  don't value, just succeed quietly
% e.g. John considered himself to be intelligent
% if slot is already filled, fail
% if slot is null(_), V should be unvalued, value V
value_null_case(P,G) :-
    uF(G,f(case,V,_)),
    (nonvar(V) ->
	 V = null(V2),
	 var(V2), V2 = 1,
	 printProbegoal(P,G,values,nullCase,'case on')
     ;  true).
    
% multiple probe features in one head (uses economy)
% m_probegoal(Probe,Stack,SO,Goals)
% multi-probe on Stack and SO
% Goals = accumulated list of goals
%%% NEW: updated for case, used for c_rel
m_probegoal(P,_ST,_SO,[]) :-
    \+ active(P),
    !.				% green
m_probegoal(P,ST,SO,RevGs) :-
    probegoal(P,ST,[],SO,Gs),
    probegoalR(P,ST,Gs,SO,Gsp),
    reverse(Gsp,RevGs).

% iterate probe P on stack ST until P is no longer active
probegoalR(P,_ST,Gs,_SO,Gs) :- \+ active(P), !.
probegoalR(P,ST,Gs,SO,Gsp) :- 
    probegoal(P,ST,Gs,SO,Gs1),
    (Gs1 == Gs ->		% economy
	 Gs2 = Gs 
     ;  append(Gs,Gs1,Gs2)),
    probegoalR(P,ST,Gs2,SO,Gsp).

% probegoal(P,Stack,PrevGoals,SO,Goals)
% P: head with probe feature
% PrevGoals: goals from previous rounds with this head or [] (none)
% looks into Stack, and (currently built) SO
% returns Goals (used)

% economy: use a prior goal from Gs
probegoal(P,_ST,Gs,SO,Gs) :-	
    member(G,Gs),
    unvalued_uF(P,ID,F),	% ID is used for locality
    checkfeature(G,ID,iF(F)),
    edgeT_check(P,F,SO,G),
    !,				% red
    printProbegoalEconomy(G,P,values,F,on),
    value_uF(P,F),
    (F == phi ->
     (uF(G,f(case,V,_)) -> value_case(V,obq,P,G) ; true)
    ;
     true),
    debug(probegoal,'pg5:eco',[]).

% get the goal(s) from the stack or SO
probegoal(P,ST,_Gs,SO,[G]) :-	% uT/uWh on probe P, stack
    unvalued_uF(P,ID,F),	% ID is used for locality
    rel_tos_ncp(ST,G,ID,iF(F)),
    edgeT_check(P,F,SO,G),
    printProbegoal(G,P,values,F,on),
    (F == phi ->
     uF(P,f(phi,V,_)),
     iF_piedp(G,f(phi,W,_)),
     printProbegoal(G,P,'values uPhi on'),
     value_phi(V,W),
     (uF(G,f(case,V,_)) -> value_case(V,obq,P,G) ; true)
    ;
     value_uF(P,F)),
    debug(probegoal,'pg5:stk',[]).
probegoal(P,_ST,_Gs,SO,Gs) :-	% uT/uWh on probe P, use SO
    unvalued_uF(P,_ID,F),
    (label(SO,type(F)) -> true ; iF(SO,F)), % T valued by T or has iF T
    head_piedpipe(SO,Gs), % picks out G head and other edge head
    printProbegoal(P,SO,attracts),
    value_uF(P,F),
    debug(probegoal,'pg5:SO',[]).

% c's uT feature may be valued by local nom(_) case (i.e. edge of T)
% c[uT] look in edge of T for goal G
% T may value nom(_) case long distance, e.g. passives
% Problem:
%   c_rel
edgeT_check(P,'T',_SO,_G) :-
    label(P,c_rel),
    !. 				%red
edgeT_check(P,'T',SO,G) :-
    label(P,type(c)),
    label(SO,type('T')),
    !,				% red
    in_edge(SO,G).
edgeT_check(_,_,_,_).

head_piedpipe(SO,Lp) :- heads(SO,L), exclude_nonproj(L,Lp).

% exclude 'there'/'it' from pied-piping
exclude_nonproj([],[]).
exclude_nonproj([H|Hs],L) :-
    (f(H,noProject) -> L = Lp ; L = [H|Lp]),
    exclude_nonproj(Hs,Lp).

% m_EFmove(Goals,Stack,Restriction,SO,SO')
% Goals are (possibly) subject to EF restriction, 
% those satisfying the restriction will merge with SO
% Goals = matched goals
% Restriction = EF restriction
% Goal has feature no_move, can't be merged, e.g. d_rel

m_EFmove([],ST,ST,_R,SO,SO).
m_EFmove([G|Gs],ST,STp,R,SO,SOp) :-
    (f(G,no_move) ->
	 SO1 = SO
     ;  (inStack(G,ST) ->
	     (nonvar(R) ->
		  (checkfeature(G,R) -> % satisfy restriction to move
		       head(SO,H), value_scope(H,G),
		       new_occ(G,Gnew),
		       updateStack(ST,G,Gnew,G,Gnew,ST1),
		       merge(SO,Gnew,SO1,_)
		   ;  SO1 = SO,
		      ST1 = ST)
	      ;  head(SO,H), value_scope(H,G),
		 new_occ(G,Gnew),
		 updateStack(ST,G,Gnew,G,Gnew,ST1),
		 merge(SO,Gnew,SO1,_))
)	 ;   ST1 = ST,		% non-stack goal
	     (checkfeature(G,R) ->
		  head(SO,H), value_scope(H,G),
		  new_occ(G,Gnew),
		  merge(SO,Gnew,SO1,_)
	      ;  SO1 = SO)),
    m_EFmove(Gs,ST1,STp,R,SO1,SOp).

inStack(G,[H|_]) :-
    G == H,
    !. 	% red
inStack(G,[inactive(H)|_]) :-
    G == H,
    !. % red
inStack(G,[_|L]) :- inStack(G,L).

% pied-piping support
% % value uScope if X has iScope, and G or complement of G has uScope
value_scope(X,G) :-
    (iF(X,f(scope)) ->
	 (uF(G,f(scope,V)) ->
	      printValue(X,G,scope),
	      V = 1
	  ; ((complement(G,G1), uF(G1,f(scope,V))) ->
		 printValue(X,G1,scope),
		 V = 1
	     ;  true))
     ; true).

% special case: used for immediate valuation during merge
% not pushed onto the stack (stack =/means later valuation)
% D[uN] N[uD] => N values uN on D, D values uD on N
% If D has feature no_check(d), it cannot value uD on N
% If N has feature no_check(n), it cannot value uN on D
% can be partial agree with non-empty L
% L: list with unvalued uF
%%% added: theta feature inheritance from N to D

agreeDN(D,N,L) :-
    (label(D,type(d)) ; verbalizer(D)),
    label(N,type(n)),
    !,				% red
    value_F(D,'D',N,L1),
    append(L1,L2,L),
    value_F(N,'N',D,L2).

agreeDN_test(D,N) :-
    (label(D,type(d)) ; verbalizer(D)),
    label(N,type(n)),
    unvalued_uF(N,'D'), unvalued_uF(D,'N').

value_F(D,F,N,L) :-
    (unvalued_uF(N,F) ->
	 (f(D, no_check(d)) ->
	      L = [N]
	  ;  printProbegoal(D,N,values,F,on),
	     value_uF(N,F),
	     L = [])
     ;  L = []).

% verbalizer: converts n to V
verbalizer(X) :- label(X,type('V')).
