1:- module(functor_constraint,[functor_constraint/4]).    2:- use_module(library(apply_macros)). % for maplist/*
    3
    4
    5:- if(current_prolog_flag(dialect, swi)).    6:- else.    7:- use_module(library(terms)).		  % for term_variables/2
    8:- use_module(library(swi),[put_attr/3]). % for put_attr/3
    9:- endif.   10
   11
   12functor_constraint(Term,Type,Args,ArgTypes) :-
   13	check_propagator(Term,Type,Args,ArgTypes,Results),
   14	Results \== [], % no solution
   15	( Results = [Result] -> % one solution
   16		Result = constructor_info(Term,Type,Args,ArgTypes)
   17	; % multiple solutions
   18		term_variables([Type|ArgTypes],SuspensionVars),
   19		Closure = functor_constraint_reactivation(Term,Type,Args,ArgTypes,_KillFlag),
   20		suspend_functor_constraint(SuspensionVars,Closure)	
   21	).	
   22
   23functor_constraint_reactivation(Term,Type,Args,ArgTypes,KillFlag,Var) :-
   24	( var(KillFlag) ->
   25		check_propagator(Term,Type,Args,ArgTypes,Results),
   26		Results \== [], % no solution
   27		( Results = [Result] -> % one solution
   28			Result = constructor_info(Term,Type,Args,ArgTypes),
   29			KillFlag = dead
   30		; % multiple solutions
   31			% TODO: narrow possibilities for argument types 
   32			%	using type domain
   33			( nonvar(Var) -> 
   34				term_variables(Var,SuspensionVars),
   35				Closure = functor_constraint_reactivation(Term,Type,Args,ArgTypes,_KillFlag),
   36				suspend_functor_constraint(SuspensionVars,Closure)
   37			;
   38				true
   39			)
   40		)	
   41	;
   42		true
   43	).	
   44
   45suspend_functor_constraint(Vars,Closure) :-
   46	maplist(var_suspend_functor_constraint(Closure),Vars).
   47
   48var_suspend_functor_constraint(Closure,Var) :-
   49	put_attr(Var,functor_constraint,Closure).
   50
   51attr_unify_hook(Closure,Term) :-
   52	call(Closure,Term).
   53
   54check_propagator(Term,Type,Args,ArgTypes,Results) :-
   55	copy_term_nat(propagator(Term,Type,Args,ArgTypes)
   56	     ,propagator(TermC,TypeC,ArgsC,ArgTypesC)),
   57	findall(constructor_info(TermC,TypeC,ArgsC,ArgTypesC),type_check:constructor_info(TermC,TypeC,ArgsC,ArgTypesC),Results)