From: Markus Triska <triska@metalevel.at>
Date: Wed, 7 Feb 2024 19:05:07 +0000 (+0100)
Subject: ENHANCED: Bidirectional char_type/2, addressing #2321.
X-Git-Tag: v0.9.4~9^2
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=53b7d9eec92e0568b5d0d28622abb62dd535f774;p=scryer-prolog.git

ENHANCED: Bidirectional char_type/2, addressing #2321.

Suggested by @librarianmage, many thanks!
---

diff --git a/src/lib/charsio.pl b/src/lib/charsio.pl
index 7ac67c91..7a4186a5 100644
--- a/src/lib/charsio.pl
+++ b/src/lib/charsio.pl
@@ -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).