ENHANCED: Bidirectional char_type/2, addressing #2321.
Suggested by @librarianmage, many thanks!
This commit is contained in:
@@ -20,6 +20,7 @@ read and write chars.
|
||||
:- use_module(library(iso_ext)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(between)).
|
||||
:- use_module(library(iso_ext), [partial_string/1,partial_string/3]).
|
||||
|
||||
fabricate_var_name(VarType, VarName, N) :-
|
||||
@@ -74,9 +75,10 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
|
||||
).
|
||||
|
||||
|
||||
%% char_type(+Char, -Type).
|
||||
%% char_type(?Char, ?Type).
|
||||
%
|
||||
% Given a Char, Type is one of the categories that char fits in.
|
||||
% Type is one of the categories that Char fits in.
|
||||
% At least one of the arguments must be ground.
|
||||
% Possible categories are:
|
||||
%
|
||||
% - `alnum`
|
||||
@@ -132,17 +134,32 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
|
||||
% Note that uppercase and lowercase transformations use a string. This is because
|
||||
% some characters do not map 1:1 between lowercase and uppercase.
|
||||
char_type(Char, Type) :-
|
||||
must_be(character, Char),
|
||||
( ground(Type) ->
|
||||
( ctype(Type) ->
|
||||
'$char_type'(Char, Type)
|
||||
; domain_error(char_type, Type, char_type/2)
|
||||
)
|
||||
; ctype(Type),
|
||||
can_be(character, Char),
|
||||
( \+ ctype(Type) ->
|
||||
domain_error(char_type, Type, char_type/2)
|
||||
; true
|
||||
),
|
||||
( ground(Char) ->
|
||||
ctype(Type),
|
||||
'$char_type'(Char, Type)
|
||||
; ground(Type) ->
|
||||
max_char_code(Max),
|
||||
between(0, Max, Code),
|
||||
char_code(Char, Code),
|
||||
'$char_type'(Char, Type)
|
||||
; must_be(character, Char)
|
||||
).
|
||||
|
||||
|
||||
max_char_code(Max) :-
|
||||
catch((length(_, Code),
|
||||
catch(char_code(Char, Code),
|
||||
error(representation_error(_),_),
|
||||
throw(max_char_code(Code))),
|
||||
false),
|
||||
max_char_code(Code),
|
||||
Max is Code - 1).
|
||||
|
||||
ctype(alnum).
|
||||
ctype(alpha).
|
||||
ctype(alphabetic).
|
||||
|
||||
Reference in New Issue
Block a user