Implementation of the predicate char_type for a subset

diff --git a/src/prolog/lib/charsio.pl b/src/prolog/lib/charsio.pl
index 0281e83261b8ec3db7a8e2e905212a7053c6d173..e09c21855fed0da188ad7ea0a43b45a4b02bd5fb 100644 (file)
--- a/src/prolog/lib/charsio.pl
+++ b/src/prolog/lib/charsio.pl
@@ -57,10 +57,36 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
     ).
 
 
-char_type(C, T) :-
-    (   var(C) -> throw(error(instantiation_error, char_type/2))
-    ;   atom_length(C, 1) -> '$char_type'(C, T)
-    ;   throw(error(type_error(in_character, C), char_type/2))
+char_type(Char, Type) :-
+    (   var(Char) -> throw(error(instantiation_error, char_type/2))
+    ;   atom_length(Char, 1) ->
+        (   ground(Type) -> '$char_type'(Char, Type)
+        ;   Type = symbolic_control, '$char_type'(Char, Type)
+        ;   Type = layout, '$char_type'(Char, Type)
+        ;   Type = symbolic_hexadecimal, Char = x
+        ;   Type = octal_digit, '$char_type'(Char, Type)
+        ;   Type = binary_digit, '$char_type'(Char, Type)
+        ;   Type = hexadecimal_digit, '$char_type'(Char, Type)
+        ;   Type = exponent, '$char_type'(Char, Type)
+        ;   Type = sign, '$char_type'(Char, Type)
+        ;   Type = upper, '$char_type'(Char, Type)
+        ;   Type = lower, '$char_type'(Char, Type)
+        ;   Type = graphic, '$char_type'(Char, Type)
+        ;   Type = alpha, '$char_type'(Char, Type)
+        ;   Type = decimal_digit, '$char_type'(Char, Type)
+        ;   Type = alnum, '$char_type'(Char, Type)
+        ;   Type = meta, '$char_type'(Char, Type)
+        ;   Type = solo, '$char_type'(Char, Type)
+        ;   Type = prolog, '$char_type'(Char, Type)
+        ;   Type = alphabetic, '$char_type'(Char, Type)
+        ;   Type = whitespace, '$char_type'(Char, Type)
+        ;   Type = control, '$char_type'(Char, Type)
+        ;   Type = numeric, '$char_type'(Char, Type)
+        ;   Type = ascii, '$char_type'(Char, Type)
+        ;   Type = ascii_punctuation, '$char_type'(Char, Type)
+        ;   Type = ascii_graphic, '$char_type'(Char, Type)
+        )
+    ;   throw(error(type_error(in_character, Char), char_type/2))
     ).
 
 

diff --git a/src/prolog/machine/system_calls.rs b/src/prolog/machine/system_calls.rs
index e07c9eb77e33853486852581fa565ff71a7b79a3..fe88f0622d8e6578c7e03234910131432cacedee 100644 (file)
--- a/src/prolog/machine/system_calls.rs
+++ b/src/prolog/machine/system_calls.rs
@@ -1353,54 +1353,79 @@ impl MachineState {
                     }
                     _ => unreachable!()
                 };
-                macro_rules! call {
+                let chars = match a2 {
+                    Addr::Con(h) if self.heap.atom_at(h) => {
+                        if let HeapCellValue::Atom(name, _) = &self.heap[h] {
+                            name.as_str().to_string()
+                        }
+                        else {
+                            unreachable!()
+                        }
+                    }
+                    Addr::Char(c) => {
+                        c.to_string()
+                    }
+                    _ => unreachable!()
+                };
+                self.fail = true; // This predicate fails by default.
+                macro_rules! macro_check {
                     ($id:ident, $name:tt) => {
-                if $id!(c) {
-                    // let string = $name;
-                    // let chars =
-                    //     clause_name!(string.to_string(), indices.atom_tbl);
-                    // let atom = self
-                    //     .heap
-                    //     .to_unifiable(HeapCellValue::Atom(chars, None));
-                    let atom = self.heap.to_unifiable(
-                        HeapCellValue::Atom(clause_name!($name.to_string(), indices.atom_tbl), None)
-                    );
+                if $id!(c) && chars == $name {
+                    self.fail = false;
 
-                    self.unify(atom, a2);
-                }
-                    }
-                }
-                call!(symbolic_control_char, "symbolic_control");
-                call!(space_char, "space");
-                call!(layout_char, "layout");
-                call!(symbolic_hexadecimal_char, "symbolic_hexadecimal");
-                call!(octal_digit_char, "octal_digit");
-                call!(binary_digit_char, "binary_digit");
-                call!(hexadecimal_digit_char, "hexadecimal_digit");
-                call!(exponent_char, "exponent");
-                call!(sign_char, "sign");
-                //call!(new_line_char, "new_line");
-                //call!(comment_1_char, "comment_1");
-                //call!(comment_2_char, "comment_2");
-                //call!(capital_letter_char, "upper");
-                //call!(small_letter_char, "lower");
-                //call!(variable_indicator_char, "variable_indicator");
-                //call!(graphic_char, "graphic");
-                //call!(graphic_token_char, "graphic_token");
-                //call!(alpha_char, "alpha");
-                //call!(decimal_digit_char, "decimal_digit");
-                //call!(decimal_point_char, "decimal_point");
-                call!(alpha_numeric_char, "alnum");
-                //call!(cut_char, "cut");
-                //call!(semicolon_char, "semicolon");
-                //call!(backslash_char, "backslash");
-                //call!(single_quote_char, "single_quote");
-                //call!(double_quote_char, "double_quote");
-                //call!(back_quote_char, "back_quote");
-                //call!(meta_char, "meta");
-                //call!(solo_char, "solo");
-                //call!(prolog_char, "prolog");
-                //self.fail = true;
+                    return return_from_clause!(self.last_call, self);
+                }
+                    }
+                }
+                macro_rules! method_check {
+                    ($id:ident, $name:tt) => {
+                if c.$id() && chars == $name {
+                    self.fail = false;
+
+                    return return_from_clause!(self.last_call, self);
+                }
+                    }
+                }
+                macro_check!(symbolic_control_char, "symbolic_control");
+                // macro_check!(space_char, "space");
+                macro_check!(layout_char, "layout");
+                macro_check!(symbolic_hexadecimal_char, "symbolic_hexadecimal");
+                macro_check!(octal_digit_char, "octal_digit");
+                macro_check!(binary_digit_char, "binary_digit");
+                macro_check!(hexadecimal_digit_char, "hexadecimal_digit");
+                macro_check!(exponent_char, "exponent");
+                macro_check!(sign_char, "sign");
+                // macro_check!(new_line_char, "new_line");
+                // macro_check!(comment_1_char, "comment_1");
+                // macro_check!(comment_2_char, "comment_2");
+                // macro_check!(capital_letter_char, "upper");
+                // macro_check!(small_letter_char, "lower");
+                // macro_check!(variable_indicator_char, "variable_indicator");
+                macro_check!(graphic_char, "graphic");
+                macro_check!(graphic_token_char, "graphic_token");
+                macro_check!(alpha_char, "alpha");
+                macro_check!(decimal_digit_char, "decimal_digit");
+                // macro_check!(decimal_point_char, "decimal_point");
+                // macro_check!(alpha_numeric_char, "alnum");
+                // macro_check!(cut_char, "cut");
+                // macro_check!(semicolon_char, "semicolon");
+                // macro_check!(backslash_char, "backslash");
+                // macro_check!(single_quote_char, "single_quote");
+                // macro_check!(double_quote_char, "double_quote");
+                // macro_check!(back_quote_char, "back_quote");
+                macro_check!(meta_char, "meta");
+                macro_check!(solo_char, "solo");
+                macro_check!(prolog_char, "prolog");
+                method_check!(is_alphabetic, "alphabetic");
+                method_check!(is_lowercase, "lower");
+                method_check!(is_uppercase, "upper");
+                method_check!(is_whitespace, "whitespace");
+                method_check!(is_alphanumeric, "alnum");
+                method_check!(is_control, "control");
+                method_check!(is_numeric, "numeric");
+                method_check!(is_ascii, "ascii");
+                method_check!(is_ascii_punctuation, "ascii_ponctuaction");
+                method_check!(is_ascii_graphic, "ascii_graphic");
             }
             &SystemClauseType::CheckCutPoint => {
                 let addr = self.store(self.deref(self[temp_v!(1)]));