View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2007-2014, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module((record),
   36          [ (record)/1,                 % +Record
   37            current_record/2,           % ?Name, ?Term
   38            current_record_predicate/2, % ?Record, :PI
   39            op(1150, fx, record)
   40          ]).   41:- use_module(library(error)).

Access compound arguments by name

This module creates a set of predicates to create a default instance, access and modify records represented as a compound term.

The full documentation is with record/1, which must be used as a directive. Here is a simple example declaration and some calls.

:- record point(x:integer=0, y:integer=0).

        default_point(Point),
        point_x(Point, X),
        set_x_of_point(10, Point, Point1),

        make_point([y(20)], YPoint),
author
- Jan Wielemaker
- Richard O'Keefe */
   65:- multifile
   66    error:has_type/2,
   67    prolog:generated_predicate/1.   68
   69error:has_type(record(M:Name), X) :-
   70    is_record(Name, M, X).
   71
   72is_record(Name, M, X) :-
   73    current_record(Name, M, _, X, IsX),
   74    !,
   75    call(M:IsX).
 record(+RecordDef)
Define access predicates for a compound-term. RecordDef is of the form <constructor>(<argument>, ...), where each argument is of the form:

Used a directive, :- record Constructor(Arg, ...) is expanded info the following predicates:

  102record(Record) :-
  103    Record == '<compiled>',
  104    !.
  105record(Record) :-
  106    throw(error(context_error(nodirective, record(Record)), _)).
 compile_records(+RecordsDefs, -Clauses) is det
Compile a record specification into a list of clauses.
  113compile_records(Spec,
  114                [ (:- record('<compiled>')) % call to make xref aware of
  115                | Clauses                   % the dependency
  116                ]) :-
  117    phrase(compile_records(Spec), Clauses).
  118%       maplist(portray_clause, Clauses).
  119
  120compile_records(Var) -->
  121    { var(Var),
  122      !,
  123      instantiation_error(Var)
  124    }.
  125compile_records((A,B)) -->
  126    compile_record(A),
  127    compile_records(B).
  128compile_records(A) -->
  129    compile_record(A).
 compile_record(+Record)// is det
Create clauses for Record.
  135compile_record(RecordDef) -->
  136    { RecordDef =.. [Constructor|Args],
  137      defaults(Args, Defs, TypedArgs),
  138      types(TypedArgs, Names, Types),
  139      atom_concat(default_, Constructor, DefName),
  140      atom_concat(Constructor, '_data', DataName),
  141      DefRecord =.. [Constructor|Defs],
  142      DefClause =.. [DefName,DefRecord],
  143      length(Names, Arity)
  144    },
  145    [ DefClause ],
  146    access_predicates(Names, 1, Arity, Constructor),
  147    data_predicate(Names, 1, Arity, Constructor, DataName),
  148    set_predicates(Names, 1, Arity, Types, Constructor),
  149    set_field_predicates(Names, 1, Arity, Types, Constructor),
  150    make_predicate(Constructor),
  151    is_predicate(Constructor, Types),
  152    current_clause(RecordDef).
  153
  154:- meta_predicate
  155    current_record(?, :),
  156    current_record_predicate(?, :).  157:- multifile
  158    current_record/5.               % Name, Module, Term, X, IsX
 current_record(?Name, :Term)
True if Name is the name of a record defined in the module associated with Term and Term is the user-provided record declaration.
  166current_record(Name, M:Term) :-
  167    current_record(Name, M, Term, _, _).
  168
  169current_clause(RecordDef) -->
  170    { prolog_load_context(module, M),
  171      functor(RecordDef, Name, _),
  172      atom_concat(is_, Name, IsName),
  173      IsX =.. [IsName, X]
  174    },
  175    [ (record):current_record(Name, M, RecordDef, X, IsX)
  176    ].
 current_record_predicate(?Record, ?PI) is nondet
True if PI is the predicate indicator for an access predicate to Record. This predicate is intended to support cross-referencer tools.
  185current_record_predicate(Record, M:PI) :-
  186    (   ground(PI)
  187    ->  Det = true
  188    ;   Det = false
  189    ),
  190    current_record(Record, M:RecordDef),
  191    (   general_record_pred(Record, M:PI)
  192    ;   RecordDef =.. [_|Args],
  193        defaults(Args, _Defs, TypedArgs),
  194        types(TypedArgs, Names, _Types),
  195        member(Field, Names),
  196        field_record_pred(Record, Field, M:PI)
  197    ),
  198    (   Det == true
  199    ->  !
  200    ;   true
  201    ).
  202
  203general_record_pred(Record, _:Name/1) :-
  204    atom_concat(is_, Record, Name).
  205general_record_pred(Record, _:Name/1) :-
  206    atom_concat(default_, Record, Name).
  207general_record_pred(Record, _:Name/A) :-
  208    member(A, [2,3]),
  209    atom_concat(make_, Record, Name).
  210general_record_pred(Record, _:Name/3) :-
  211    atom_concat(Record, '_data', Name).
  212general_record_pred(Record, _:Name/A) :-
  213    member(A, [3,4]),
  214    atomic_list_concat([set_, Record, '_fields'], Name).
  215general_record_pred(Record, _:Name/3) :-
  216    atomic_list_concat([set_, Record, '_field'], Name).
  217
  218field_record_pred(Record, Field, _:Name/2) :-
  219    atomic_list_concat([Record, '_', Field], Name).
  220field_record_pred(Record, Field, _:Name/A) :-
  221    member(A, [2,3]),
  222    atomic_list_concat([set_, Field, '_of_', Record], Name).
  223field_record_pred(Record, Field, _:Name/2) :-
  224    atomic_list_concat([nb_set_, Field, '_of_', Record], Name).
  225
  226prolog:generated_predicate(P) :-
  227    current_record_predicate(_, P).
 make_predicate(+Constructor)// is det
Creates the make_<constructor>(+Fields, -Record) predicate. This looks like this: 
make_<constructor>(Fields, Record) :-
        make_<constructor>(Fields, Record, [])

make_<constructor>(Fields, Record, RestFields) :-
        default_<constructor>(Record0),
        set_<constructor>_fields(Fields, Record0, Record, RestFields).

set_<constructor>_fields(Fields, Record0, Record) :-
        set_<constructor>_fields(Fields, Record0, Record, []).

set_<constructor>_fields([], Record, Record, []).
set_<constructor>_fields([H|T], Record0, Record, RestFields) :-
        (   set_<constructor>_field(H, Record0, Record1)
        ->  set_<constructor>_fields(T, Record1, Record, RestFields)
        ;   RestFields = [H|RF],
            set_<constructor>_fields(T, Record0, Record, RF)
        ).

set_<constructor>_field(<name1>(Value), Record0, Record).
...
  257make_predicate(Constructor) -->
  258    { atomic_list_concat([make_, Constructor], MakePredName),
  259      atomic_list_concat([default_, Constructor], DefPredName),
  260      atomic_list_concat([set_, Constructor, '_fields'], SetFieldsName),
  261      atomic_list_concat([set_, Constructor, '_field'], SetFieldName),
  262      MakeHead3 =.. [MakePredName, Fields, Record],
  263      MakeHead4 =.. [MakePredName, Fields, Record, []],
  264      MakeClause3 = (MakeHead3 :- MakeHead4),
  265      MakeHead =.. [MakePredName, Fields, Record, RestFields],
  266      DefGoal  =.. [DefPredName, Record0],
  267      SetGoal  =.. [SetFieldsName, Fields, Record0, Record, RestFields],
  268      MakeClause = (MakeHead :- DefGoal, SetGoal),
  269      SetHead3 =.. [SetFieldsName, Fields, R0, R],
  270      SetHead4 =.. [SetFieldsName, Fields, R0, R, []],
  271      SetClause0 = (SetHead3 :- SetHead4),
  272      SetClause1 =.. [SetFieldsName, [], R, R, []],
  273      SetHead2  =.. [SetFieldsName, [H|T], R0, R, RF],
  274      SetGoal2a =.. [SetFieldName, H, R0, R1],
  275      SetGoal2b =.. [SetFieldsName, T, R1, R, RF],
  276      SetGoal2c =.. [SetFieldsName, T, R0, R, RF1],
  277      SetClause2 = (SetHead2 :- (SetGoal2a -> SetGoal2b ; RF=[H|RF1], SetGoal2c))
  278    },
  279    [ MakeClause3, MakeClause, SetClause0, SetClause1, SetClause2 ].
 is_predicate(+Constructor, +Types)// is det
Create a clause that tests for a given record type.
  285is_predicate(Constructor, Types) -->
  286    { type_checks(Types, Vars, Body0),
  287      clean_body(Body0, Body),
  288      Term =.. [Constructor|Vars],
  289      atom_concat(is_, Constructor, Name),
  290      Head1 =.. [Name,Var],
  291      Head2 =.. [Name,Term]
  292    },
  293    [   (Head1 :- var(Var), !, fail) ],
  294    (   { Body == true }
  295    ->  [ Head2 ]
  296    ;   [ (Head2 :- Body) ]
  297    ).
  298
  299type_checks([], [], true).
  300type_checks([any|T], [_|Vars], Body) :-
  301    type_checks(T, Vars, Body).
  302type_checks([Type|T], [V|Vars], (Goal, Body)) :-
  303    type_goal(Type, V, Goal),
  304    type_checks(T, Vars, Body).
 type_goal(+Type, +Var, -BodyTerm) is det
Inline type checking calls.
  310type_goal(Type, Var, Body) :-
  311    current_type(Type, Var, Body),
  312    !.
  313type_goal(record(Record), Var, Body) :-
  314    !,
  315    atom_concat(is_, Record, Pred),
  316    Body =.. [Pred,Var].
  317type_goal(Record, Var, Body) :-
  318    atom(Record),
  319    !,
  320    atom_concat(is_, Record, Pred),
  321    Body =.. [Pred,Var].
  322type_goal(Type, _, _) :-
  323    domain_error(type, Type).
  324
  325
  326clean_body(Var, G) :-
  327    var(Var),
  328    !,
  329    G = Var.
  330clean_body(M:C0, G) :-
  331    nonvar(C0),
  332    control(C0),
  333    !,
  334    C0 =.. [Name|Args0],
  335    clean_args(Args0, M, Args),
  336    G =.. [Name|Args].
  337clean_body((A0,true), A) :-
  338    !,
  339    clean_body(A0, A).
  340clean_body((true,A0), A) :-
  341    !,
  342    clean_body(A0, A).
  343clean_body(C0, G) :-
  344    control(C0),
  345    !,
  346    C0 =.. [Name|Args0],
  347    clean_args(Args0, Args),
  348    G =.. [Name|Args].
  349clean_body(_:A, A) :-
  350    predicate_property(system:A, built_in),
  351    \+ predicate_property(system:A, meta_predicate(_)),
  352    !.
  353clean_body(A, A).
  354
  355clean_args([], []).
  356clean_args([H0|T0], [H|T]) :-
  357    clean_body(H0, H),
  358    clean_args(T0, T).
  359
  360clean_args([], _, []).
  361clean_args([H0|T0], M, [H|T]) :-
  362    clean_body(M:H0, H),
  363    clean_args(T0, M, T).
  364
  365control((_,_)).
  366control((_;_)).
  367control((_->_)).
  368control((_*->_)).
  369control(\+(_)).
 access_predicates(+Names, +Idx0, +Arity, +Constructor)// is det
Create the <constructor>_<name>(Record, Value) predicates.
  376access_predicates([], _, _, _) -->
  377    [].
  378access_predicates([Name|NT], I, Arity, Constructor) -->
  379    { atomic_list_concat([Constructor, '_', Name], PredName),
  380      functor(Record, Constructor, Arity),
  381      arg(I, Record, Value),
  382      Clause =.. [PredName, Record, Value],
  383      I2 is I + 1
  384    },
  385    [Clause],
  386    access_predicates(NT, I2, Arity, Constructor).
 data_predicate(+Names, +Idx0, +Arity, +Constructor, +DataName)// is det
Create the <constructor>_data(Name, Record, Value) predicate.
  393data_predicate([], _, _, _, _) -->
  394    [].
  395data_predicate([Name|NT], I, Arity, Constructor, DataName) -->
  396    { functor(Record, Constructor, Arity),
  397      arg(I, Record, Value),
  398      Clause =.. [DataName, Name, Record, Value],
  399      I2 is I + 1
  400    },
  401    [Clause],
  402    data_predicate(NT, I2, Arity, Constructor, DataName).
 set_predicates(+Names, +Idx0, +Arity, +Types, +Constructor)// is det
Create the clauses 
  412set_predicates([], _, _, _, _) -->
  413    [].
  414set_predicates([Name|NT], I, Arity, [Type|TT], Constructor) -->
  415    { atomic_list_concat(['set_', Name, '_of_', Constructor], PredName),
  416      atomic_list_concat(['nb_set_', Name, '_of_', Constructor], NBPredName),
  417      length(Args, Arity),
  418      replace_nth(I, Args, Value, NewArgs),
  419      Old =.. [Constructor|Args],
  420      New =.. [Constructor|NewArgs],
  421      Head =.. [PredName, Value, Old, New],
  422      SetHead =.. [PredName, Value, Term],
  423      NBSetHead =.. [NBPredName, Value, Term],
  424      (   Type == any
  425      ->  Clause = Head,
  426          SetClause = (SetHead :- setarg(I, Term, Value)),
  427          NBSetClause = (NBSetHead :- nb_setarg(I, Term, Value))
  428      ;   type_check(Type, Value, MustBe),
  429          Clause = (Head :- MustBe),
  430          SetClause = (SetHead :- MustBe,
  431                                  setarg(I, Term, Value)),
  432          NBSetClause = (NBSetHead :- MustBe,
  433                                      nb_setarg(I, Term, Value))
  434      ),
  435      I2 is I + 1
  436    },
  437    [ Clause, SetClause, NBSetClause ],
  438    set_predicates(NT, I2, Arity, TT, Constructor).
  439
  440type_check(Type, Value, must_be(Type, Value)) :-
  441    current_type(Type, Value, _),
  442    !.
  443type_check(record(Spec), Value, must_be(record(M:Name), Value)) :-
  444    !,
  445    prolog_load_context(module, C),
  446    strip_module(C:Spec, M, Name).
  447type_check(Atom, Value, Check) :-
  448    atom(Atom),
  449    !,
  450    type_check(record(Atom), Value, Check).
 set_field_predicates(+Names, +Idx0, +Arity, +Types, +Constructor)// is det
Create the clauses 
  459set_field_predicates([], _, _, _, _) -->
  460    [].
  461set_field_predicates([Name|NT], I, Arity, [Type|TT], Constructor) -->
  462    { atomic_list_concat(['set_', Constructor, '_field'], FieldPredName),
  463      length(Args, Arity),
  464      replace_nth(I, Args, Value, NewArgs),
  465      Old =.. [Constructor|Args],
  466      New =.. [Constructor|NewArgs],
  467      NameTerm =.. [Name, Value],
  468      SetFieldHead =.. [FieldPredName, NameTerm, Old, New],
  469      (   Type == any
  470      ->  SetField = SetFieldHead
  471      ;   type_check(Type, Value, MustBe),
  472          SetField = (SetFieldHead :- MustBe)
  473      ),
  474      I2 is I + 1
  475    },
  476    [ SetField ],
  477    set_field_predicates(NT, I2, Arity, TT, Constructor).
 replace_nth(+Index, +List, +Element, -NewList) is det
Replace the Nth (1-based) element of a list.
  484replace_nth(1, [_|T], V, [V|T]) :- !.
  485replace_nth(I, [H|T0], V, [H|T]) :-
  486    I2 is I - 1,
  487    replace_nth(I2, T0, V, T).
 defaults(+ArgsSpecs, -Defaults, -Args)
Strip the default specification from the argument specification.
  494defaults([], [], []).
  495defaults([Arg=Default|T0], [Default|TD], [Arg|TA]) :-
  496    !,
  497    defaults(T0, TD, TA).
  498defaults([Arg|T0], [_|TD], [Arg|TA]) :-
  499    defaults(T0, TD, TA).
 types(+ArgsSpecs, -Defaults, -Args)
Strip the default specification from the argument specification.
  506types([], [], []).
  507types([Name:Type|T0], [Name|TN], [Type|TT]) :-
  508    !,
  509    must_be(atom, Name),
  510    types(T0, TN, TT).
  511types([Name|T0], [Name|TN], [any|TT]) :-
  512    must_be(atom, Name),
  513    types(T0, TN, TT).
  514
  515
  516                 /*******************************
  517                 *            EXPANSION         *
  518                 *******************************/
  519
  520:- multifile
  521    system:term_expansion/2,
  522    sandbox:safe_primitive/1.  523:- dynamic
  524    system:term_expansion/2.  525
  526system:term_expansion((:- record(Record)), Clauses) :-
  527    compile_records(Record, Clauses).
  528
  529sandbox:safe_primitive((record):is_record(_,_,_))