API tools faq
paste
Advertisement
logicmoo

mpred_type_constraints

logicmoo
Mar 20th, 2017
291
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 17.76 KB | None | 0 0
raw download clone embed print report
  1. /*  
  2. % ===================================================================
  3. % File 'mpred_type_constraints.pl'
  4. % Purpose: For Emulation of OpenCyc for SWI-Prolog
  5. % Maintainer: Douglas Miles
  6. % Contact: $Author: dmiles $@users.sourceforge.net ;
  7. % Version: 'interface' 1.0.0
  8. % Revision:  $Revision: 1.9 $
  9. % Revised At:   $Date: 2002/06/27 14:13:20 $
  10. % ===================================================================
  11. % File used as storage place for all predicates which change as
  12. % the world is run.
  13. %
  14. %
  15. % Dec 13, 2035
  16. % Douglas Miles
  17. */
  18.  
  19.  
  20. % File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/mpred/mpred_type_constraints.pl
  21. :- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )).
  22. :- module(mpred_type_constraints,
  23.           [ add_iza/2,
  24.             arg_to_var/3,
  25.             attempt_attribute_args/3,
  26.             attempt_attribute_args/5,
  27.             attempt_attribute_one_arg/4,
  28.             attribs_to_atoms/2,
  29.             attribs_to_atoms0/2,
  30.             cmp_memberchk/2,
  31.             cmp_memberchk0/2,
  32.             comp_type/3,
  33.             dom/2,
  34.             extend_dom/2,
  35.             extend_domain/2,
  36.             init_dom/2,
  37.             inst_isac/2,
  38.             isa_pred_l/3,
  39.             isa_pred_l/4,
  40.             isac/2,
  41.             isac_chk/2,
  42.             isac_gen/2,
  43.             iza_to_isa/2,
  44.             map_subterms/3,
  45.             max_isa/3,
  46.             max_isa_l/2,
  47.             mdif/2,
  48.             min_isa/3,
  49.             min_isa_l/2,
  50.             promp_yn/2,
  51.             same/2,
  52.             same_arg/3,
  53.             samef/2,
  54.             to_functor/2,
  55.             type_size/2,
  56.             extract_conditions/2,
  57.             enforce_fa_unify_hook/2,
  58.             dom_lbl/1, dom_member/1,
  59.  
  60.             lazy/1,lazy/2,
  61.             constrain/1,
  62.             enforce/1,
  63.             weaken/1,weaken_goal/2,thaw/1,
  64.             mpred_type_constraints_file/0
  65.           ]).
  66.  
  67. :- include('mpred_header.pi').
  68.  
  69. :- endif.
  70.  :- meta_predicate isa_pred_l(+,*,*),
  71.               isa_pred_l(+,*,*,*),
  72.               map_subterms(+,?,?),
  73.               dom_member(0),
  74.               enforce_or(0,*),
  75.               constrain(*),
  76.               map_lits(1,+),
  77.               boxlog_goal_expansion(*,*).
  78.  
  79. :- meta_predicate
  80.   thaw(?),
  81.   lazy(0),
  82.   weaken(0),
  83.   weaken_goal(0,0),
  84.   lazy(?,0).
  85.  
  86. map_lits(_,Lit):- \+ compound(Lit).
  87. map_lits(P1,(Lit1 , Lit2)):- !,call(P1,Lit1),call(P1,Lit2).
  88. map_lits(P1,(Lit1 ; Lit2)):- !,call(P1,Lit1),call(P1,Lit2).
  89. map_lits(P1,(Lit1 :- Lit2)):- !,call(P1,Lit1),call(P1,Lit2).
  90. map_lits(P1, Expr) :- functor(Expr,F,A),mappable_sentence_functor(F,A),!, Expr =.. [F|Args], maplist(P1,Args).
  91. map_lits(P1,Lit):- call(P1,Lit).
  92.  
  93. mappable_sentence_functor(call,1).
  94. mappable_sentence_functor(call_u,1).
  95. mappable_sentence_functor(F,_):- downcase_atom(F,DC),upcase_atom(F,DC).
  96. mappable_sentence_functor(F,1):- \+ tCol(F).
  97. mappable_sentence_functor(F,A):- \+ argIsa(F,A,_).
  98.  
  99. % fire_constraints(G) = check current args for violations
  100. % add_constraints(G)  = add constraints to free args
  101. % constrain(G) = do both
  102.  
  103.  
  104. constrain(G):- ground(G),!.
  105. constrain(isa(I,C)):-var(I),nonvar(C),!,constrain_arg_var(C,1,I).
  106. constrain(G):- map_lits(constrain0,G).
  107. constrain0(G):- ground(G),!.
  108. constrain0(G):- map_argnums(constrain_arg,G).
  109.  
  110. constrain_arg(_,_,Arg):-nonvar(Arg),!.
  111. constrain_arg(F,A,Arg):-constrain_arg_var(F,A,Arg).
  112.  
  113. constrain_arg_var(F,A,Arg):- FA=fa(F,A), get_attr(Arg,argIsas,ArgIsas),!,  
  114.   (member(FA,ArgIsas)->true ; put_attr(Arg,argIsas,[FA|ArgIsas])).
  115. constrain_arg_var(F,A,Arg):- put_attr(Arg,argIsas,[fa(F,A)]).
  116.  
  117. enforce(G):- map_lits(enforce_or(fail),G).
  118. enforce_or(Wrong,G):- map_argnums(enforce_fa(Wrong,G).
  119.  
  120. enforce_fa(_Wrong,F,A,Value):- var(Value),constrain_arg_var(F,A,Value),!.
  121. enforce_fa(Wrong,F,A,Value):-
  122.   ((argIsa(F,A,Type)*->isa(Value,Type);nop(dmsg(warn(missing(argIsa_for(F,A,Value))))))->true;call(Wrong)).
  123.  
  124. argIsas:attr_unify_hook(ArgIsas,Value):- enforce_fa_unify_hook(ArgIsas,Value).
  125.  
  126. enforce_fa_unify_hook([fa(F,A)|ArgIsas],Value):- !,
  127.   enforce_fa(fail,F,A,Value)->
  128.   enforce_fa_unify_hook(ArgIsas,Value).
  129. enforce_fa_unify_hook(_,_).
  130.  
  131.  
  132. map_argnums(P3,G):- compound(G),!, compound_name_arguments(G,F,Args),map_each_argnum(P3,F,1,Args).
  133. map_argnums(_,_).
  134.  
  135. map_each_argnum(P3,F,N,[Arg|Args]):- !,
  136.    call(P3,F,N,Arg),
  137.    N2 is N + 1,
  138.    map_each_argnum(P3,F,N2,Args).
  139. map_each_argnum(_,_,_,_).
  140.  
  141.  
  142.  
  143. %% extract_conditions( +PFCSentence, -Conds) is semidet.
  144. %
  145. % Datalog Preconditional Expansion.
  146. %
  147. extract_conditions(Sentence,Conds):-
  148.  copy_term(Sentence,Sentence,Goals),
  149.  list_to_conjuncts(Goals,Conds),!.
  150.  
  151. %% boxlog_goal_expansion( ?G, ?GG) is semidet.
  152. %
  153. % Datalog Goal Expansion.
  154. %
  155. boxlog_goal_expansion(weaken(G),GG):-!,weaken_goal(G,GG).
  156. /*
  157. boxlog_goal_expansion(G,_):- % \+ source_location(_,_),
  158.   wdmsg(g_s(G)),fail.
  159. */
  160.  
  161.  
  162.  
  163.  
  164. %% weaken( :GoalG) is semidet.
  165. %
  166. % Weaken.
  167. %
  168. weaken(G):- weaken_goal(G,GG) -> GG.
  169.  
  170.  
  171.  
  172.  
  173. %% weaken_goal( :GoalG, :GoalGGG) is semidet.
  174. %
  175. % Weaken Goal.
  176. %
  177. weaken_goal(G,GGG):- copy_term(G,GG,Gs),G=GG,G=..[_|ARGS],weaken_args(GG,1,ARGS),   GGG=(GG,maplist(dom_member,Gs)).
  178.  
  179.  
  180.  
  181.  
  182. %% weaken_arg( ?G, ?N, ?A) is semidet.
  183. %
  184. % Weaken Argument.
  185. %
  186. weaken_arg(G,N,A):- dom(AA,[A]),!,setarg(N,G,AA).
  187. weaken_arg(G,N,A):- (var(A)->true;(dom(AA,[A]),setarg(N,G,AA))).
  188.  
  189.  
  190.  
  191.  
  192. %% weaken_args( ?G, ?N, :TermA) is semidet.
  193. %
  194. % Weaken Arguments.
  195. %
  196. weaken_args(G,N,[A]):-weaken_arg(G,N,A),!.
  197. weaken_args(G,N,[A|RGS]):-weaken_arg(G,N,A),N2 is N + 1,weaken_args(G,N2,RGS).
  198.  
  199.  
  200.  
  201.  
  202. %% lazy( :GoalG) is semidet.
  203. %
  204. % Lazy.
  205. %
  206. lazy(G):- term_variables(G,Vs),lazy(Vs,G).
  207.  
  208.  
  209. %% lazy( ?V, :GoalG) is semidet.
  210. %
  211. % Lazy.
  212. %
  213. lazy([],G):-!,G.
  214. %lazy([V|Vs],G):- or_any_var([V|Vs],C)->when(C,lazy(G)).
  215. lazy([V|Vs],G):- lazy(Vs,freeze(V,G)).
  216.  
  217. or_any_var([V],nonvar(V)).
  218. or_any_var([V|Vs],(nonvar(V);C)):-or_any_var(Vs,C).
  219.  
  220. % test  lazy(isa(X,Y)),!,X=tCol,melt(Y).
  221.  
  222. %% thaw( ?G) is semidet.
  223. %
  224. % Thaw.
  225. %
  226. thaw(G):- call_residue_vars(G,Vs),maplist(melt,Vs).
  227.  
  228.  
  229. %% melt( ?G) is semidet.
  230. %
  231. % melt.
  232. %
  233. melt(V):-frozen(V,G),call(G).
  234.  
  235.  
  236.  
  237.  
  238. %% attribs_to_atoms( ?ListA, ?List) is semidet.
  239. %
  240. % Attribs Converted To Atoms.
  241. %
  242. attribs_to_atoms(ListA,List):-map_subterms(attribs_to_atoms0,ListA,List).
  243.  
  244.  
  245.  
  246.  
  247. %% map_subterms( :PRED2Pred, ?I, ?O) is semidet.
  248. %
  249. % Map Subterms.
  250. %
  251. map_subterms(Pred,I,O):-call(Pred,I,O).
  252. map_subterms(Pred,I,O):-is_list(I),!,maplist(map_subterms(Pred),I,O).
  253. map_subterms(Pred,I,O):-compound(I),!,I=..IL,maplist(map_subterms(Pred),IL,OL),O=..OL.
  254. map_subterms(_Pred,IO,IO).
  255.  
  256.  
  257.  
  258.  
  259. %% iza_to_isa( :TermAA, :TermAB) is semidet.
  260. %
  261. % iza Converted To  (isa/2).
  262. %
  263. iza_to_isa(Iza,ftTerm):-var(Iza),!.
  264. iza_to_isa((A,B),isAnd(ListO)):-!,conjuncts_to_list((A,B),List),list_to_set(List,Set),min_isa_l(Set,ListO).
  265. iza_to_isa((A;B),isOr(Set)):-!,conjuncts_to_list((A,B),List),list_to_set(List,Set).
  266. iza_to_isa(AA,AB):-must(AA=AB).
  267.  
  268.  
  269.  
  270. %%  argisa:attribute_goals(+Var)// is semidet.
  271. %
  272. %
  273. argisa:attribute_goals(_) --> [true].
  274.  
  275.  
  276.  
  277. %% attr_unify_hook( ?X, ?Other) is semidet.
  278. %
  279. % Hook To [dom:attr_unify_hook/2] For Module Mpred_type_constraints.
  280. % Attr Unify Hook.
  281. %
  282. argisa:attr_unify_hook(_, _).
  283.  
  284.  
  285.  
  286.  
  287. %% attribs_to_atoms0( ?Var, ?Isa) is semidet.
  288. %
  289. % Attribs Converted To Atoms Primary Helper.
  290. %
  291. attribs_to_atoms0(Var,Isa):-get_attr(Var,argisa,Iza),!,must(iza_to_isa(Iza,Isa)).
  292. attribs_to_atoms0(O,O):- \+ (compound(O)).
  293.  
  294.  
  295.  
  296.  
  297.  
  298. %% min_isa_l( ?List, ?ListO) is semidet.
  299. %
  300. % min  (isa/2) (List version).
  301. %
  302. min_isa_l(List,ListO):-isa_pred_l(lambda(Y,X,genls(X,Y)),List,ListO).
  303.  
  304.  
  305.  
  306. %% max_isa_l( ?List, ?ListO) is semidet.
  307. %
  308. % max  (isa/2) (List version).
  309. %
  310. max_isa_l(List,ListO):-isa_pred_l(genls,List,ListO).
  311.  
  312.  
  313.  
  314.  
  315.  
  316. %% isa_pred_l( :PRED2Pred, ?List, ?ListO) is semidet.
  317. %
  318. %  (isa/2) Predicate (List version).
  319. %
  320. isa_pred_l(Pred,List,ListO):-isa_pred_l(Pred,List,List,ListO).
  321.  
  322.  
  323.  
  324.  
  325. %% isa_pred_l( :PRED2Pred, ?UPARAM2, ?List, ?UPARAM4) is semidet.
  326. %
  327. %  (isa/2) Predicate (List version).
  328. %
  329. isa_pred_l(_Pred,[],_List,[]).
  330. isa_pred_l(Pred,[X|L],List,O):-member(Y,List),X\=Y,call_u(call(Pred,X,Y)),!,isa_pred_l(Pred,L,List,O).
  331. isa_pred_l(Pred,[X|L],List,[X|O]):-isa_pred_l(Pred,L,List,O).
  332.  
  333.  
  334.  
  335.  
  336. %% min_isa( :TermHintA, ?HintA, ?HintA) is semidet.
  337. %
  338. % min  (isa/2).
  339. %
  340. min_isa(HintA,HintA,HintA):- !.
  341. min_isa(HintA,HintB,HintA):- call_u(genls(HintA,HintB)),!.
  342. min_isa(HintB,HintA,HintA):- call_u(genls(HintA,HintB)),!.
  343. min_isa((A,B),HintC,HintO):- min_isa(A,HintC,HintA),min_isa(B,HintC,HintB),conjoin(HintA,HintB,HintO).
  344. min_isa(HintA,HintB,HintO):- conjoin(HintA,HintB,HintO).
  345.  
  346.  
  347.  
  348.  
  349. %% max_isa( :TermHintA, ?HintA, ?HintA) is semidet.
  350. %
  351. % max  (isa/2).
  352. %
  353. max_isa(HintA,HintA,HintA):- !.
  354. max_isa(HintA,HintB,HintB):- genls(HintA,HintB),!.
  355. max_isa(HintB,HintA,HintB):- genls(HintA,HintB),!.
  356. max_isa((A,B),HintC,HintO):- max_isa(A,HintC,HintA),max_isa(B,HintC,HintB),conjoin(HintA,HintB,HintO).
  357. max_isa(HintA,HintB,HintO):- conjoin(HintA,HintB,HintO).
  358.  
  359.  
  360.  
  361.  
  362.  
  363. %% add_iza( ?Var, ?HintA) is semidet.
  364. %
  365. % Add Iza.
  366. %
  367. add_iza(Var,HintA):- var(Var),
  368.   (get_attr(Var,argisa,HintB)
  369.     ->min_isa(HintA,HintB,Hint);Hint=HintA),
  370.      put_attr(Var,argisa,Hint).
  371. add_iza(Var,Hint):- ignore(show_failure(why,call_u(isa(Var,Hint)))).
  372.  
  373. :- style_check(-singleton).
  374.  
  375.  
  376.  
  377.  
  378. %% dom_lbl( ?X) is semidet.
  379. %
  380. % Domain Labeling (residuals).
  381. %
  382. dom_lbl(X):-copy_term(X,X,Gs),maplist(dom_member,Gs).
  383.  
  384.  
  385.  
  386.  
  387. %% dom_member( :GoalG) is semidet.
  388. %
  389. % Domain Member.
  390. %
  391. dom_member(dom(X,List)):-!,member(X,List).
  392. dom_member(G):-G.
  393.  
  394.  
  395.  
  396.  
  397. %% attempt_attribute_args( ?AndOr, ?Hint, :TermVar) is semidet.
  398. %
  399. % Attempt Attribute Arguments.
  400. %
  401. attempt_attribute_args(AndOr,Hint,Var):- var(Var),add_iza(Var,Hint),!.
  402. attempt_attribute_args(AndOr,Hint,Grnd):-ground(Grnd),!.
  403. attempt_attribute_args(AndOr,Hint,Term):- \+ (compound(Term)),!.
  404. attempt_attribute_args(AndOr,Hint,+(A)):-!,attempt_attribute_args(AndOr,Hint,A).
  405. attempt_attribute_args(AndOr,Hint,-(A)):-!,attempt_attribute_args(AndOr,Hint,A).
  406. attempt_attribute_args(AndOr,Hint,?(A)):-!,attempt_attribute_args(AndOr,Hint,A).
  407. attempt_attribute_args(AndOr,Hint,(A,B)):-!,attempt_attribute_args(AndOr,Hint,A),attempt_attribute_args(AndOr,Hint,B).
  408. attempt_attribute_args(AndOr,Hint,[A|B]):-!,attempt_attribute_args(AndOr,Hint,A),attempt_attribute_args(AndOr,Hint,B).
  409. attempt_attribute_args(AndOr,Hint,(A;B)):-!,attempt_attribute_args(';'(AndOr),Hint,A),attempt_attribute_args(';'(AndOr),Hint,B).
  410. attempt_attribute_args(AndOr,Hint,Term):- use_was_isa(Term,I,C), add_iza(I,C).
  411. attempt_attribute_args(AndOr,Hint,Term):- Term=..[F,A],tCol(F),!,attempt_attribute_args(AndOr,F,A).
  412. attempt_attribute_args(AndOr,Hint,Term):- Term=..[F|ARGS],!,attempt_attribute_args(AndOr,Hint,F,1,ARGS).
  413.  
  414.  
  415.  
  416.  
  417. %% attempt_attribute_args( ?AndOr, ?Hint, ?F, ?N, :TermARG5) is semidet.
  418. %
  419. % Attempt Attribute Arguments.
  420. %
  421. attempt_attribute_args(AndOr,_Hint,_F,_N,[]):-!.
  422. attempt_attribute_args(AndOr,Hint,t,1,[A]):-attempt_attribute_args(AndOr,callable,A).
  423. attempt_attribute_args(AndOr,Hint,t,N,[A|ARGS]):-atom(A),!,attempt_attribute_args(AndOr,Hint,A,N,ARGS).
  424. attempt_attribute_args(AndOr,Hint,t,N,[A|ARGS]):- \+ (atom(A)),!.
  425. attempt_attribute_args(AndOr,Hint,F,N,[A|ARGS]):-attempt_attribute_one_arg(Hint,F,N,A),N2 is N+1,attempt_attribute_args(AndOr,Hint,F,N2,ARGS).
  426.  
  427.  
  428.  
  429.  
  430. %% attempt_attribute_one_arg( ?Hint, ?F, ?N, ?A) is semidet.
  431. %
  432. % Attempt Attribute One Argument.
  433. %
  434. attempt_attribute_one_arg(Hint,F,N,A):-call_u(argIsa(F,N,Type)),Type\=ftTerm, \+ (compound(Type)),!,attempt_attribute_args(AndOr,Type,A).
  435. attempt_attribute_one_arg(Hint,F,N,A):-call_u(argQuotedIsa(F,N,Type)),Type\=ftTerm, \+ (compound(Type)),!,attempt_attribute_args(AndOr,Type,A).
  436. attempt_attribute_one_arg(Hint,F,N,A):-call_u(argIsa(F,N,Type)),Type\=ftTerm,!,attempt_attribute_args(AndOr,Type,A).
  437. attempt_attribute_one_arg(Hint,F,N,A):-attempt_attribute_args(AndOr,argi(F,N),A).
  438.  
  439.  
  440.  
  441. % mdif(A,B):- tlbugger:attributedVars,!,dif(A,B).
  442.  
  443.  
  444.  
  445. %% mdif( ?A, ?B) is semidet.
  446. %
  447. % Mdif.
  448. %
  449. mdif(A,B):-A\==B.
  450.  
  451. :- was_export((samef/2,same/2)).
  452.  
  453.  
  454.  
  455. %% same( ?X, ?Y) is semidet.
  456. %
  457. % Same.
  458. %
  459. same(X,Y):- samef(X,Y),!.
  460. same(X,Y):- compound(X),arg(1,X,XX)->same(XX,Y),!.
  461. same(Y,X):- compound(X),arg(1,X,XX),!,same(XX,Y).
  462.  
  463.  
  464.  
  465.  
  466. %% samef( ?X, ?Y) is semidet.
  467. %
  468. % Samef.
  469. %
  470. samef(X,Y):- quietly(((to_functor(X,XF),to_functor(Y,YF),(XF=YF->true;string_equal_ci(XF,YF))))).
  471.  
  472.  
  473.  
  474.  
  475. %% to_functor( ?A, ?O) is semidet.
  476. %
  477. % Converted To Functor.
  478. %
  479. to_functor(A,O):-is_ftVar(A),!,A=O.
  480. to_functor(A,O):-compound(A),get_functor(A,F),!,to_functor(F,O).
  481. to_functor(A,A).
  482.  
  483. :- was_export(arg_to_var/3).
  484.  
  485.  
  486.  
  487. %% arg_to_var( ?Type, ?String, ?Var) is semidet.
  488. %
  489. % Argument Converted To Variable.
  490. %
  491. arg_to_var(_Type,_String,_Var).
  492.  
  493. :- was_export(same_arg/3).
  494.  
  495.  
  496.  
  497.  
  498. %% same_arg( ?How, ?X, ?Y) is semidet.
  499. %
  500. % Same Argument.
  501. %
  502. same_arg(_How,X,Y):-var(X),var(Y),!,X=Y.
  503. same_arg(equals,X,Y):-!,equals_call(X,Y).
  504. same_arg(tCol(_Type),X,Y):-!, unify_with_occurs_check(X,Y).
  505.  
  506. same_arg(ftText,X,Y):-(var(X);var(Y)),!,X=Y.
  507. same_arg(ftText,X,Y):-!, string_equal_ci(X,Y).
  508.  
  509. same_arg(same_or(equals),X,Y):- same_arg(equals,X,Y).
  510. same_arg(same_or(genls),X,Y):- same_arg(equals,X,Y).
  511. same_arg(same_or(genls),Sub,Sup):- holds_t(genls,Sub,Sup),!.
  512. same_arg(same_or(isa),X,Y):- same_arg(equals,X,Y).
  513. same_arg(same_or(isa),I,Sup):- !, holds_t(Sup,I),!.
  514.  
  515. same_arg(same_or(_Pred),X,Y):- same_arg(equals,X,Y).
  516. same_arg(same_or(Pred),I,Sup):- holds_t(Pred,I,Sup),!.
  517.  
  518. % same_arg(I,X):- promp_yn('~nSame Objects: ~q== ~q ?',[I,X]).
  519.  
  520.  
  521.  
  522. %% promp_yn( ?Fmt, ?A) is semidet.
  523. %
  524. % Promp Yn.
  525. %
  526. promp_yn(Fmt,A):- format(Fmt,A),get_single_char(C),C=121.
  527.  
  528. :- set_prolog_flag(generate_debug_info, true).
  529.  
  530.  
  531. % :-swi_module(dom, [ dom/2  ]). % Var, ?Domain
  532. :- use_module(library(ordsets)).
  533. :- was_export(dom/2).
  534.  
  535.  
  536.  
  537. %% dom( ?X, ?Dom) is semidet.
  538. %
  539. % Domain.
  540. %
  541. dom(X, Dom) :-
  542.       var(Dom), !,
  543.       get_attr(X, dom, Dom).
  544. dom(X, List) :-
  545.       list_to_ord_set(List, Domain),
  546.       put_attr(Y, dom, Domain),
  547.       X = Y.
  548.  
  549. :- was_export(extend_domain/2).
  550.  
  551.  
  552.  
  553. %% extend_domain( ?X, ?DomL) is semidet.
  554. %
  555. % Extend Domain.
  556. %
  557. extend_domain(X, DomL):- init_dom(X, Dom2), ord_union(Dom2, DomL, NewDomain),put_attr( X, dom, NewDomain ).
  558.  
  559. :- was_export(extend_dom/2).
  560.  
  561.  
  562.  
  563. %% extend_dom( ?X, ?DomE) is semidet.
  564. %
  565. % Extend Domain.
  566. %
  567. extend_dom(X, DomE):-  init_dom(X, Dom2),ord_add_element(Dom2, DomE, NewDomain),put_attr( X, dom, NewDomain ).
  568.  
  569. :- was_export(init_dom/2).
  570.  
  571.  
  572.  
  573. %% init_dom( ?X, ?Dom) is semidet.
  574. %
  575. % Init Domain.
  576. %
  577. init_dom(X,Dom):-get_attr(X, dom, Dom),!.
  578. init_dom(X,Dom):-Dom =[_], put_attr(X, dom, Dom),!.
  579.  
  580. % An attributed variable with attribute value Domain has been
  581. % assigned the value Y
  582. dom:attr_unify_hook(Domain, Y) :-
  583.    ( get_attr(Y, dom, Dom2)
  584.    -> ord_intersection(Domain, Dom2, NewDomain),
  585.    ( NewDomain == []
  586.    -> fail
  587.    ; NewDomain = [Value]
  588.    -> Y = Value
  589.    ; put_attr(Y, dom, NewDomain)
  590.    )
  591.    ; var(Y)
  592.    -> put_attr( Y, dom, Domain )
  593.    ; (\+ \+ (cmp_memberchk(Y, Domain)))
  594. ).
  595.  
  596.  
  597.  
  598. % Translate attributes from this module to residual goals
  599. dom:attribute_goals(X) -->
  600.       { get_attr(X, dom, List) },
  601.       [dom(X, List)].
  602.  
  603.  
  604.  
  605.  
  606.  
  607. %% cmp_memberchk( ?X, ?Y) is semidet.
  608. %
  609. % Cmp Memberchk.
  610. %
  611. cmp_memberchk(X,Y):-numbervars(X,0,_,[attvars(skip)]),member(X,Y),!.
  612.  
  613.  
  614.  
  615. %% cmp_memberchk0( ?Item, :TermX1) is semidet.
  616. %
  617. % Cmp Memberchk Primary Helper.
  618. %
  619. cmp_memberchk0(Item, [X1,X2,X3,X4|Xs]) :- !,
  620.     compare(R4, Item, X4),
  621.     (   R4 = (>) -> cmp_memberchk0(Item, Xs)
  622.     ;   R4 = (<) ->
  623.         compare(R2, Item, X2),
  624.         (   R2 = (>) -> Item = X3
  625.         ;   R2 = (<) -> Item = X1
  626.         ;/* R2 = (=),   Item = X2 */ true
  627.         )
  628.     ;/* R4 = (=) */ true
  629.     ).
  630. cmp_memberchk0(Item, [X1,X2|Xs]) :- !,
  631.     compare(R2, Item, X2),
  632.     (   R2 = (>) -> cmp_memberchk0(Item, Xs)
  633.     ;   R2 = (<) -> Item = X1
  634.     ;/* R2 = (=) */ true
  635.     ).
  636. cmp_memberchk0(Item, [X1]) :-
  637.     Item = X1.
  638.  
  639.  
  640.  
  641. :- was_export(isac/2).
  642.  
  643.  
  644.  
  645. %% isac( ?X, ?Dom) is semidet.
  646. %
  647. % Isac.
  648. %
  649. isac(X, Dom) :-
  650.       var(Dom), !,
  651.       get_attr(X, isac, Dom).
  652. isac(X, Domain) :-
  653.       put_attr(Y, isac, Domain),!,
  654.       X = Y.
  655.  
  656.  
  657.  
  658.  
  659. %% type_size( ?VALUE1, :PRED1000VALUE2) is semidet.
  660. %
  661. % Type Size.
  662. %
  663. type_size(C,S):-a(completeExtentEnumerable,C),!,setof(E,t(C,E),L),length(L,S).
  664. type_size(C,1000000):-a(ttExpressionType,C),!.
  665. type_size(_,1000).
  666.  
  667. /*
  668.  
  669. ?-  Z #=:= 2 + X, Z #< 2 .
  670.  
  671. succ(succ(0)).
  672.  
  673. S2I
  674. I2E
  675.  
  676. 2
  677. 2
  678. 2
  679. E2S
  680.  
  681. S = succ/1.
  682. I = integer
  683. E = 2
  684.  
  685. a:p(1).
  686.  
  687. a:p(X):-b:p(X).
  688. b:p(X):-c:p(X).
  689.  
  690. b:p(2).
  691.  
  692. */
  693.  
  694.  
  695. %% comp_type( ?Comp, ?Col1, ?Col2) is semidet.
  696. %
  697. % Comp Type.
  698. %
  699. comp_type(Comp,Col1,Col2):-type_size(Col1,S1),type_size(Col2,S2),compare(Comp,S1,S2).
  700.  
  701.  
  702.  
  703.  
  704. %% inst_isac( ?X, ?List) is semidet.
  705. %
  706. % Inst Isac.
  707. %
  708. inst_isac(X, List):- predsort(comp_type,List,SList),isac_gen(X,SList).
  709.  
  710. % An attributed variable with attribute value DVar has been
  711. % assigned the value Y
  712. isac:attr_unify_hook(DVar, Y):-
  713.    ( get_attr(Y, isac, Dom2)
  714.    -> ord_union(DVar, Dom2, NewDomain),
  715.    ( (fail,NewDomain == [])
  716.    -> fail
  717.    ; (fail,NewDomain = [Value])
  718.    -> Y = Value
  719.    ; put_attr(Y, isac, NewDomain)
  720.    )
  721.    ; var(Y)
  722.    -> put_attr( Y, isac, DVar )
  723.    ;  isac_chk(Y,DVar)).
  724.  
  725.  
  726.  
  727.  
  728. %% isac_chk( ?E, ?Cs) is semidet.
  729. %
  730. % Isac Checking.
  731. %
  732. isac_chk(E,Cs):-once(isac_gen(E,Cs)).
  733.  
  734.  
  735.  
  736.  
  737. %% isac_gen( ?VALUE1, :TermARG2) is semidet.
  738. %
  739. % Isac Gen.
  740. %
  741. isac_gen(_, []).
  742. isac_gen(Y, [H|List]):-call_u(isa(Y,H)),!,isac_gen(Y, List).
  743.  
  744.  
  745.  
  746. % Translate attributes from this module to residual goals
  747. isac:attribute_goals(X) -->
  748.       { get_attr(X, isac, List) },
  749.       [isac(X, List)].
  750.  
  751. :- fixup_exports.
  752.  
  753. mpred_type_constraints_file.
  754.  
  755.  
  756. %% goal_expansion( ?LC, ?LCOO) is semidet.
  757. %
  758. % Hook To [system:goal_expansion/2] For Module Mpred_type_constraints.
  759. % Goal Expansion.
  760. %
  761. % system:goal_expansion(G,O):- \+ current_prolog_flag(xref,true),\+ pldoc_loading, nonvar(G),boxlog_goal_expansion(G,O).
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!