1% Code specific to the host Prolog language
    2% Version for SWI Prolog
    3
    4:- module(swi_specific,
    5    [subsumeschk/2,get_atts/2,put_atts/2,term_variables_bag/2,attribute/1, text_style/1]).    6
    7subsumeschk(General,Specific):-
    8    subsumes_chk(General,Specific).
    9
   10% SICStus requires the definition of attributes through an 'attribute' declaration,
   11% while SWI raises an error. So, I define a dummy attribute/1 predicate that does nothing
   12attribute(_).
   13
   14% Definition of the predicate get_atts, built-in in SICStus.
   15% This definition makes sense only for the two attributes quant/1 and restrictions/1 
   16get_atts(Var, AccessSpec):-
   17    nonvar(AccessSpec),!,
   18    (AccessSpec=quant(Dom) -> get_attr(Var,quant,quant(Dom)) ;
   19     AccessSpec=restrictions(R) -> get_attr(Var,restrictions,restrictions(R)) ;
   20     writeln('*** ERROR of porting SCIFF from SICStus to SWI ***'),
   21     writeln('*** Please contact SCIFF developers ***')).
   22
   23put_atts(Var, AccessSpec):-
   24    nonvar(AccessSpec),!,
   25    (AccessSpec=quant(Dom) -> put_attr(Var,quant,quant(Dom)) ;
   26     AccessSpec=restrictions(R) -> put_attr(Var,restrictions,restrictions(R)) ;
   27     writeln('*** ERROR of porting SCIFF from SICStus to SWI ***'),
   28     writeln('*** Please contact SCIFF developers ***')).
   29% Forse questo si potrebbe direttamente sostituire, cosi` diventa piu` "standard"
   30term_variables_bag(Term, Variables):-
   31    term_variables(Term, Variables).
   32
   33text_style(Num):-
   34    write_term('\033[',[character_escapes(true)]),
   35    write_term(Num,[character_escapes(true)]),
   36    write_term('m',[character_escapes(true)])