on master help sign in
Fix source locations for decl syntax

The new decl syntax directive caused errors to be reported at the syntax declaration site rather than the use site. Now, they are reported at the use site. The solution used is the same as for the term syntax fix.

commit93761d531a2287382b37119b815b966cc4083422 authorDavid Raymond Christiansen <david@davidchristiansen.dk> dateMon 24 Aug 2015, 16:43 (11 years ago) parent0655d3d
2 files changed+93−3
src/Idris/AbsSyntaxTree.hs+82−2 src/Idris/Parser.hs+11−1
src/Idris/AbsSyntaxTree.hs+82−2
@@ -751,6 +751,18 @@ data PData' t = PDatadecl { d_name :: Name, -- ^ The name of the datatype
751751 | PLaterdecl { d_name :: Name, d_name_fc :: FC, d_tcon :: t }
752752 -- ^ "Placeholder" for data whose constructors are defined later
753753 deriving Functor
754+
755+-- | Transform the FCs in a PData and its associated terms. The first
756+-- function transforms the general-purpose FCs, and the second transforms
757+-- those that are used for semantic source highlighting, so they can be
758+-- treated specially.
759+mapPDataFC :: (FC -> FC) -> (FC -> FC) -> PData -> PData
760+mapPDataFC f g (PDatadecl n nfc tycon ctors) =
761+ PDatadecl n (g nfc) (mapPTermFC f g tycon) (map ctorFC ctors)
762+ where ctorFC (doc, argDocs, n, nfc, ty, fc, ns) =
763+ (doc, argDocs, n, g nfc, mapPTermFC f g ty, f fc, ns)
764+mapPDataFC f g (PLaterdecl n nfc tycon) =
765+ PLaterdecl n (g nfc) (mapPTermFC f g tycon)
754766{-!
755767deriving instance Binary PData'
756768deriving instance NFData PData'
@@ -763,8 +775,76 @@ type PDecl = PDecl' PTerm
763775type PData = PData' PTerm
764776type PClause = PClause' PTerm
765777
766−-- get all the names declared in a decl
767−
778+-- | Transform the FCs in a PTerm. The first function transforms the
779+-- general-purpose FCs, and the second transforms those that are used
780+-- for semantic source highlighting, so they can be treated specially.
781+mapPDeclFC :: (FC -> FC) -> (FC -> FC) -> PDecl -> PDecl
782+mapPDeclFC f g (PFix fc fixity ops) =
783+ PFix (f fc) fixity ops
784+mapPDeclFC f g (PTy doc argdocs syn fc opts n nfc ty) =
785+ PTy doc argdocs syn (f fc) opts n (g nfc) (mapPTermFC f g ty)
786+mapPDeclFC f g (PPostulate ext doc syn fc nfc opts n ty) =
787+ PPostulate ext doc syn (f fc) (g nfc) opts n (mapPTermFC f g ty)
788+
789+mapPDeclFC f g (PClauses fc opts n clauses) =
790+ PClauses (f fc) opts n (map (fmap (mapPTermFC f g)) clauses)
791+mapPDeclFC f g (PCAF fc n tm) = PCAF (f fc) n (mapPTermFC f g tm)
792+mapPDeclFC f g (PData doc argdocs syn fc opts dat) =
793+ PData doc argdocs syn (f fc) opts (mapPDataFC f g dat)
794+mapPDeclFC f g (PParams fc params decls) =
795+ PParams (f fc)
796+ (map (\(n, ty) -> (n, mapPTermFC f g ty)) params)
797+ (map (mapPDeclFC f g) decls)
798+mapPDeclFC f g (PNamespace ns fc decls) =
799+ PNamespace ns (f fc) (map (mapPDeclFC f g) decls)
800+mapPDeclFC f g (PRecord doc syn fc opts n nfc params paramdocs fields ctor ctorDoc syn') =
801+ PRecord doc syn (f fc) opts n (g nfc)
802+ (map (\(pn, pnfc, plic, ty) -> (pn, g pnfc, plic, mapPTermFC f g ty)) params)
803+ paramdocs
804+ (map (\(fn, plic, ty, fdoc) -> (fmap (\(fn', fnfc) -> (fn', g fnfc)) fn,
805+ plic, mapPTermFC f g ty, fdoc))
806+ fields)
807+ (fmap (\(ctorN, ctorNFC) -> (ctorN, g ctorNFC)) ctor)
808+ ctorDoc
809+ syn'
810+mapPDeclFC f g (PClass doc syn fc constrs n nfc params paramDocs det body ctor ctorDoc) =
811+ PClass doc syn (f fc)
812+ (map (\(constrn, constr) -> (constrn, mapPTermFC f g constr)) constrs)
813+ n (g nfc) (map (\(n, nfc, pty) -> (n, g nfc, mapPTermFC f g pty)) params)
814+ paramDocs (map (\(dn, dnfc) -> (dn, g dnfc)) det)
815+ (map (mapPDeclFC f g) body)
816+ (fmap (\(n, nfc) -> (n, g nfc)) ctor)
817+ ctorDoc
818+mapPDeclFC f g (PInstance doc paramDocs syn fc constrs cn cnfc params instTy instN body) =
819+ PInstance doc paramDocs syn (f fc)
820+ (map (\(constrN, constrT) -> (constrN, mapPTermFC f g constrT)) constrs)
821+ cn (g cnfc) (map (mapPTermFC f g) params)
822+ (mapPTermFC f g instTy)
823+ instN
824+ (map (mapPDeclFC f g) body)
825+mapPDeclFC f g (PDSL n dsl) = PDSL n (fmap (mapPTermFC f g) dsl)
826+mapPDeclFC f g (PSyntax fc syn) = PSyntax (f fc) $
827+ case syn of
828+ Rule syms tm ctxt -> Rule syms (mapPTermFC f g tm) ctxt
829+ DeclRule syms decls -> DeclRule syms (map (mapPDeclFC f g) decls)
830+mapPDeclFC f g (PMutual fc decls) =
831+ PMutual (f fc) (map (mapPDeclFC f g) decls)
832+mapPDeclFC f g (PDirective d) =
833+ PDirective $
834+ case d of
835+ DNameHint n nfc ns ->
836+ DNameHint n (g nfc) (map (\(hn, hnfc) -> (hn, g hnfc)) ns)
837+ DErrorHandlers n nfc n' nfc' ns ->
838+ DErrorHandlers n (g nfc) n' (g nfc') $
839+ map (\(an, anfc) -> (an, g anfc)) ns
840+mapPDeclFC f g (PProvider doc syn fc nfc what n) =
841+ PProvider doc syn (f fc) (g nfc) (fmap (mapPTermFC f g) what) n
842+mapPDeclFC f g (PTransform fc safe l r) =
843+ PTransform (f fc) safe (mapPTermFC f g l) (mapPTermFC f g r)
844+mapPDeclFC f g (PRunElabDecl fc script) =
845+ PRunElabDecl (f fc) (mapPTermFC f g script)
846+
847+-- | Get all the names declared in a declaration
768848declared :: PDecl -> [Name]
769849declared (PFix _ _ _) = []
770850declared (PTy _ _ _ _ _ n fc t) = [n]
src/Idris/Parser.hs+11−1
@@ -248,7 +248,17 @@ externalDecl syn = do i <- get
248248 decls <- declExtensions syn (syntaxRulesList $ syntax_rules i)
249249 FC _ _ end <- getFC
250250 let outerFC = FC fn start end
251− return decls
251+ return $ map (mapPDeclFC (fixFC outerFC)
252+ (fixFCH fn outerFC))
253+ decls
254+ where
255+ -- | Fix non-highlighting FCs to prevent spurious error location reports
256+ fixFC :: FC -> FC -> FC
257+ fixFC outer inner | inner `fcIn` outer = inner
258+ | otherwise = outer
259+ -- | Fix highlighting FCs by obliterating them, to avoid spurious highlights
260+ fixFCH fn outer inner | inner `fcIn` outer = inner
261+ | otherwise = FileFC fn
252262
253263declExtensions :: SyntaxInfo -> [Syntax] -> IdrisParser [PDecl]
254264declExtensions syn rules = declExtension syn [] (filter isDeclRule rules)