11
12
14:- export((
15 must_map_preds/3,
16 sumo_to_pdkb_p5/2,
17 is_kif_string/1,
18 from_kif_string/2,
19 convert_if_kif_string/2,
20 sumo_to_pdkb/2)). 21
22
23
24delay_rule_eval(InOut,_Wrap,InOut):-ground(InOut),!.
25delay_rule_eval(In,Wrap,WIn):- WIn=..[Wrap,In].
26
28sumo_to_pdkb_const('Collection','ttSumoCollection').
29sumo_to_pdkb_const(format,formatSumo).
31sumo_to_pdkb_const('instance', isa).
32sumo_to_pdkb_const('subclass', genls).
33sumo_to_pdkb_const('inverse', genlInverse).
34sumo_to_pdkb_const('domain', 'argIsa').
35sumo_to_pdkb_const('disjoint', 'disjointWith').
36
37sumo_to_pdkb_const('Atom', 'tSumoAtomMolecule').
38
39sumo_to_pdkb_const('range', 'resultIsa').
40sumo_to_pdkb_const('domainSubclass', 'argGenl').
41sumo_to_pdkb_const('rangeSubclass', 'resultGenl').
42sumo_to_pdkb_const(immediateInstance,nearestIsa).
43sumo_to_pdkb_const('partition', 'sumo_partition').
44sumo_to_pdkb_const('Entity','tThing').
45sumo_to_pdkb_const('ListFn',vTheListFn).
46sumo_to_pdkb_const('ListOrderFn',vSumoListOrderFn).
47sumo_to_pdkb_const('AssignmentFn',uFn).
48sumo_to_pdkb_const('SymbolicString',ftString).
49sumo_to_pdkb_const('property','sumoProperty').
50sumo_to_pdkb_const('attribute','sumoAttribute').
51sumo_to_pdkb_const('Attribute','vtSumoAttribute').
52sumo_to_pdkb_const('EnglishLanguage','vEnglishLanguage').
53sumo_to_pdkb_const('Formula','ftFormula').
54sumo_to_pdkb_const('Function','tFunction').
55sumo_to_pdkb_const(forall,all).
56sumo_to_pdkb_const(subrelation,genlPreds).
57sumo_to_pdkb_const('Class','tSet').
58sumo_to_pdkb_const('baseKB','baseKB').
59sumo_to_pdkb_const('SetOrClass', 'tCol').
60sumo_to_pdkb_const(v,v).
61sumo_to_pdkb_const(&,&).
62sumo_to_pdkb_const(~,~).
63sumo_to_pdkb_const(=>,=>).
64sumo_to_pdkb_const(U,U):- downcase_atom(U,U).
65sumo_to_pdkb_const(U,U):- upcase_atom(U,U).
66sumo_to_pdkb_const(I,O):- if_defined(builtin_rn_or_rn_new(I,O)),!.
75is_kif_string([]):- !,fail.
76is_kif_string(String):-atomic(String),name(String,Codes), memberchk(40,Codes),memberchk(41,Codes).
85convert_if_kif_string(I, O):-is_kif_string(I),sumo_to_pdkb(I,O),!, \+ is_list(O).
86
87
88last_chance_doc(Wff0,WffO):- will_mws(Wff0),string_to_mws(Wff0,MWS),last_chance_doc(MWS,WffO),!.
89last_chance_doc(Wff0,comment(Atom,NewStr)):-
90 Wff0=..[s,"(", "documentation",AntisymmetricRelation, "EnglishLanguage", "\""|REST],
91 append(NOQUOTES,[_,_],REST),
92 string_to_atom(AntisymmetricRelation,Atom),
93 NewStr =..[s|NOQUOTES],!.
94last_chance_doc(IO,IO).
101convert_1_kif_string(I,Wff):- input_to_forms(I,Wff,Vs)->must(put_variable_names(Vs)),!.
102
103from_kif_string(Wff,Wff):- \+ atomic(Wff), \+ is_list(Wff),!.
104from_kif_string(I,Wff) :- string(I),convert_1_kif_string(string(I),Wff),!.
105from_kif_string(I,Wff) :- atom(I),atom_contains(I,' '),convert_1_kif_string(atom(I),Wff),!.
106from_kif_string([C|String],Wff) :- is_list(String),text_to_string_safe([C|String],Text),one_must(convert_1_kif_string(string(Text),Wff),codelist_to_forms(string(Text),Wff)),!.
107from_kif_string(Wff,Wff).
108
109
110:- module_transparent(must_map_preds/3). 111must_map_preds([],IO,IO):-!.
112must_map_preds([one(Pred)|ListOfPreds],IO,Out):- !, quietly(call(Pred,IO)),!,must_map_preds(ListOfPreds,IO,Out).
113must_map_preds([Pred|ListOfPreds],In,Out):- quietly(call(Pred,In,Mid)),!,must_map_preds(ListOfPreds,Mid,Out),!.
114
115
116:- thread_local(t_l:no_db_expand_props/0). 117
118fully_expand_always(C0,C1):- locally_tl(no_db_expand_props,fully_expand('==>'(C0),C1)),!.
119
120
121sumo_to_pdkb(CycL,CycL):- is_ftVar(CycL).
122sumo_to_pdkb('$COMMENT'(A),'$COMMENT'(A)):- !.
123sumo_to_pdkb(D,CycLOut):-
124 must_det_l((must_map_preds([
125 from_kif_string,
126 sexpr_sterm_to_pterm,
127 sumo_to_pdkb_extra(sumo_to_pdkb_p5),
128 cyc_to_pdkb_maybe,
129 fully_expand_always,
130 unnumbervars_with_names,
131 sumo_to_pdkb_p9,
132 =],D,CycLOut))).
133
134cyc_to_pdkb_maybe(I,O):- if_defined(cyc_to_pdkb(I,O),I=O),!.
135
136sumo_to_pdkb_p9(I,O):-sumo_to_pdkb_extra(sumo_to_pdkb_p9_e,I,O).
137
138:- meta_predicate(sumo_to_pdkb_extra(2,?,?)). 139
(_ ,O,O):- is_ftVar(O),!.
141sumo_to_pdkb_extra(Ex,I,O):- call(Ex,I,O),!.
142sumo_to_pdkb_extra(_ ,O,O):- \+ compound(O),!.
143sumo_to_pdkb_extra(Ex,(H,T),(HH,TT)):- !,sumo_to_pdkb_extra(Ex,H,HH),sumo_to_pdkb_extra(Ex,T,TT).
144sumo_to_pdkb_extra(Ex,[H|T],[HH|TT]):- !,sumo_to_pdkb_extra(Ex,H,HH),sumo_to_pdkb_extra(Ex,T,TT).
145sumo_to_pdkb_extra(Ex,SENT,SENTO):- SENT=..[CONNECTIVE|ARGS],sumo_to_pdkb_extra(Ex,[CONNECTIVE|ARGS],ARGSO),
146 (is_list(ARGSO)->SENTO=..ARGSO;SENTO=ARGSO),!.
147sumo_to_pdkb_extra(_ ,IO,IO).
148
149sumo_to_pdkb_p5(documentation(C,'vEnglishLanguage',S),comment(C,S)):-!.
150sumo_to_pdkb_p5(Const,NConst):-atom(Const),(sumo_to_pdkb_const(Const,NConst)->true;Const=NConst),!.
151sumo_to_pdkb_p5(Const,NConst):-string(Const),string_to_mws(Const,NConst),!.
152sumo_to_pdkb_p5(I,O):-clause_b(ruleRewrite(I,O))->I\==O,!.
153
154sumo_to_pdkb_p9_e([P|List],OUT):- atom(P),\+ is_list(List),op_type_head(P,TYPE),make_var_arg(TYPE,P,List,OUT),!.
155
156op_type_head(P,uN):-atom(P), atom_concat(_,'Fn',P).
157op_type_head(P,tN):-atom(P).
158
159
160make_var_arg(TYPE,P,List,OUT):- is_ftVar(List),!,OUT=..[TYPE,P,List].
161make_var_arg(TYPE,P,List,OUT):- is_list(List),!,must_maplist(sumo_to_pdkb_p9,List,ListO),OUT=..[TYPE,P|ListO].
162make_var_arg(TYPE,P,[A0|List],OUT):- sumo_to_pdkb_p9(A0,A),!,
163 (is_ftVar(List) -> OUT=..[TYPE,P,A,List];
164 (append(Left,Var,List),is_ftVar(Var),!,
165 must_maplist(sumo_to_pdkb_p9,Left,NewLeft),
166 append(NewLeft,[Var],NewList),
167 OUT=..[TYPE,P,A|NewList])),!.
168
169
170
171:- use_module(library(logicmoo_motel)). 172
173
174:- fixup_exports.