Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

unflip {mkNixDoc, nvSet{,'}}; refactors #878

Merged
merged 45 commits into from
Mar 11, 2021
Merged
Changes from 1 commit
Commits
Show all changes
45 commits
Select commit Hold shift + click to select a range
6d614e8
Pretty: mkNixDoc: unflip
Anton-Latukha Mar 8, 2021
886d83b
Expr.Types.Annotated: fx inline directive
Anton-Latukha Mar 8, 2021
5583b0a
rm unused RankNTypes; Utils: embed RankNtypes `transport`
Anton-Latukha Mar 8, 2021
82754ad
Value: unflip nvSet{,'}
Anton-Latukha Mar 8, 2021
78651d4
Exec: refactor
Anton-Latukha Mar 8, 2021
d869d20
Exec: refactor
Anton-Latukha Mar 8, 2021
2a47a8e
(mappend -> <>)
Anton-Latukha Mar 8, 2021
b7acde7
Exec: m refactor
Anton-Latukha Mar 8, 2021
a0eba14
Effects: TOC the file structure
Anton-Latukha Mar 8, 2021
5cf0c7b
Effects: put derived instances into structure
Anton-Latukha Mar 8, 2021
90b828a
Eval: m refactor
Anton-Latukha Mar 8, 2021
6cf382e
Eval: refactor (includes (=<<) -> (<$>))
Anton-Latukha Mar 8, 2021
f529db9
Eval: refactor
Anton-Latukha Mar 8, 2021
a0edfaa
Lint: refactor
Anton-Latukha Mar 8, 2021
1d77b58
Lint: add ApplicativeDo extention - very fit here
Anton-Latukha Mar 8, 2021
152138e
Scope: refactor
Anton-Latukha Mar 8, 2021
2c3caf4
Scope: m refactor
Anton-Latukha Mar 8, 2021
0412ab8
(HashMap.empty -> mempty)
Anton-Latukha Mar 8, 2021
d936e95
{Set,Map}.empty-> mempty
Anton-Latukha Mar 8, 2021
0155454
Expr.Types: Alternative.empty -> mempty, it is used for []
Anton-Latukha Mar 8, 2021
d5d853d
Effects: m refactor
Anton-Latukha Mar 8, 2021
2b658fb
Parser: parseFromText: (=<< -> <$>)
Anton-Latukha Mar 8, 2021
9c4d123
Parser: refactor
Anton-Latukha Mar 8, 2021
bb1ebba
Parser: refactor
Anton-Latukha Mar 8, 2021
47b1f03
Parser: make imports explicit
Anton-Latukha Mar 9, 2021
9a7f07c
Parser: m refactor
Anton-Latukha Mar 9, 2021
2a4b7eb
Parser: add ApplicativeDo
Anton-Latukha Mar 9, 2021
200ca83
Value.Equal: refactor
Anton-Latukha Mar 9, 2021
84d9625
Value.Equal: refactor
Anton-Latukha Mar 9, 2021
884e16a
Type.Infer: refactor
Anton-Latukha Mar 9, 2021
9af8917
Builtins: refactor
Anton-Latukha Mar 9, 2021
a86140e
Reduce: reduce: refactor
Anton-Latukha Mar 9, 2021
ea6e8c5
Reduce: reduce: reduce (=<< -> <$>)
Anton-Latukha Mar 9, 2021
fab166d
Reduce: reduce: reduce <$>
Anton-Latukha Mar 9, 2021
78771ce
Eval: addStackFrames: nodge GHC to optimize it
Anton-Latukha Mar 9, 2021
6e23add
Builtins: Eval: evalBinds: (maybe -> =<<)
Anton-Latukha Mar 9, 2021
4e3aa9b
Pretty: refactor
Anton-Latukha Mar 9, 2021
a869b4e
Pretty: refactor
Anton-Latukha Mar 10, 2021
2b326e9
Pretty: refactor
Anton-Latukha Mar 10, 2021
f3e6887
Pretty: refactor
Anton-Latukha Mar 10, 2021
1a3c8e2
Pretty: refactor
Anton-Latukha Mar 10, 2021
24683c3
Pretty: refactor
Anton-Latukha Mar 10, 2021
5e88b8a
Exec: unflip nvSetP
Anton-Latukha Mar 11, 2021
b015ae2
ChangeLog: note on `nvSet{,',P}`
Anton-Latukha Mar 11, 2021
a802a10
ChangeLog: note about `mkNixDoc`
Anton-Latukha Mar 11, 2021
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Lint: refactor
  • Loading branch information
Anton-Latukha committed Mar 8, 2021
commit a0edfaa2b5a07e60aed82e1db0d8f4aee67433db
179 changes: 104 additions & 75 deletions src/Nix/Lint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,14 +57,14 @@ data TAtom
deriving (Show, Eq, Ord)

data NTypeF (m :: * -> *) r
= TConstant [TAtom]
| TStr
| TList r
| TSet (Maybe (HashMap Text r))
| TClosure (Params ())
| TPath
| TBuiltin String (Symbolic m -> m r)
deriving Functor
= TConstant [TAtom]
| TStr
| TList r
| TSet (Maybe (HashMap Text r))
| TClosure (Params ())
| TPath
| TBuiltin String (Symbolic m -> m r)
deriving Functor

compareTypes :: NTypeF m r -> NTypeF m r -> Ordering
compareTypes (TConstant _) (TConstant _) = EQ
Expand All @@ -88,9 +88,9 @@ compareTypes _ TPath = GT
compareTypes (TBuiltin _ _) (TBuiltin _ _) = EQ

data NSymbolicF r
= NAny
| NMany [r]
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
= NAny
| NMany [r]
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

type SThunk (m :: * -> *) = NThunkF m (Symbolic m)

Expand All @@ -101,14 +101,21 @@ data Symbolic m = SV { getSV :: SValue m } | ST { getST :: SThunk m }
instance Show (Symbolic m) where
show _ = "<symbolic>"

everyPossible :: MonadVar m => m (Symbolic m)
everyPossible
:: MonadVar m
=> m (Symbolic m)
everyPossible = packSymbolic NAny

mkSymbolic :: MonadVar m => [NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic
:: MonadVar m
=> [NTypeF m (Symbolic m)]
-> m (Symbolic m)
mkSymbolic xs = packSymbolic (NMany xs)

packSymbolic
:: MonadVar m => NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
:: MonadVar m
=> NSymbolicF (NTypeF m (Symbolic m))
-> m (Symbolic m)
packSymbolic = fmap SV . newVar

unpackSymbolic
Expand Down Expand Up @@ -333,27 +340,33 @@ instance MonadLint e m => MonadEval (Symbolic m) m where
-- each time a name is looked up within the weak scope, and we want to be
-- sure the action it evaluates is to force a thunk, so its value is only
-- computed once.
evalWith scope body = do
s <- defer scope
pushWeakScope ?? body $
(unpackSymbolic >=> \case
NMany [TSet (Just s')] -> pure s'
NMany [TSet Nothing] -> error "NYI: with unknown"
_ -> throwError $ ErrorCall "scope must be a set in with statement"
) =<< demand s

evalIf cond t f = do
t' <- t
f' <- f
let e = NIf cond t' f'
_ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
unify (void e) t' f'

evalAssert cond body = do
body' <- body
let e = NAssert cond body'
_ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
pure body'
evalWith scope body =
do
s <- unpackSymbolic =<< demand =<< defer scope

pushWeakScope
(case s of
NMany [TSet (Just s')] -> pure s'
NMany [TSet Nothing] -> error "NYI: with unknown"
_ -> throwError $ ErrorCall "scope must be a set in with statement"
)
body

evalIf cond t f =
do
t' <- t
f' <- f
let e = NIf cond t' f'

_ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
unify (void e) t' f'

evalAssert cond body =
do
body' <- body
let e = NAssert cond body'
_ <- unify (void e) cond =<< mkSymbolic [TConstant [TBool]]
pure body'

evalApp = (fmap snd .) . lintApp (NBinary NApp () ())
evalAbs params _ = mkSymbolic [TClosure (void params)]
Expand All @@ -367,39 +380,47 @@ lintBinaryOp
-> Symbolic m
-> m (Symbolic m)
-> m (Symbolic m)
lintBinaryOp op lsym rarg = do
rsym <- rarg
y <- defer everyPossible
case op of
NApp -> symerr "lintBinaryOp:NApp: should never get here"
NEq -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y]
NNEq -> check lsym rsym [TConstant [TInt, TBool, TNull], TStr, TList y]

NLt -> check lsym rsym [TConstant [TInt, TBool, TNull]]
NLte -> check lsym rsym [TConstant [TInt, TBool, TNull]]
NGt -> check lsym rsym [TConstant [TInt, TBool, TNull]]
NGte -> check lsym rsym [TConstant [TInt, TBool, TNull]]

NAnd -> check lsym rsym [TConstant [TBool]]
NOr -> check lsym rsym [TConstant [TBool]]
NImpl -> check lsym rsym [TConstant [TBool]]

-- jww (2018-04-01): NYI: Allow Path + Str
NPlus -> check lsym rsym [TConstant [TInt], TStr, TPath]
NMinus -> check lsym rsym [TConstant [TInt]]
NMult -> check lsym rsym [TConstant [TInt]]
NDiv -> check lsym rsym [TConstant [TInt]]

NUpdate -> check lsym rsym [TSet mempty]

NConcat -> check lsym rsym [TList y]
lintBinaryOp op lsym rarg =
do
rsym <- rarg
y <- defer everyPossible

case op of
NApp -> symerr "lintBinaryOp:NApp: should never get here"
_ -> check lsym rsym $
case op of
NEq -> [TConstant [TInt, TBool, TNull], TStr, TList y]
NNEq -> [TConstant [TInt, TBool, TNull], TStr, TList y]

NLt -> [TConstant [TInt, TBool, TNull]]
NLte -> [TConstant [TInt, TBool, TNull]]
NGt -> [TConstant [TInt, TBool, TNull]]
NGte -> [TConstant [TInt, TBool, TNull]]

NAnd -> [TConstant [TBool]]
NOr -> [TConstant [TBool]]
NImpl -> [TConstant [TBool]]

-- jww (2018-04-01): NYI: Allow Path + Str
NPlus -> [TConstant [TInt], TStr, TPath]
NMinus -> [TConstant [TInt]]
NMult -> [TConstant [TInt]]
NDiv -> [TConstant [TInt]]

NUpdate -> [TSet mempty]

NConcat -> [TList y]

_ -> error "Should not be possible" -- symerr or this fun signature should be changed to work in type scope
where
check lsym rsym xs = do
let e = NBinary op lsym rsym
m <- mkSymbolic xs
_ <- unify (void e) lsym m
_ <- unify (void e) rsym m
unify (void e) lsym rsym
check lsym rsym xs =
do
let e = NBinary op lsym rsym

m <- mkSymbolic xs
_ <- unify (void e) lsym m
_ <- unify (void e) rsym m
unify (void e) lsym rsym

infixl 1 `lintApp`
lintApp
Expand Down Expand Up @@ -451,21 +472,29 @@ instance MonadCatch (Lint s) where
runLintM :: Options -> Lint s a -> ST s a
runLintM opts action = do
i <- newVar (1 :: Int)
runFreshIdT i $ flip runReaderT (newContext opts) $ runLint action
runFreshIdT i $ (`runReaderT` newContext opts) $ runLint action

symbolicBaseEnv :: Monad m => m (Scopes m (Symbolic m))
symbolicBaseEnv
:: Monad m
=> m (Scopes m (Symbolic m))
symbolicBaseEnv = pure emptyScopes

lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))
lint opts expr =
runLintM opts
$ symbolicBaseEnv
>>= (`pushScopes` adi (Eval.eval . annotated . getCompose)
Eval.addSourcePositions
expr
runLintM opts $
do
basis <- symbolicBaseEnv

pushScopes
basis
(adi
(Eval.eval . annotated . getCompose)
Eval.addSourcePositions
expr
)

instance Scoped (Symbolic (Lint s)) (Lint s) where
instance
Scoped (Symbolic (Lint s)) (Lint s) where
currentScopes = currentScopesReader
clearScopes = clearScopesReader @(Lint s) @(Symbolic (Lint s))
pushScopes = pushScopesReader
Expand Down