add mvp bitwise left shift operator <<

src/consts.f90

@@ -16,6 +16,7 @@ module syntran__consts_m
 	! Token and syntax node kinds enum.  Is there a better way to do this that
 	! allows re-ordering enums?  Currently it would break kind_name()
 	integer, parameter ::          &
+			less_less_token      = 107, &
 			continue_statement   = 106, &
 			continue_keyword     = 105, &
 			break_statement      = 104, &
@@ -242,6 +243,7 @@ function kind_token(kind)
 			"break statement      ", & ! 104
 			"continue             ", & ! 105
 			"continue statement   ", & ! 106
+			"<<                   ", & ! 107
 			"unknown              "  & ! inf
 		]
 
@@ -369,6 +371,7 @@ function kind_name(kind)
 			"break_statement     ", & ! 104
 			"continue keyword    ", & ! 105
 			"continue statement  ", & ! 106
+			"less_less_token     ", & ! 107
 			"unknown             "  & ! inf (trailing comma hack)
 		]
 			! FIXME: update kind_tokens array too

src/eval.f90

@@ -7,6 +7,7 @@ module syntran__eval_m
 
 	use syntran__bool_m
 	use syntran__math_m
+	use syntran__math_left_shift_m  ! consider grouping/encapsulating in a math bitwise module?
 	use syntran__types_m
 
 	implicit none
@@ -234,6 +235,9 @@ recursive subroutine eval_binary_expr(node, state, res)
 	case (greater_equals_token)
 		call is_ge(left, right, res, node%op%text)
 
+	case (less_less_token)
+		call left_shift(left, right, res, node%op%text)
+
 	case default
 		write(*,*) err_eval_binary_op(node%op%text)
 		call internal_error()

src/lex.f90

@@ -811,6 +811,9 @@ function lex(lexer) result(token)
 			if (lexer%lookahead() == "=") then
 				lexer%pos = lexer%pos + 1
 				token = new_token(less_equals_token, lexer%pos, "<=")
+			else if (lexer%lookahead() == "<") then
+				lexer%pos = lexer%pos + 1
+				token = new_token(less_less_token, lexer%pos, "<<")
 			else
 				token = new_token(less_token, lexer%pos, lexer%current())
 			end if

src/math_bit_left_shift.f90

@@ -0,0 +1,155 @@
+
+!===============================================================================
+
+module syntran__math_left_shift_m
+
+	! Unlike math_bin_*.f90, this source was manually generated, but by copying
+	! from math_bin_subtract.f90 and removing all the f32/f64 cases
+	!
+	! Shifting is defined *only* for integers, not floats.  However, an i32 can
+	! be shifted by i64 and vice-versa.  This will not be the case for bitwise
+	! and, or, etc.
+
+	use syntran__value_m
+
+	implicit none
+
+	interface left_shift
+		module procedure left_shift_value_t
+	end interface left_shift
+
+!===============================================================================
+
+contains
+
+!===============================================================================
+
+subroutine left_shift_value_t(left, right, res, op_text)
+
+	type(value_t), intent(in)  :: left, right
+
+	type(value_t), intent(inout) :: res
+
+	character(len = *), intent(in) :: op_text
+
+	select case (magic**2 * res%type + magic * left%type + right%type)
+	!****
+	case        (magic**2 * array_type + magic * array_type + i32_type)
+		!print *, 'array_type + i32_type'
+
+		select case (left%array%type)
+		case (i32_type)
+			res%array = mold(left%array, i32_type)
+			res%array%i32 = shiftl(left%array%i32, right%sca%i32)
+		case (i64_type)
+			res%array = mold(left%array, i64_type)
+			res%array%i64 = shiftl(left%array%i64, right%sca%i32)
+		case default
+			write(*,*) err_eval_binary_types(op_text)
+			call internal_error()
+		end select
+
+	!****
+	case        (magic**2 * array_type + magic * array_type + i64_type)
+		!print *, 'array_type + i64_type'
+
+		select case (left%array%type)
+		case (i32_type)
+			res%array = mold(left%array, i64_type)
+			res%array%i64 = shiftl(left%array%i32, right%sca%i64)
+		case (i64_type)
+			res%array = mold(left%array, i64_type)
+			res%array%i64 = shiftl(left%array%i64, right%sca%i64)
+		case default
+			write(*,*) err_eval_binary_types(op_text)
+			call internal_error()
+		end select
+
+	!****
+	case        (magic**2 * array_type + magic * i32_type + array_type)
+		!print *, 'i32_type + array_type'
+
+		select case (right%array%type)
+		case (i32_type)
+			res%array = mold(right%array, i32_type)
+			res%array%i32 = shiftl(left%sca%i32, right%array%i32)
+		case (i64_type)
+			res%array = mold(right%array, i64_type)
+			res%array%i64 = shiftl(left%sca%i32, right%array%i64)
+		case default
+			write(*,*) err_eval_binary_types(op_text)
+			call internal_error()
+		end select
+
+	!****
+	case        (magic**2 * array_type + magic * i64_type + array_type)
+		!print *, 'i32_type + array_type'
+
+		select case (right%array%type)
+		case (i32_type)
+			res%array = mold(right%array, i64_type)
+			res%array%i64 = shiftl(left%sca%i64, right%array%i32)
+		case (i64_type)
+			res%array = mold(right%array, i64_type)
+			res%array%i64 = shiftl(left%sca%i64, right%array%i64)
+		case default
+			write(*,*) err_eval_binary_types(op_text)
+			call internal_error()
+		end select
+
+	!****
+	case        (magic**2 * array_type + magic * array_type + array_type)
+
+		select case (magic * left%array%type + right%array%type)
+		case (magic * i32_type + i32_type)
+			res%array = mold(right%array, i32_type)
+			res%array%i32 = shiftl(left%array%i32, right%array%i32)
+
+		case (magic * i64_type + i64_type)
+			res%array = mold(right%array, i64_type)
+			res%array%i64 = shiftl(left%array%i64, right%array%i64)
+
+		case (magic * i32_type + i64_type)
+			res%array = mold(right%array, i64_type)
+			res%array%i64 = shiftl(left%array%i32, right%array%i64)
+
+		case (magic * i64_type + i32_type)
+			res%array = mold(right%array, i64_type)
+			res%array%i64 = shiftl(left%array%i64, right%array%i32)
+
+		case default
+			write(*,*) err_eval_binary_types(op_text)
+			call internal_error()
+
+		end select
+
+	!****
+	case        (magic**2 * i32_type + magic * i32_type + i32_type)
+		res%sca%i32 = shiftl(left%sca%i32, right%sca%i32)
+
+	case        (magic**2 * i64_type + magic * i64_type + i64_type)
+		res%sca%i64 = shiftl(left%sca%i64, right%sca%i64)
+
+	case        (magic**2 * i64_type + magic * i64_type + i32_type)
+		res%sca%i64 = shiftl(left%sca%i64, right%sca%i32)
+
+	case        (magic**2 * i64_type + magic * i32_type + i64_type)
+		res%sca%i64 = shiftl(left%sca%i32, right%sca%i64)
+
+	case        (magic**2 * i32_type + magic * i32_type + i64_type)
+		res%sca%i32 = shiftl(left%sca%i32, right%sca%i64)
+
+	!****
+	case default
+		write(*,*) err_eval_binary_types(op_text)
+		call internal_error()
+	end select
+
+end subroutine left_shift_value_t
+
+!===============================================================================
+
+end module syntran__math_left_shift_m
+
+!===============================================================================
+

src/tests/test.f90

@@ -1628,6 +1628,51 @@ end subroutine unit_test_literals
 
 !===============================================================================
 
+subroutine unit_test_bitwise(npass, nfail)
+
+	! Bitwise operators: shift, and, xor, etc.
+
+	implicit none
+
+	integer, intent(inout) :: npass, nfail
+
+	!********
+
+	character(len = *), parameter :: label = "bitwise operators"
+
+	logical, allocatable :: tests(:)
+
+	write(*,*) "Unit testing "//label//" ..."
+
+	tests = &
+		[   &
+			eval_i32("1 << 0;") == 1, &
+			eval_i32("1 << 1;") == 2, &
+			eval_i32("1 << 3;") == 8, &
+			eval_i32("0x0f << 4;") == 15*16, &
+			eval_i32("0x0f << 4;") == eval_i32("0xf0;"), &
+			eval_i32("0x00ff << 8;") == eval_i32("0xff00;"), &
+			eval_i32("0x00ff00 << 8;") == eval_i32("0xff0000;"), &
+			eval_i32("0xff00_0000 << 1;") == eval_i32("0xfe00_0000;"), &
+			eval_i32("0xff00_0000 << 4;") == eval_i32("0xf000_0000;"), &
+			eval_i32("0xff00_0000 << 8;") == eval_i32("0x0000_0000;"), &
+			eval_i32("0b00001011 << 0;") == eval_i32("0b00001011;"), &
+			eval_i32("0b00001011 << 1;") == eval_i32("0b00010110;"), &
+			eval_i32("0b00001011 << 2;") == eval_i32("0b00101100;"), &
+			eval_i32("0b00001011 << 3;") == eval_i32("0b01011000;"), &
+			eval_i32("0b00001011 << 4;") == eval_i32("0b10110000;"), &
+			.false.  & ! so I don't have to bother w/ trailing commas
+		]
+
+	! Trim dummy false element
+	tests = tests(1: size(tests) - 1)
+
+	call unit_test_coda(tests, label, npass, nfail)
+
+end subroutine unit_test_bitwise
+
+!===============================================================================
+
 subroutine unit_test_i64(npass, nfail)
 
 	! Simple i64 integer tests of arithmetic with single-line
@@ -4217,6 +4262,7 @@ subroutine unit_tests(iostat)
 	call unit_test_struct_1   (npass, nfail)
 	call unit_test_f64_mix    (npass, nfail)
 	call unit_test_literals   (npass, nfail)
+	call unit_test_bitwise    (npass, nfail)
 
 	! TODO: add tests that mock interpreting one line at a time (as opposed to
 	! whole files)

src/types.f90

@@ -1528,6 +1528,11 @@ logical function is_binary_op_allowed(left, op, right, left_arr, right_arr) &
 				allowed = is_num_type(left) .and. is_num_type(right)
 			end if
 
+		case (less_less_token)
+			! Bitwise shift operators work on any combination of ints
+			allowed = is_int_type(left) .and. is_int_type(right)
+			! TODO: arrays in elemental sense
+
 		case (and_keyword, or_keyword)
 
 			if (left == array_type .and. right == array_type) then
@@ -1675,16 +1680,19 @@ integer function get_binary_op_prec(kind) result(prec)
 		! Follow C operator precedence here, except possible for bitwise and/or
 
 		case (sstar_token)
-			prec = 7
+			prec = 8
 
 		case (star_token, slash_token, percent_token)
-			prec = 6
+			prec = 7
 
 		case (plus_token, minus_token)
-			prec = 5
+			prec = 6
 
 		case (less_token, less_equals_token, &
 				greater_token, greater_equals_token)
+			prec = 5
+
+		case (less_less_token)
 			prec = 4
 
 		case (eequals_token, bang_equals_token)
@@ -1886,6 +1894,11 @@ recursive integer function get_binary_op_kind(left, op, right, &
 			kind_ = bool_type
 		end if
 
+	case (less_less_token)
+		! Bitwise shifts always return the left operand's type
+		kind_ = left
+		! TODO: arrays
+
 	case default
 		!print *, 'default'