Implemented distinct BOOLEAN type for BASIC

Author: totalspectrum

Changelog.txt

@@ -1,6 +1,7 @@
 Version 6.6.0
 - Implemented proper boolean type for C
 - Fixed -- operator for floats
+- Made the BASIC boolean type a distinct type
 
 Version 6.5.4
 - Minor optimization improvement (and major documentation improvements) courtesy of Ada

Test/Expect/basexec03.txt

@@ -17,3 +17,6 @@ closed handle
 0.8000
 0.9000
 1.0000
+0 : a, b = 	0	-1
+1 : a, b = 	-1	0
+2 : a, b = 	-1	-1

Test/basexec03.bas

@@ -45,6 +45,25 @@ for i# = 0.3 to 1.0001 step 0.1
   print i#
 next i#
 
+const two = 2
+sub trybool(x as single)
+  var a = two <> 2
+  dim b as boolean
+
+  b = x
+  print "0 : a, b = ", a, b
+  a -= 2
+  b += 1
+  print "1 : a, b = ", a, b
+  a = two
+  b += 1
+  print "2 : a, b = ", a, b
+  
+end sub
+
+trybool(1.0)
+
+
 ''
 '' send the magic propload status code
 ''

doc/basic.md

@@ -1356,7 +1356,7 @@ Returns the bits of the 32 bit unsigned integer `y` in reverse order. For exampl
 
 ### BOOLEAN
 
-Represents a true or false result. Represented as a 32 bit integer, with TRUE set to all 1's and FALSE set to all 0's. In practice any non-zero value will be accepted as being "true".
+Represents a true or false result. Represented as a 32 bit integer, with TRUE set to all 1's and FALSE set to all 0's. The compiler tries to normalize boolean values to be either TRUE or FALSE, but this may not succeed in all cases. In such cases any non-zero value will be accepted as being "true".
 
 ### __BUILTIN_ALLOCA
 

expr.c

@@ -2856,7 +2856,8 @@ AST *
 ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
 {
     AST *sub;
-
+    int lang = GetCurrentLang();
+    
     if (!expr) return NULL;
     if (!P) {
         P = current;
@@ -2865,7 +2866,7 @@ ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
     case AST_TYPEOF:
         return ExprTypeRelative(table, expr->left, P);
     case AST_INTEGER:
-        if ( IsCLang(P->curLanguage) && expr->d.ival == 0) {
+        if ( IsCLang(lang) && expr->d.ival == 0) {
             return ast_type_generic;
         }
         if (expr->left) {  /* explicit cast */
@@ -2904,12 +2905,12 @@ ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
         // in Spin, a string is always dereferenced
         // so "abc" is the same as "a" is the same as 0x65
         // (actually no -- "abc" is the same as "a", "b", "c")
-        if (curfunc && IsSpinLang(curfunc->language)) {
+        if (IsSpinLang(lang)) {
             return ast_type_long;
         }
     /* otherwise fall through */
     case AST_STRINGPTR:
-        if ( curfunc && curfunc->language == LANG_CFAMILY_C && !(curfunc->warn_flags & WARN_C_CONST_STRING) ) {
+        if ( lang == LANG_CFAMILY_C && curfunc && !(curfunc->warn_flags & WARN_C_CONST_STRING) ) {
             return ast_type_ptr_byte;
         }
         return ast_type_string;
@@ -2952,7 +2953,7 @@ ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
         case SYM_LABEL:
             lab = (Label *)sym->v.ptr;
             typ = lab->type;
-            if (curfunc && IsSpinLang(curfunc->language) && typ && typ->kind != AST_ARRAYTYPE) {
+            if (IsSpinLang(lang) && typ && typ->kind != AST_ARRAYTYPE) {
                 if (typ == ast_type_void) {
                     return typ;
                 }
@@ -3028,11 +3029,11 @@ ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
                 if (typexpr && typexpr->kind == AST_FUNCTYPE) {
                     return typexpr->left;
                 }
-                if ( (IsArrayType(old_typexpr) || IsPointerType(old_typexpr)) && curfunc && IsBasicLang(curfunc->language)) {
+                if ( (IsArrayType(old_typexpr) || IsPointerType(old_typexpr)) && IsBasicLang(lang)) {
                     // in BASIC we may not have converted x(i) into an array reference yet
                     return BaseType(old_typexpr);
                 }
-                if (curfunc && IsSpinLang(curfunc->language)) {
+                if (IsSpinLang(lang)) {
                     if (old_typexpr == NULL) {
                         return NULL;
                     }
@@ -3144,7 +3145,7 @@ ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
                     return ltype;
                 }
             }
-            if (curfunc && IsSpinLang(curfunc->language)) {
+            if (IsSpinLang(lang)) {
                 if (ltype) {
                     //if (IsIntOrGenericType(ltype)) return ltype;
                     if (IsPointerType(ltype)) {
@@ -3193,7 +3194,7 @@ ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
         case '&':
             ltype = ExprTypeRelative(table, expr->left, P);
             rtype = ExprTypeRelative(table, expr->right, P);
-            if (IsBasicLang(GetCurrentLang())) {
+            if (IsBasicLang(lang)) {
                 if (IsStringType(ltype)) {
                     return ltype;
                 } else if (IsStringType(rtype)) {
@@ -3206,7 +3207,25 @@ ExprTypeRelative(SymbolTable *table, AST *expr, Module *P)
             if ( TypeSize(rtype) > LONG_SIZE ) {
                 return ast_type_long64;
             }
-            return ast_type_long;            
+            return ast_type_long;
+        case '<':
+        case '>':
+        case K_EQ:
+        case K_NE:
+        case K_GE:
+        case K_LE:
+        case K_GEU:
+        case K_LEU:
+        case K_GTU:
+        case K_LTU:
+        case K_BOOL_AND:
+        case K_BOOL_OR:
+        case K_BOOL_NOT:
+        {
+            if (IsBasicLang(lang)) {
+                return ast_type_basic_boolean;
+            }
+        }
         default:
             ltype = ExprTypeRelative(table, expr->left, P);
             rtype = ExprTypeRelative(table, expr->right, P);

frontends/basic/basic.y

@@ -2415,7 +2415,7 @@ basetypename:
   | BAS_INTEGER_KW
     { $$ = ast_type_long; }
   | BAS_BOOLEAN
-    { $$ = ast_type_long; }
+    { $$ = ast_type_basic_boolean; }
   | BAS_UINTEGER
     { $$ = ast_type_unsigned_long; }
   | BAS_SINGLE

testlex.c

@@ -32,6 +32,7 @@ AST *ast_type_ptr_byte;
 AST *ast_type_unsigned_long;
 AST *ast_type_void;
 AST *ast_type_long64, *ast_type_unsigned_long64, *ast_type_float64;
+AST *ast_type_c_boolean, *ast_type_basic_boolean;
 
 int gl_p2 = 0;
 int gl_errors = 0;