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

:- 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),

   73:- multifile
   74    error:has_type/2,
   75    prolog:generated_predicate/1.   76
   77error:has_type(record(M:Name), X) :-
   78    is_record(Name, M, X).
   79
   80is_record(Name, M, X) :-
   81    current_record(Name, M, _, X, IsX),
   82    !,
   83    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:

• <name>[:<type>][=<default>]

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

• <constructor>_<name>(Record, Value)
• <constructor>_data(?Name, ?Record, ?Value)
• default_<constructor>(-Record)
• is_<constructor>(@Term)
• make_<constructor>(+Fields, -Record)
• make_<constructor>(+Fields, -Record, -RestFields)
• set_<name>_of_<constructor>(+Value, +OldRecord, -New)
• set_<name>_of_<constructor>(+Value, !Record)
• nb_set_<name>_of_<constructor>(+Value, !Record)
• set_<constructor>_fields(+Fields, +Record0, -Record).
• set_<constructor>_fields(+Fields, +Record0, -Record, -RestFields).
• set_<constructor>_field(+Field, +Record0, -Record).
• user:current_record(?<name>, :<constructor>).

In the above, the Fields arguments are a list of the form Name(Value). If a name appears more than once, the last value is used. For make_<constructor>/3, RestFields gets a list of Name(Value) that were not used; make_<constructor>/2 requires that all the names are in the record.

These predicates fail if there is an error (e.g., if make_<constructor>/2 has a field name that isn't in the record); the exceptions are if type checking throws an exception.

  120record(Record) :-
  121    Record == '<compiled>',
  122    !.
  123record(Record) :-
  124    throw(error(context_error(nodirective, record(Record)), _)).

 compile_records(+RecordsDefs, -Clauses) is det

Compile a record specification into a list of clauses.

  131compile_records(Spec,
  132                [ (:- record('<compiled>')) % call to make xref aware of
  133                | Clauses                   % the dependency
  134                ]) :-
  135    phrase(compile_records(Spec), Clauses).
  136
  137compile_records(Var) -->
  138    { var(Var),
  139      !,
  140      instantiation_error(Var)
  141    }.
  142compile_records((A,B)) -->
  143    compile_record(A),
  144    compile_records(B).
  145compile_records(A) -->
  146    compile_record(A).

 compile_record(+Record)// is det

Create clauses for Record.

  152compile_record(RecordDef) -->
  153    { RecordDef =.. [Constructor|Args],
  154      defaults(Args, Defs, TypedArgs),
  155      types(TypedArgs, Names, Types),
  156      atom_concat(default_, Constructor, DefName),
  157      atom_concat(Constructor, '_data', DataName),
  158      DefRecord =.. [Constructor|Defs],
  159      DefClause =.. [DefName,DefRecord],
  160      length(Names, Arity)
  161    },
  162    [ DefClause ],
  163    access_predicates(Names, 1, Arity, Constructor),
  164    data_predicate(Names, 1, Arity, Constructor, DataName),
  165    set_predicates(Names, 1, Arity, Types, Constructor),
  166    set_field_predicates(Names, 1, Arity, Types, Constructor),
  167    make_predicate(Constructor),
  168    is_predicate(Constructor, Types),
  169    current_clause(RecordDef).
  170
  171:- meta_predicate
  172    current_record(?, :),
  173    current_record_predicate(?, :).  174:- multifile
  175    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.

  183current_record(Name, M:Term) :-
  184    current_record(Name, M, Term, _, _).
  185
  186current_clause(RecordDef) -->
  187    { prolog_load_context(module, M),
  188      functor(RecordDef, Name, _),
  189      atom_concat(is_, Name, IsName),
  190      IsX =.. [IsName, X]
  191    },
  192    [ (record):current_record(Name, M, RecordDef, X, IsX)
  193    ].

 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.

  202current_record_predicate(Record, M:PI) :-
  203    (   ground(PI)
  204    ->  Det = true
  205    ;   Det = false
  206    ),
  207    current_record(Record, M:RecordDef),
  208    (   general_record_pred(Record, M:PI)
  209    ;   RecordDef =.. [_|Args],
  210        defaults(Args, _Defs, TypedArgs),
  211        types(TypedArgs, Names, _Types),
  212        member(Field, Names),
  213        field_record_pred(Record, Field, M:PI)
  214    ),
  215    (   Det == true
  216    ->  !
  217    ;   true
  218    ).
  219
  220general_record_pred(Record, _:Name/1) :-
  221    atom_concat(is_, Record, Name).
  222general_record_pred(Record, _:Name/1) :-
  223    atom_concat(default_, Record, Name).
  224general_record_pred(Record, _:Name/A) :-
  225    member(A, [2,3]),
  226    atom_concat(make_, Record, Name).
  227general_record_pred(Record, _:Name/3) :-
  228    atom_concat(Record, '_data', Name).
  229general_record_pred(Record, _:Name/A) :-
  230    member(A, [3,4]),
  231    atomic_list_concat([set_, Record, '_fields'], Name).
  232general_record_pred(Record, _:Name/3) :-
  233    atomic_list_concat([set_, Record, '_field'], Name).
  234
  235field_record_pred(Record, Field, _:Name/2) :-
  236    atomic_list_concat([Record, '_', Field], Name).
  237field_record_pred(Record, Field, _:Name/A) :-
  238    member(A, [2,3]),
  239    atomic_list_concat([set_, Field, '_of_', Record], Name).
  240field_record_pred(Record, Field, _:Name/2) :-
  241    atomic_list_concat([nb_set_, Field, '_of_', Record], Name).
  242
  243prolog:generated_predicate(P) :-
  244    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).
...

  274make_predicate(Constructor) -->
  275    { atomic_list_concat([make_, Constructor], MakePredName),
  276      atomic_list_concat([default_, Constructor], DefPredName),
  277      atomic_list_concat([set_, Constructor, '_fields'], SetFieldsName),
  278      atomic_list_concat([set_, Constructor, '_field'], SetFieldName),
  279      MakeHead3 =.. [MakePredName, Fields, Record],
  280      MakeHead4 =.. [MakePredName, Fields, Record, []],
  281      MakeClause3 = (MakeHead3 :- MakeHead4),
  282      MakeHead =.. [MakePredName, Fields, Record, RestFields],
  283      DefGoal  =.. [DefPredName, Record0],
  284      SetGoal  =.. [SetFieldsName, Fields, Record0, Record, RestFields],
  285      MakeClause = (MakeHead :- DefGoal, SetGoal),
  286      SetHead3 =.. [SetFieldsName, Fields, R0, R],
  287      SetHead4 =.. [SetFieldsName, Fields, R0, R, []],
  288      SetClause0 = (SetHead3 :- SetHead4),
  289      SetClause1 =.. [SetFieldsName, [], R, R, []],
  290      SetHead2  =.. [SetFieldsName, [H|T], R0, R, RF],
  291      SetGoal2a =.. [SetFieldName, H, R0, R1],
  292      SetGoal2b =.. [SetFieldsName, T, R1, R, RF],
  293      SetGoal2c =.. [SetFieldsName, T, R0, R, RF1],
  294      SetClause2 = (SetHead2 :- (SetGoal2a -> SetGoal2b ; RF=[H|RF1], SetGoal2c))
  295    },
  296    [ MakeClause3, MakeClause, SetClause0, SetClause1, SetClause2 ].

 is_predicate(+Constructor, +Types)// is det

Create a clause that tests for a given record type.

  302is_predicate(Constructor, Types) -->
  303    { type_checks(Types, Vars, Body0),
  304      clean_body(Body0, Body),
  305      Term =.. [Constructor|Vars],
  306      atom_concat(is_, Constructor, Name),
  307      Head =.. [Name,VarOrTerm]
  308    },
  309    (   { Body == true }
  310    ->  [ (Head :- nonvar(VarOrTerm), VarOrTerm = Term) ]
  311    ;   [ (Head :- nonvar(VarOrTerm), VarOrTerm = Term, Body) ]
  312    ).
  313
  314type_checks([], [], true).
  315type_checks([any|T], [_|Vars], Body) :-
  316    type_checks(T, Vars, Body).
  317type_checks([Type|T], [V|Vars], (Goal, Body)) :-
  318    type_goal(Type, V, Goal),
  319    type_checks(T, Vars, Body).

 type_goal(+Type, +Var, -BodyTerm) is det

Inline type checking calls.

  325type_goal(Type, Var, Body) :-
  326    current_type(Type, Var, Body),
  327    !.
  328type_goal(record(Record), Var, Body) :-
  329    !,
  330    atom_concat(is_, Record, Pred),
  331    Body =.. [Pred,Var].
  332type_goal(Record, Var, Body) :-
  333    atom(Record),
  334    !,
  335    atom_concat(is_, Record, Pred),
  336    Body =.. [Pred,Var].
  337type_goal(Type, _, _) :-
  338    domain_error(type, Type).
  339
  340
  341clean_body(Var, G) :-
  342    var(Var),
  343    !,
  344    G = Var.
  345clean_body(M:C0, G) :-
  346    nonvar(C0),
  347    control(C0),
  348    !,
  349    C0 =.. [Name|Args0],
  350    clean_args(Args0, M, Args),
  351    G =.. [Name|Args].
  352clean_body((A0,true), A) :-
  353    !,
  354    clean_body(A0, A).
  355clean_body((true,A0), A) :-
  356    !,
  357    clean_body(A0, A).
  358clean_body(C0, G) :-
  359    control(C0),
  360    !,
  361    C0 =.. [Name|Args0],
  362    clean_args(Args0, Args),
  363    G =.. [Name|Args].
  364clean_body(_:A, A) :-
  365    predicate_property(system:A, built_in),
  366    \+ predicate_property(system:A, meta_predicate(_)),
  367    !.
  368clean_body(A, A).
  369
  370clean_args([], []).
  371clean_args([H0|T0], [H|T]) :-
  372    clean_body(H0, H),
  373    clean_args(T0, T).
  374
  375clean_args([], _, []).
  376clean_args([H0|T0], M, [H|T]) :-
  377    clean_body(M:H0, H),
  378    clean_args(T0, M, T).
  379
  380control((_,_)).
  381control((_;_)).
  382control((_->_)).
  383control((_*->_)).
  384control(\+(_)).

 access_predicates(+Names, +Idx0, +Arity, +Constructor)// is det

Create the <constructor>_<name>(Record, Value) predicates.

  391access_predicates([], _, _, _) -->
  392    [].
  393access_predicates([Name|NT], I, Arity, Constructor) -->
  394    { atomic_list_concat([Constructor, '_', Name], PredName),
  395      functor(Record, Constructor, Arity),
  396      arg(I, Record, Value),
  397      Clause =.. [PredName, Record, Value],
  398      I2 is I + 1
  399    },
  400    [Clause],
  401    access_predicates(NT, I2, Arity, Constructor).

 data_predicate(+Names, +Idx0, +Arity, +Constructor, +DataName)// is det

Create the <constructor>_data(Name, Record, Value) predicate.

  408data_predicate([], _, _, _, _) -->
  409    [].
  410data_predicate([Name|NT], I, Arity, Constructor, DataName) -->
  411    { functor(Record, Constructor, Arity),
  412      arg(I, Record, Value),
  413      Clause =.. [DataName, Name, Record, Value],
  414      I2 is I + 1
  415    },
  416    [Clause],
  417    data_predicate(NT, I2, Arity, Constructor, DataName).

 set_predicates(+Names, +Idx0, +Arity, +Types, +Constructor)// is det

Create the clauses

• set_<name>_of_<constructor>(Value, Old, New)
• set_<name>_of_<constructor>(Value, Record)

  427set_predicates([], _, _, _, _) -->
  428    [].
  429set_predicates([Name|NT], I, Arity, [Type|TT], Constructor) -->
  430    { atomic_list_concat(['set_', Name, '_of_', Constructor], PredName),
  431      atomic_list_concat(['nb_set_', Name, '_of_', Constructor], NBPredName),
  432      length(Args, Arity),
  433      replace_nth(I, Args, Value, NewArgs),
  434      Old =.. [Constructor|Args],
  435      New =.. [Constructor|NewArgs],
  436      Head =.. [PredName, Value, Old, New],
  437      SetHead =.. [PredName, Value, Term],
  438      NBSetHead =.. [NBPredName, Value, Term],
  439      (   Type == any
  440      ->  Clause = Head,
  441          SetClause = (SetHead :- setarg(I, Term, Value)),
  442          NBSetClause = (NBSetHead :- nb_setarg(I, Term, Value))
  443      ;   type_check(Type, Value, MustBe),
  444          Clause = (Head :- MustBe),
  445          SetClause = (SetHead :- MustBe,
  446                                  setarg(I, Term, Value)),
  447          NBSetClause = (NBSetHead :- MustBe,
  448                                      nb_setarg(I, Term, Value))
  449      ),
  450      I2 is I + 1
  451    },
  452    [ Clause, SetClause, NBSetClause ],
  453    set_predicates(NT, I2, Arity, TT, Constructor).
  454
  455type_check(Type, Value, must_be(Type, Value)) :-
  456    current_type(Type, Value, _),
  457    !.
  458type_check(record(Spec), Value, must_be(record(M:Name), Value)) :-
  459    !,
  460    prolog_load_context(module, C),
  461    strip_module(C:Spec, M, Name).
  462type_check(Atom, Value, Check) :-
  463    atom(Atom),
  464    !,
  465    type_check(record(Atom), Value, Check).

 set_field_predicates(+Names, +Idx0, +Arity, +Types, +Constructor)// is det

Create the clauses

• set_<constructor>_field(<name>(Value), Old, New)

  474set_field_predicates([], _, _, _, _) -->
  475    [].
  476set_field_predicates([Name|NT], I, Arity, [Type|TT], Constructor) -->
  477    { atomic_list_concat(['set_', Constructor, '_field'], FieldPredName),
  478      length(Args, Arity),
  479      replace_nth(I, Args, Value, NewArgs),
  480      Old =.. [Constructor|Args],
  481      New =.. [Constructor|NewArgs],
  482      NameTerm =.. [Name, Value],
  483      SetFieldHead =.. [FieldPredName, NameTerm, Old, New],
  484      (   Type == any
  485      ->  SetField = SetFieldHead
  486      ;   type_check(Type, Value, MustBe),
  487          SetField = (SetFieldHead :- MustBe)
  488      ),
  489      I2 is I + 1
  490    },
  491    [ SetField ],
  492    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.

  499replace_nth(1, [_|T], V, [V|T]) :- !.
  500replace_nth(I, [H|T0], V, [H|T]) :-
  501    I2 is I - 1,
  502    replace_nth(I2, T0, V, T).

 defaults(+ArgsSpecs, -Defaults, -Args)

Strip the default specification from the argument specification.

  509defaults([], [], []).
  510defaults([Arg=Default|T0], [Default|TD], [Arg|TA]) :-
  511    !,
  512    defaults(T0, TD, TA).
  513defaults([Arg|T0], [_|TD], [Arg|TA]) :-
  514    defaults(T0, TD, TA).

 types(+ArgsSpecs, -Defaults, -Args)

Strip the default specification from the argument specification.

  521types([], [], []).
  522types([Name:Type|T0], [Name|TN], [Type|TT]) :-
  523    !,
  524    must_be(atom, Name),
  525    types(T0, TN, TT).
  526types([Name|T0], [Name|TN], [any|TT]) :-
  527    must_be(atom, Name),
  528    types(T0, TN, TT).
  529
  530
  531                 /*******************************
  532                 *            EXPANSION         *
  533                 *******************************/
  534
  535:- multifile
  536    system:term_expansion/2,
  537    sandbox:safe_primitive/1.  538:- dynamic
  539    system:term_expansion/2.  540
  541system:term_expansion((:- record(Record)), Clauses) :-
  542    compile_records(Record, Clauses).
  543
  544sandbox:safe_primitive((record):is_record(_,_,_))