From c51d4513ac34f9266d303df36e48474fdcbb9c52 Mon Sep 17 00:00:00 2001
From: Malik Ammar Faisal <binfaisal.ammar@gmail.com>
Date: Wed, 30 Mar 2022 08:09:36 +0530
Subject: [PATCH] implement binary literal - fixes #2183
---
compiler/src/Parse/Number.hs | 44 ++++++++++++++++++++++++++
compiler/src/Reporting/Error/Syntax.hs | 18 ++++++++++-
2 files changed, 61 insertions(+), 1 deletion(-)
diff --git a/compiler/src/Parse/Number.hs b/compiler/src/Parse/Number.hs
index 107853d07..5d396c227 100644
--- a/compiler/src/Parse/Number.hs
+++ b/compiler/src/Parse/Number.hs
@@ -224,6 +224,9 @@ chompZero pos end =
if word == 0x78 {-x-} then
chompHexInt (plusPtr pos 1) end
+ else if word == 0x62 {-b-} then
+ chompBinInt (plusPtr pos 1) end
+
else if word == 0x2E {-.-} then
chompFraction pos end 0
@@ -246,6 +249,15 @@ chompHexInt pos end =
OkInt newPos answer
+chompBinInt :: Ptr Word8 -> Ptr Word8 -> Outcome
+chompBinInt pos end =
+ let (# newPos, answer #) = chompBin pos end in
+ if answer < 0 then
+ Err newPos E.NumberBinDigit
+ else
+ OkInt newPos answer
+
+
-- CHOMP HEX
@@ -285,6 +297,38 @@ stepHex pos end word acc
+-- CHOMP BIN
+
+{-# INLINE chompBin #-}
+chompBin :: Ptr Word8 -> Ptr Word8 -> (# Ptr Word8, Int #)
+chompBin pos end =
+ chompBinHelp pos end (-1) 0
+
+
+chompBinHelp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> (# Ptr Word8, Int #)
+chompBinHelp pos end answer accumulator =
+ if pos >= end then
+ (# pos, answer #)
+ else
+ let
+ !newAnswer =
+ stepBin pos end (P.unsafeIndex pos) accumulator
+ in
+ if newAnswer < 0 then
+ (# pos, if newAnswer == -1 then answer else -2 #)
+ else
+ chompBinHelp (plusPtr pos 1) end newAnswer newAnswer
+
+
+{-# INLINE stepBin #-}
+stepBin :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> Int
+stepBin pos end word acc
+ | 0x30 {-0-} <= word && word <= 0x31 {-1-} = 2 * acc + fromIntegral (word - 0x30 {-0-})
+ | isDirtyEnd pos end word = -2
+ | True = -1
+
+
+
-- PRECEDENCE
diff --git a/compiler/src/Reporting/Error/Syntax.hs b/compiler/src/Reporting/Error/Syntax.hs
index a8ff1524e..db46788d2 100644
--- a/compiler/src/Reporting/Error/Syntax.hs
+++ b/compiler/src/Reporting/Error/Syntax.hs
@@ -472,6 +472,7 @@ data Number
= NumberEnd
| NumberDot Int
| NumberHexDigit
+ | NumberBinDigit
| NumberNoLeadingZero
@@ -2912,7 +2913,7 @@ toNumberReport source number row col =
D.stack
[ D.reflow $
"I recognize numbers in the following formats:"
- , D.indent 4 $ D.vcat [ "42", "3.14", "6.022e23", "0x002B" ]
+ , D.indent 4 $ D.vcat [ "42", "3.14", "6.022e23", "0x002B", "0b1010" ]
, D.reflow $
"So is there a way to write it like one of those?"
]
@@ -2947,6 +2948,21 @@ toNumberReport source number row col =
]
)
+ NumberBinDigit ->
+ Report.Report "WEIRD BINARY LITERAL" region [] $
+ Code.toSnippet source region Nothing
+ (
+ D.reflow $
+ "I thought I was reading a binary literal until I got here:"
+ ,
+ D.stack
+ [ D.reflow $
+ "Valid binary digits include 0 and 1, so I can\
+ \ only recognize things like this:"
+ , D.indent 4 $ D.vcat [ "0x10", "0x0010", "0x011011" ]
+ ]
+ )
+
NumberNoLeadingZero ->
Report.Report "LEADING ZEROS" region [] $
Code.toSnippet source region Nothing