unlp.pl 5.81 KB
:-version( 'UNL Prolog (UNLP) Version 1.8 for Quintus Prolog
Copyright (C) 1989 GPLIA -- FCT/UNL.').
:-new_language(unlp,unlp_expand_term).
:-op(1200,xfx,(<=)).
:-op(1190,xfx,(<->)).
:-op(1190,xfx,(<-)).
:-op(999,xf,!).
:-op(999,xf,#).
:-op(10,fx,@).
:-op(10,fx,@@).
:-op(900,fy,not).
:-op(900,fy,once).
unlp_expand_term(_21,_22):-up_command(_21,_22) ','!.
unlp_expand_term(_21,_22):-up_parse_(_21,_27,_28) ','! ','up_parse_to_ep(rule(_27,_28),_22).
up_command((:-_21),(:-_21)):-!.
up_command((?-_21),(?-_21)):-!.
up_parse_((_21<=_22),_27,iff(_22,_28)):-! ','up_parse_iff(_21,_27,_28).
up_parse_((_21<-_22),_21,if(_22)):-!.
up_parse_((_21:-_22),_21,ep(_22,_27)):-! ','up_parse_up_body(_22,_27).
up_parse_((_21-->_22),_27,ep(_28,_29)):-! ','up_parse_dcg(_22,_21,_27,_28,_29).
up_parse_(_21,_22,iff(true,_23)):-up_parse_iff(_21,_22,_23) ','!.
up_parse_(_21,_21,if(true)):-!.
up_parse_iff((_21<->_22),_21,_22):-!.
up_parse_iff(_21!,_21,true):-!.
up_parse_iff(_21#,_21,fail):-!.
up_parse_up_body(_21,_22):-! ','up_parse_ep(_21,_27) ','up_ep_body(_27,_22).
up_parse_ep(_21,call(_21)):-var(_21) ','!.
up_parse_ep(call(_21),call(_25)):-! ','up_parse_ep(_21,_25).
up_parse_ep(not _21,not _25):-! ','up_parse_ep(_21,_25).
up_parse_ep(bagof(_21,_22,_23),bagof(_21,_29,_23)):-! ','up_parse_ep(_22,_29).
up_parse_ep(setof(_21,_22,_23),setof(_21,_29,_23)):-! ','up_parse_ep(_22,_29).
up_parse_ep(once _21,once _25):-! ','up_parse_ep(_21,_25).
up_parse_ep((_21;_22),_27):-var(_21) ','! ','up_parse_ep(_21,_32) ','up_parse_ep(_22,_37) ','up_or(_32,_37,_27).
up_parse_ep((_21->_22;_27),(_32->_33;_38)):-! ','up_parse_ep(_21,_32) ','up_parse_ep(_22,_33) ','up_parse_ep(_27,_38).
up_parse_ep((_21->_22),(_27->_28)):-! ','up_parse_ep(_21,_27) ','up_parse_ep(_22,_28).
up_parse_ep((_21 ','_22),_27):-! ','up_parse_ep(_21,_32) ','up_parse_ep(_22,_37) ','up_and(_32,_37,_27).
up_parse_ep((_21;_22),_27):-! ','up_parse_ep(_21,_32) ','up_parse_ep(_22,_37) ','up_or(_32,_37,_27).
up_parse_ep(!,iff(true,true)):-!.
up_parse_ep(_21,_21):-!.
up_and(true,_21,_21):-!.
up_and(_21,true,_21):-!.
up_and(iff(_21,_22),_27,iff(_21,_28)):-! ','up_and(_22,_27,_28).
up_and(ciff(_21,_22,_23),_29,ciff(_21,_30,_31)):-! ','up_and(_22,_29,_30) ','up_and(_23,_29,_31).
up_and(ciff(_21,_22),_27,ciff(_28,_29)):-! ','up_and(_21,_27,_28) ','up_and(_22,_27,_29).
up_and(if(_21),_25,_26):-! ','up_and(_21,_25,_32) ','up_ep_body(_32,_26).
up_and(_21,iff(_22,_23),iff(_28,_23)):-! ','up_and(_21,_22,_28).
up_and(_21,ciff(_22,_23,_24),ciff(_30,_23,_24)):-! ','up_and(_21,_22,_30).
up_and(_21,ciff(_22,_23),ciff(_21,_22,_23)):-! ','up_and(_21,_38,_39).
up_and(_21,_22,(_21 ','_22)):-!.
up_or(fail,_21,_21):-!.
up_or(_21,fail,_21):-!.
up_or(_21,_22,ciff(_23,_24)):-(up_cut(_21);up_cut(_22)) ','! ','up_or(_21,_22,_23,_24).
up_or(_21,_22,(_21;_22)):-!.
up_or(ciff(_21,if(_22)),ciff(if(_30),_34),_21,ciff(if((_22;_30)),_34)):-!.
up_or(ciff(_21,if(_22)),_30,_21,if((_22;_30))):-up_not_cut(_30) ','!.
up_or(_21,ciff(if(_22),_26),if((_21;_22)),_26):-up_not_cut(_21) ','!.
up_or(_21,_22,_23,_24):-! ','up_ep_body(_21,_23) ','up_ep_body(_22,_24).
up_ep_body(_21,_21):-up_cut(_21) ','!.
up_ep_body(_21,if(_21)):-!.
up_not_cut(_21):-up_cut(_21) ','! ','fail.
up_not_cut(_21):-!.
up_cut(iff(_21,_22)):-!.
up_cut(ciff(_21,_22)):-!.
up_cut(ciff(_21,_22,_23)):-!.
up_parse_dcg([],_21,_22,true,true):-! ','expand_term((_21-->[]),_22).
up_parse_dcg(_21,_22,_23,_24,_25):-! ','expand_term((_22-->_21),(_23:-_24)) ','up_parse_up_body(_24,_25).
up_parse_to_ep(rule(_21,ep(_22,_23)),(_21:-_22)):-!.
up_parse_to_ep(rule(_21,_22),_27):-! ','up_parse_to_ep(_22,_21,_27).
up_parse_to_ep(_21,_22,_23):-(arg(1,_22,_96) ','nonvar(_96) ','_96={_29}) ','! ','up_first_args(_29,_30,_31) ','functor(_22,_37,_38) ','up_get_pu(2,_38,_22,_31,_44) ','_52=..[_37|_30] ','up_put_pu(_21,_44,_61) ','up_parse_to_ep(_61,_52,_23).
up_first_args(_21,[_22|_21],_27):-(nonvar(_21) ','_21=(_22 ','_33)) ','! ','up_first_args(_33,_21,_27,_34).
up_first_args(_21,[_21|_22],_22):-!.
up_get_pu(_21,_21,_22,[_23],_23=_28):-! ','arg(_21,_22,_28).
up_get_pu(_21,_22,_23,[_24|_25],(_24=_30 ','_35)):-! ','arg(_21,_23,_30) ','_52 is _21+1 ','up_get_pu(_52,_22,_23,_25,_35).
up_get_pu(_21,_22,_23,[],true):-!.
up_put_pu(if(_21),_25,if(_26)):-! ','up_join(_25,_21,_26).
up_put_pu(iff(_21,_22),_27,iff(_21,_28)):-! ','up_join(_27,_22,_28).
up_parse_to_ep(_21,_22,_23):-up_nt(_22,_38,_30,_31) ','! ','up_g_rule(_21,_29,_30,_31) ','up_parse_to_ep(_29,_38,_23).
up_nt(@_21,_25,_26,_27):-! ','_21=..[_34|_35] ','up_app(_35,[_26,_27],_49) ','_25=..[_34|_49].
up_nt(@@_21,_25,_26,_27):-! ','_21=..[_34|_35] ','up_app(_35,[_27],_48) ','_25=..[_34,_26|_48].
up_g_rule(if(_21),if(_25),_29,_30):-! ','up_xpnd(_21,_25,_29,_30).
up_g_rule(iff(_21,_22),iff(_27,_28),_33,_34):-! ','up_xpnd(_21,_27,_33,_41) ','up_xpnd_(_22,_28,_41,_34).
up_xpnd(_21,(up_xpnd(_21,_22,_23,_24) ','call(_22)),_23,_24):-var(_21) ','!.
up_xpnd((_21 ','_22),_27,_28,_29):-! ','up_xpnd(_21,_36,_28,_37) ','up_xpnd(_22,_44,_37,_29) ','up_join(_36,_44,_27).
up_xpnd((_21;_22),(_27;_28),_33,_34):-! ','up_xpnd_(_21,_27,_33,_34) ','up_xpnd_(_22,_28,_33,_34).
up_xpnd([_21|_22],true,[_21|_27],_32):-! ','up_app(_22,_32,_27).
up_xpnd({_21},lex(_25,_21,_26,_27),[_25|_26],_27):-!.
up_xpnd(_21,_22,_23,_24):-up_nt(_21,_22,_23,_24) ','!.
up_xpnd(_21,_21,_22,_22):-!.
up_xpnd_(_21,_22,_23,_24):-! ','up_xpnd(_21,_31,_32,_24) ','(var(_32)->_22=_31 ','_23=_32;up_join(_23=_32,_31,_22)).
up_parse_to_ep(if(_21),_25,_25):-(nonvar(_21) ','_21=true) ','!.
up_parse_to_ep(if(_21),_25,(_25:-_21)):-!.
up_parse_to_ep(iff(_21,_22),_27,(_27:-_28)):-! ','up_join(!,_22,_38) ','up_join(_21,_38,_28).
up_join(_21,_22,_22):-(nonvar(_21) ','_21=true) ','!.
up_join(_21,_22,_21):-(nonvar(_22) ','_22=true) ','!.
up_join(_21,_22,(_23 ','_24)):-(nonvar(_21) ','_21=(_23 ','_34)) ','! ','up_join(_34,_22,_24).
up_join(_21,_22,(_21 ','_22)):-!.
up_app([_21|_22],_27,[_21|_28]):-! ','up_app(_22,_27,_28).
up_app([],_21,_21):-!.