@@ -474,76 +474,69 @@ ETS nor `element/2` will work with native records.
474474
475475### Native-record guard BIFs
476476
477- #### `is_record/2 `
477+ #### `is_record/3 `
478478
479- We define a pseudo-BIF `is_record/2`, which will be translated by
480- the compiler to instructions to test whether `Term` is a native
481- record.
479+ The existing `is_record/3` BIF is overloaded to also accept a native record:
482480
483481```erlang
484- is_record(Term :: dynamic(), # Module: Name) -> boolean().
485- is_record (Term :: dynamic(), # Name) -> boolean().
482+ -spec is_record(Term :: dynamic(), Module :: module(), Name :: atom()) -> boolean();
483+ (Term :: dynamic(), Name :: atom(), Arity :: non_neg_integer() ) -> boolean().
486484```
487485
488- The `Module` and `Name` arguments must be atoms.
489-
490- If `Module` is not given, `Name` must refer to either an imported
491- record or to a native record defined in the current module. The compiler
492- will issue a diagnostic if no record having name `Name` is neither imported
493- nor defined in the current module.
486+ If `Module` is a module name and `Name` is an atom, the predicate
487+ returns true if term `Term` is a native-record value with the
488+ corresponding native-record name.
494489
495- Examples :
490+ Example :
496491
497492```erlang
498493-module(misc).
499- -record #user() {a,b,c}.
500-
501- is_user(U) when is_record(U, #user) ->
502- true;
503- is_user(U) when is_record(U, #some_module:other_user) ->
504- true;
505- is_user(_U) ->
506- false.
494+ is_user(U) -> is_record(U, some_module, user).
507495```
508496
509- <!-- -->
497+ #### `is_record/2`
498+
499+ The existing `is_record/2` function is extended to also work on native
500+ records:
510501
511502```erlang
512- -module(example).
513- -import_record(misc, [user/0]).
514- is_user(U) -> is_record(U, #user).
503+ is_record(Term :: dynamic(), Name :: atom()) -> boolean().
515504```
516505
517- > Why not include curly brackets after the record name, for example
518- > `is_record(R, #user{})`?
506+ `Name` must be the name of one of the following:
519507
520- That would look like a record construction, which it is not.
508+ * a tuple record
509+ * a local native record
510+ * a native record imported using `-import_record()'
521511
522- An attempt to use the existing `is_record/2` in the following way will
523- result in a compilation error:
512+ When `is_record / 2 ` is used in a guard , `Name ` must be a literal atom ;
513+ otherwise , there will be a compilation error . There will be a
514+ compilation error if `Name ` is neither the name of a local record nor
515+ an imported native record .
524516
525- ```erlang
526- -module(misc).
527- -record #user() {a,b,c}.
528- is_user(U) -> is_record(U, user).
529- ```
517+ If `is_record / 2 ` is used in a function body , `Name ` is allowed to be a
518+ variable .
530519
531- Rationale: It is preferable to only having one syntax for testing for a
532- native. Therefore, the `#` is required. In practice, when migrating old
533- code, it is better to use pattern matching to test for a record:
520+ Examples :
534521
535522```erlang
536523- module (misc ).
537524- record # user () {a ,b ,c }.
538525
539- is_user(#user{}) ->
540- true;
541- is_user(#some_module:other_user{}) ->
526+ is_user (U ) when is_record (U , user ) ->
542527 true ;
543528is_user (_U ) ->
544529 false .
545530```
546531
532+ <!-- -->
533+
534+ ```erlang
535+ - module (example ).
536+ - import_record (misc , [user / 0 ]).
537+ is_user (U ) -> is_record (U , user ).
538+ ```
539+
547540#### `is_record / 1 `
548541
549542```erlang
0 commit comments