From bc52411ae2ed26cab1d5086ae6df68f23ebbd052 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Wed, 10 Jun 2020 19:59:03 +0200
Subject: Initial state I found the code in

---
 utils/CC/IdSupply.hs | 29 +++++++++++++++++++++++++++++
 utils/CC/Pretty.hs   |  9 +++++++++
 utils/CC/Types.hs    | 44 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 82 insertions(+)
 create mode 100644 utils/CC/IdSupply.hs
 create mode 100644 utils/CC/Pretty.hs
 create mode 100644 utils/CC/Types.hs

(limited to 'utils/CC')

diff --git a/utils/CC/IdSupply.hs b/utils/CC/IdSupply.hs
new file mode 100644
index 0000000..234f6cc
--- /dev/null
+++ b/utils/CC/IdSupply.hs
@@ -0,0 +1,29 @@
+module CC.IdSupply(IdSupply, runIdSupply, genId) where
+
+import Control.Monad.Trans
+
+
+data IdSupply a = IdSupply (Int -> (Int, a))
+
+instance Functor IdSupply where
+    fmap f (IdSupply act) = IdSupply (fmap f . act)
+
+instance Applicative IdSupply where
+    pure x = IdSupply (\idval -> (idval, x))
+    IdSupply f <*> IdSupply x =
+        IdSupply (\idval -> let (idval', f') = f idval
+                            in f' <$> x idval')
+
+instance Monad IdSupply where
+    IdSupply x >>= f =
+        IdSupply (\idval -> let (idval', x') = x idval
+                                IdSupply res = f x'
+                            in res idval')
+
+instance MonadTrans
+
+runIdSupply :: Int -> IdSupply a -> a
+runIdSupply startid (IdSupply f) = snd (f startid)
+
+genId :: IdSupply Int
+genId = IdSupply (\idval -> (idval + 1, idval))
diff --git a/utils/CC/Pretty.hs b/utils/CC/Pretty.hs
new file mode 100644
index 0000000..0a41abe
--- /dev/null
+++ b/utils/CC/Pretty.hs
@@ -0,0 +1,9 @@
+module CC.Pretty where
+
+
+class Pretty a where
+    pretty :: a -> String
+
+
+instance Pretty Int where
+    pretty = show
diff --git a/utils/CC/Types.hs b/utils/CC/Types.hs
new file mode 100644
index 0000000..dc1b0e5
--- /dev/null
+++ b/utils/CC/Types.hs
@@ -0,0 +1,44 @@
+module CC.Types where
+
+import CC.Pretty
+
+
+-- | Names of variables in the program
+type Name = String
+
+-- | Source metadata for compilation
+data Context = Context FilePath
+
+-- | Position in a source file; `SourcePos line column`, both zero-based
+data SourcePos = SourcePos Int Int
+  deriving (Show, Read, Eq, Ord)
+
+instance Pretty SourcePos where
+    pretty (SourcePos line col) = show (line + 1) ++ ":" ++ show (col + 1)
+
+-- | A range in the original source code (for diagnostics and debug
+-- information); [from, to).
+data SourceRange = SourceRange SourcePos SourcePos
+  deriving (Show, Read)
+
+instance Pretty SourceRange where
+    pretty (SourceRange from@(SourcePos fromLine fromCol) to@(SourcePos toLine toCol))
+        | fromLine == toLine =
+            show (fromLine + 1) ++ ":" ++ show (fromCol + 1) ++ "-" ++ show (toCol + 1)
+        | otherwise =
+            show from ++ "-" ++ show to
+
+class HasRange a where
+    range :: a -> SourceRange
+
+mergeRange :: SourceRange -> SourceRange -> SourceRange
+mergeRange (SourceRange p1 p2) (SourceRange q1 q2) = SourceRange (min p1 q1) (max p2 q2)
+
+-- | A newtype with no-op Read and Show instances
+newtype RawString = RawString String
+
+instance Read RawString where
+    readsPrec _ s = [(RawString s, "")]
+
+instance Show RawString where
+    show (RawString s) = s
-- 
cgit v1.2.3-70-g09d2