[Git][ghc/ghc][wip/js-staging] GHC.JS: Remove FIXMEs
doyougnu (@doyougnu)
gitlab at gitlab.haskell.org
Wed Aug 24 00:19:31 UTC 2022
doyougnu pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC
Commits:
9e31bb0f by doyougnu at 2022-08-23T20:19:16-04:00
GHC.JS: Remove FIXMEs
JS.Syntax: Remove FIXMEs
JS.Make: remove FIXMEs
JS.Ppr/Transform: Remove FIXMEs
- - - - -
4 changed files:
- compiler/GHC/JS/Make.hs
- compiler/GHC/JS/Ppr.hs
- compiler/GHC/JS/Syntax.hs
- compiler/GHC/JS/Transform.hs
Changes:
=====================================
compiler/GHC/JS/Make.hs
=====================================
@@ -159,7 +159,6 @@ import GHC.Types.Unique.Map
-- Instantiate for any necessary data structures.
class ToJExpr a where
toJExpr :: a -> JExpr
- -- FIXME: Jeff (2022,05): Convert list to Foldable
toJExprFromList :: [a] -> JExpr
toJExprFromList = ValExpr . JList . map toJExpr
@@ -173,8 +172,6 @@ instance ToJExpr () where
toJExpr _ = ValExpr $ JList []
instance ToJExpr Bool where
- -- FIXME: Jeff (2022,05): these 'var "true"' and 'var "false"' should be
- -- constants instead of created on the fly
toJExpr True = var "true"
toJExpr False = var "false"
@@ -231,7 +228,6 @@ class ToStat a where
instance ToStat JStat where
toStat = id
--- FIXME: Jeff (2022,05): Convert list to Foldable
instance ToStat [JStat] where
toStat = BlockStat
@@ -327,7 +323,6 @@ jhSingle k v = jhAdd k v jhEmpty
jhAdd :: (Ord k, ToJExpr a) => k -> a -> M.Map k JExpr -> M.Map k JExpr
jhAdd k v m = M.insert k (toJExpr v) m
--- FIXME: Jeff (2022,05): remove list for foldable and specialize
-- | Construct a JS HashMap from a list of key-value pairs
jhFromList :: [(FastString, JExpr)] -> JVal
jhFromList = JHash . listToUniqMap
@@ -418,7 +413,6 @@ if10 e = IfExpr e one_ zero_
if01 :: JExpr -> JExpr
if01 e = IfExpr e zero_ one_
--- FIXME: Jeff (2022,05): Shouldn't app take an Ident?
-- | an expression application, see related 'appS'
--
-- > app f xs ==> f(xs)
@@ -633,8 +627,6 @@ instance Fractional JExpr where
-- $misc
-- Everything else,
--- FIXME: Jeff (2022,05): Consider moving these
-
-- | Cache "dXXX" field names
dataFieldCache :: Array Int FastString
dataFieldCache = listArray (0,nFieldCache) (map (mkFastString . ('d':) . show) [(0::Int)..nFieldCache])
@@ -674,9 +666,6 @@ allocClsA i = toJExpr (TxtI (clsCache ! i))
class ToSat a where
toSat_ :: a -> [Ident] -> IdentSupply (JStat, [Ident])
--- FIXME: Jeff (2022,05): Remove list to avoid reversals. Obviously ordering is
--- important since we need to reverse so lets use a data structure that produces
--- the correct ordering even if that structure is a bankers queue
instance ToSat [JStat] where
toSat_ f vs = IS $ return $ (BlockStat f, reverse vs)
@@ -689,12 +678,8 @@ instance ToSat JExpr where
instance ToSat [JExpr] where
toSat_ f vs = IS $ return $ (BlockStat $ map expr2stat f, reverse vs)
--- FIXME: Jeff (2022,05): Why type equality and not ToExpr? Also why is the type
--- signature written like a profunctor lmap?
instance (ToSat a, b ~ JExpr) => ToSat (b -> a) where
toSat_ f vs = IS $ do
- -- FIXME Jeff (2022,05): We pop an Ident just to wrap into a JVar and then
- -- push the Ident back onto the Ident stream. Why not just peek?
x <- takeOneIdent
runIdentSupply $ toSat_ (f (ValExpr $ JVar x)) (x:vs)
@@ -707,13 +692,6 @@ expr2stat (IfExpr x y z) = IfStat x (expr2stat y) (expr2stat z)
expr2stat (UOpExpr o x) = UOpStat o x
expr2stat _ = nullStat
--- FIXME: Jeff (2022,05): This function checks for an empty list via the case
--- expression. That the empty case produces an error indicates that this list
--- should be 'NonEmpty'. The fix is to change this type to a NonEmpty list, then
--- when we initialize the environment we /begin/ with a List: [], but once we
--- add the very first ident we convert the list to a NonEmpty. If you check the
--- definition of 'JS.Syntax.newIdentSupply' you'll see that this error case can
--- actually never happen. So we should encode that in the type system!
takeOneIdent :: State [Ident] Ident
takeOneIdent = do
xxs <- get
=====================================
compiler/GHC/JS/Ppr.hs
=====================================
@@ -52,7 +52,6 @@ instance Outputable JVal where
($$$) :: Doc -> Doc -> Doc
---x $$$ y = align (nest 2 $ x $+$ y) -- FIXME (Sylvain, 2022/02)
x $$$ y = nest 2 $ x $+$ y
-- | Render a syntax tree as a pretty-printable document
@@ -92,8 +91,6 @@ braceNest x = char '{' <+> nest 2 x $$ char '}'
braceNest' :: Doc -> Doc
braceNest' x = nest 2 (char '{' $+$ x) $$ char '}'
--- FIXME: Jeff (2022,03): better naming of braceNest'' functions. Stop the
--- madness!
-- somewhat more compact (egyptian style) braces
braceNest'' :: Doc -> Doc
braceNest'' x = nest 2 (char '{' $$ x) $$ char '}'
=====================================
compiler/GHC/JS/Syntax.hs
=====================================
@@ -105,35 +105,6 @@ import GHC.Data.FastString
import GHC.Utils.Monad.State.Strict
import GHC.Types.Unique.Map
--- FIXME: Jeff (2022,03): This state monad is strict, but uses a lazy list as
--- the state, since the strict state monad evaluates to WHNF, this state monad
--- will only evaluate to the first cons cell, i.e., we will be spine strict but
--- store possible huge thunks. This isn't a problem as long as we use this list
--- as a stack, but if we don't then any kind of Functor or Traverse operation
--- over this state will yield a lot of thunks.
---
--- FIXME: Jeff (2022,05): IdentSupply is quite weird, it is used in
--- GHC.JS.Make.ToSat to record new identifiers but uses a list which could be
--- empty, even though the empty case has no denotation in the domain (i.e. it is
--- a meaningless case!) and sure enough newIdentSupply makes sure we can never
--- hit this case! But it is even /more/ weird because it is a wrapper around a
--- state monad /that doesn't/ itself instantiate a state monad! So we end up
--- with a lot of weird unboxing, boxing, and running of this "monad". It is
--- almost as if it wants to redefine 'MonadTransControl'! The situation gets
--- even /more/ weird when you look at the 'GHC.JS.Make.ToSat', which has
--- numerous problems: it isn't polymorphic over the "IdentSupply" monad, of the
--- instances it defines there is only one that is monadic, it has 7 call sites
--- in JS.Make and /each one/ is fed to 'runIdentSupply'. Basically we have a
--- monad that is never called a monad and so is run all over the place to get
--- non-monadic (although still pure) values back out. To make matters worse our
--- ASTs embed this monad statically! See the UnsatFoo constuctors in JExpr,
--- JStat, and JVal. Why do my ASTs know anything about the state of the
--- interpreter!? This is quite the confusion. It confuses the AST with the code
--- that interprets the AST. The fix is to just derive the state monad with
--- generalized newtype deriving and derivingStrategies, and swap this list out
--- for something that is NonEmpty and doesn't need to be reversed all the time!
--- And clean up the mess in the ASTs.
-
-- | A supply of identifiers, possibly empty
newtype IdentSupply a
= IS {runIdentSupply :: State [Ident] a}
@@ -153,8 +124,6 @@ newIdentSupply (Just pfx) = [ TxtI (mconcat [pfx,"_",mkFastString (show x)])
| x <- [(0::Word64)..]
]
--- FIXME: Jeff (2022,05): Create note for reason behind pseudoSaturate
--- FIXME: Jeff (2022,05): make "<<unsatId>>" a constant
-- | Given a Pseudo-saturate a value with garbage @<<unsatId>>@ identifiers.
pseudoSaturate :: IdentSupply a -> a
pseudoSaturate x = evalState (runIdentSupply x) $ newIdentSupply (Just "<<unsatId>>")
@@ -170,19 +139,6 @@ instance Show a => Show (IdentSupply a) where
--------------------------------------------------------------------------------
-- Statements
--------------------------------------------------------------------------------
--- FIXME: Jeff (2022,05): TryStat only conforms to the largest case of the
--- standard. See [try](https://tc39.es/ecma262/#sec-try-statement), notice that
--- we only encode the case where we have: try BLOCK IDENT BLOCK BLOCK, where the
--- inner IDENT BLOCK is actually the Catch production rule. Because we've opted
--- to deeply embed only a single case we are under-specifying the other cases
--- and probably have to check for empty JStats to know which case the TryStat
--- will be. We should partition this out into its own data type.
-
--- FIXME: Jeff (2022,05) Remove the Bools in For and While for real data types
-
--- FIXME: Jeff (2022,05): Why is Application a statement and not an expression?
--- Same for Unary Operators. I guess because these are side-effectual in JS?
-
-- | JavaScript statements, see the [ECMA262
-- Reference](https://tc39.es/ecma262/#sec-ecmascript-language-statements-and-declarations)
-- for details
@@ -211,8 +167,6 @@ type JsLabel = LexicalFastString
instance Semigroup JStat where
(<>) = appendJStat
--- FIXME (Sylvain, 2022/03): should we use OrdList instead of lists in
--- BlockStat?
instance Monoid JStat where
mempty = BlockStat []
@@ -234,9 +188,6 @@ appendJStat mx my = case (mx,my) of
--------------------------------------------------------------------------------
-- Expressions
--------------------------------------------------------------------------------
--- FIXME: annotate expressions with type. This is an EDSL of JS ASTs in Haskell.
--- There are many approaches to leveraging the GHCs type system for correctness
--- guarentees in EDSLs and we should use them
-- | JavaScript Expressions
data JExpr
= ValExpr JVal -- ^ All values are trivially expressions
@@ -458,9 +409,6 @@ jsKeywords = Set.fromList $ TxtI <$>
, "null", "true", "false"
]
--- FIXME (Jeff, 2022/05): This predicate should be encoded in the type system as
--- a newtype over Ident. Basically we should be using nominal typing so that a
--- regular Ident can never be confused with a Keyword
-- | Predicate which checks if input 'Ident' is a JS keyword or not.
isJsKeyword :: Ident -> Bool
isJsKeyword = flip Set.member jsKeywords
=====================================
compiler/GHC/JS/Transform.hs
=====================================
@@ -79,7 +79,6 @@ mapIdent f = (map_expr, map_stat)
JHash me -> ValExpr $ JHash (fmap map_expr me)
JFunc is s -> ValExpr $ JFunc is (map_stat s)
UnsatVal v2 -> ValExpr $ UnsatVal v2
- -- FIXME: shouldn't we transform this into `UnsatExpr (map_val v2)`?
map_stat s = case s of
DeclStat{} -> s
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e31bb0fb8fa192b6456ed0ce1fffa3c315c46d4
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e31bb0fb8fa192b6456ed0ce1fffa3c315c46d4
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220823/1fdda312/attachment-0001.html>
More information about the ghc-commits
mailing list