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