Skip to content

Commit

Permalink
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
make import of Data.Text qualified
Browse files Browse the repository at this point in the history
vidsinghal committed Nov 19, 2024
1 parent 71e0b12 commit dc5597f
Showing 1 changed file with 13 additions and 14 deletions.
27 changes: 13 additions & 14 deletions gibbon-compiler/src/Gibbon/SExpFrontend.hs
Original file line number Diff line number Diff line change
@@ -20,7 +20,6 @@ import qualified Data.List as L
import Data.Loc ( Loc(..), Pos(..))
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Text hiding (map, head, init, last, length, zip, reverse, foldr, show)
import qualified Data.Text as T
import qualified Safe as Sf

@@ -59,7 +58,7 @@ deriving instance Generic HaskLikeAtom
instance (Generic a, Out a) => Out (SExpr a)
instance (Generic a, Out a) => Out (RichSExpr a)
instance Out HaskLikeAtom
instance Out Text where
instance Out T.Text where
doc t = doc (T.unpack t)
docPrec n t = docPrec n (T.unpack t)

@@ -68,10 +67,10 @@ type Sexp = RichSExpr (SC.Located HaskLikeAtom)
prnt :: Sexp -> String
prnt = T.unpack . encodeOne locatedHaskLikePrinter . fromRich

textToVar :: Text -> Var
textToVar :: T.Text -> Var
textToVar = toVar . T.unpack

textToDataCon :: Text -> DataCon
textToDataCon :: T.Text -> DataCon
textToDataCon = T.unpack

-- | Convert Location (s-cargot) to Loc (Data.Loc)
@@ -100,14 +99,14 @@ treelangParser =
addQuoteReader locatedHaskLikeParser

-- Hack:
_stripHashLang :: Text -> Text
_stripHashLang :: T.Text -> T.Text
_stripHashLang txt =
if T.isPrefixOf "#lang" txt
then snd $ T.break (== '\n') txt
-- (\c -> generalCategory c == LineSeparator)
else txt

bracketHacks :: Text -> Text
bracketHacks :: T.Text -> T.Text
bracketHacks = T.map $ \case '[' -> '('
']' -> ')'
x -> x
@@ -298,7 +297,7 @@ typ s = case s of
_ -> error$ "SExpression encodes invalid type:\n "++ show s

-- Some text is a tyvar if it starts with a lowercase alphabet.
isTyVar :: Text -> Bool
isTyVar :: T.Text -> Bool
isTyVar t = isLower h && isAlpha h
where h = T.head t

@@ -332,15 +331,15 @@ falseE = PrimAppE MkFalse []
-- hackySymbol :: String -> Int
-- hackySymbol s = product (L.map ord s)

keywords :: S.Set Text
keywords = S.fromList $ L.map pack $
keywords :: S.Set T.Text
keywords = S.fromList $ L.map T.pack $
[ "quote", "if", "or", "and", "time", "let", "let*"
, "case", "vector-ref", "for/fold", "for/list"
, "insert", "empty-dict", "lookup", "error", "ann"
, "div", "mod", "exp", "rand"
]

isKeyword :: Text -> Bool
isKeyword :: T.Text -> Bool
isKeyword s = s `S.member` keywords

exp :: Sexp -> PassM Exp0
@@ -651,12 +650,12 @@ letbind s =
(textToVar vr, [], , ) <$> newMetaTy <*> exp rhs
_ -> error $ "Badly formed let binding:\n "++prnt s

isPrim :: Text -> Bool
isPrim :: T.Text -> Bool
isPrim p = S.member p (M.keysSet primMap)

-- ^ A map between SExp-frontend prefix function names, and Gibbon
-- abstract Primops.
primMap :: M.Map Text (Prim d)
primMap :: M.Map T.Text (Prim d)
primMap = M.fromList
[ ("+", AddP)
, ("-", SubP)
@@ -693,7 +692,7 @@ primMap = M.fromList
, ("is-big", IsBig)
]

prim :: Text -> Prim Ty0
prim :: T.Text -> Prim Ty0
prim t = case M.lookup t primMap of
Just x -> x
Nothing -> error$ "Internal error, this is not a primitive: "++show t
@@ -708,7 +707,7 @@ handleRequire baseFile (l:ls) =
-- (Ls2 "require" arg) -> do
ls' <- handleRequire baseFile ls
let file = case arg of
RSAtom (SC.At _ (HSString str)) -> (takeDirectory baseFile) </> (unpack str)
RSAtom (SC.At _ (HSString str)) -> (takeDirectory baseFile) </> (T.unpack str)
_ -> error $ "bad require line: " ++ (show arg)
dbgPrintLn lvl $ "Including required file: "++show file
txt <- fmap bracketHacks $ readFile file

0 comments on commit dc5597f

Please sign in to comment.