Convert to full names before computing hashes.

This commit is contained in:
Matus Tejiscak 2020-05-21 23:15:50 +02:00
parent 1e570f5895
commit 8ed8ee463e
4 changed files with 22 additions and 10 deletions

View File

@ -885,6 +885,9 @@ clearCtxt
resetElab : Options -> Options resetElab : Options -> Options
resetElab = record { elabDirectives = defaultElab } resetElab = record { elabDirectives = defaultElab }
-- Beware: if your hashable thing contains (potentially resolved) names,
-- it'll be better to use addHashWithNames to make the hash independent
-- of the internal numbering of names.
export export
addHash : {auto c : Ref Ctxt Defs} -> addHash : {auto c : Ref Ctxt Defs} ->
Hashable a => a -> Core () Hashable a => a -> Core ()
@ -1181,6 +1184,15 @@ prettyName (WithBlock outer idx)
prettyName (NS ns n) = prettyName n prettyName (NS ns n) = prettyName n
prettyName n = pure (show n) prettyName n = pure (show n)
-- Add a hash of a thing that contains names,
-- but convert the internal numbers to full numbers first.
-- This makes the hash not depend on the internal numbering,
-- which is unstable.
export
addHashWithNames : {auto c : Ref Ctxt Defs} ->
Hashable a => HasNames a => a -> Core ()
addHashWithNames x = toFullNames x >>= addHash
export export
setFlag : {auto c : Ref Ctxt Defs} -> setFlag : {auto c : Ref Ctxt Defs} ->
FC -> Name -> DefFlag -> Core () FC -> Name -> DefFlag -> Core ()

View File

@ -107,8 +107,8 @@ checkCon {vars} opts nest env vis tn_in tn (MkImpTy fc cn_in ty_raw)
log 10 $ "Saving from " ++ show cn ++ ": " ++ show (keys (getMetas ty)) log 10 $ "Saving from " ++ show cn ++ ": " ++ show (keys (getMetas ty))
case vis of case vis of
Public => do addHash cn Public => do addHashWithNames cn
addHash fullty addHashWithNames fullty
_ => pure () _ => pure ()
pure (MkCon fc cn !(getArity defs [] fullty) fullty) pure (MkCon fc cn !(getArity defs [] fullty) fullty)
@ -278,8 +278,8 @@ processData {vars} eopts nest env fc vis (MkImpLater dfc n_in ty_raw)
case vis of case vis of
Private => pure () Private => pure ()
_ => do addHash n _ => do addHashWithNames n
addHash fullty addHashWithNames fullty
pure () pure ()
processData {vars} eopts nest env fc vis (MkImpData dfc n_in ty_raw opts cons_raw) processData {vars} eopts nest env fc vis (MkImpData dfc n_in ty_raw opts cons_raw)
@ -323,8 +323,8 @@ processData {vars} eopts nest env fc vis (MkImpData dfc n_in ty_raw opts cons_ra
(TCon 0 arity [] [] defaultFlags [] [] Nothing)) (TCon 0 arity [] [] defaultFlags [] [] Nothing))
case vis of case vis of
Private => pure () Private => pure ()
_ => do addHash n _ => do addHashWithNames n
addHash fullty addHashWithNames fullty
-- Constructors are private if the data type as a whole is -- Constructors are private if the data type as a whole is
-- export -- export

View File

@ -393,8 +393,8 @@ checkClause {vars} mult hashit n opts nest env (PatClause fc lhs_in rhs)
logTerm 3 "RHS term" rhstm logTerm 3 "RHS term" rhstm
when hashit $ when hashit $
do addHash lhstm' do addHashWithNames lhstm'
addHash rhstm addHashWithNames rhstm
-- If the rhs is a hole, record the lhs in the metadata because we -- If the rhs is a hole, record the lhs in the metadata because we
-- might want to split it interactively -- might want to split it interactively

View File

@ -301,5 +301,5 @@ processType {vars} eopts nest env fc rig vis opts (MkImpTy tfc n_in ty_raw)
log 10 $ "Saving from " ++ show n ++ ": " ++ show (keys (getMetas ty)) log 10 $ "Saving from " ++ show n ++ ": " ++ show (keys (getMetas ty))
when (vis /= Private) $ when (vis /= Private) $
do addHash n do addHashWithNames n
addHash ty addHashWithNames ty