git.iko.soy/Idris-dev
on master help sign in
Updated formatting for Directives.
8b152bbJan de Muijnck-Hughes
src/Idris/Directives.hs+71−59
compare with master
unifiedsplit
@@ -13,28 +13,35 @@ import Util.DynamicLinker
13
13
14-- | Run the action corresponding to a directive
14-- | Run the action corresponding to a directive
15directiveAction :: Directive -> Idris ()
15directiveAction :: Directive -> Idris ()
16−directiveAction (DLib cgn lib) = do addLib cgn lib
16+directiveAction (DLib cgn lib) = do
17+ addLib cgn lib
17− addIBC (IBCLib cgn lib)
18+ addIBC (IBCLib cgn lib)
18
19
19−directiveAction (DLink cgn obj) = do dirs <- allImportDirs
20+directiveAction (DLink cgn obj) = do
21+ dirs <- allImportDirs
20− o <- runIO $ findInPath dirs obj
22+ o <- runIO $ findInPath dirs obj
21− addIBC (IBCObj cgn obj) -- just name, search on loading ibc
23+ addIBC (IBCObj cgn obj) -- just name, search on loading ibc
22− addObjectFile cgn o
24+ addObjectFile cgn o
23
25
24directiveAction (DFlag cgn flag) = do
26directiveAction (DFlag cgn flag) = do
25− let flags = words flag
27+ let flags = words flag
26− mapM_ (\f -> addIBC (IBCCGFlag cgn f)) flags
28+ mapM_ (\f -> addIBC (IBCCGFlag cgn f)) flags
27− mapM_ (addFlag cgn) flags
29+ mapM_ (addFlag cgn) flags
28−
30+
29−directiveAction (DInclude cgn hdr) = do addHdr cgn hdr
31+directiveAction (DInclude cgn hdr) = do
32+ addHdr cgn hdr
30− addIBC (IBCHeader cgn hdr)
33+ addIBC (IBCHeader cgn hdr)
31−
34+
32−directiveAction (DHide n') = do ns <- allNamespaces n'
35+directiveAction (DHide n') = do
36+ ns <- allNamespaces n'
37+ mapM_ (\n -> do
33− mapM_ (\n -> do setAccessibility n Hidden
38+ setAccessibility n Hidden
34− addIBC (IBCAccess n Hidden)) ns
39+ addIBC (IBCAccess n Hidden)) ns
35−directiveAction (DFreeze n') = do ns <- allNamespaces n'
40+directiveAction (DFreeze n') = do
41+ ns <- allNamespaces n'
42+ mapM_ (\n -> do
36− mapM_ (\n -> do setAccessibility n Frozen
43+ setAccessibility n Frozen
37− addIBC (IBCAccess n Frozen)) ns
44+ addIBC (IBCAccess n Frozen)) ns
38
45
39directiveAction (DAccess acc) = do updateIState (\i -> i { default_access = acc })
46directiveAction (DAccess acc) = do updateIState (\i -> i { default_access = acc })
40
47
@@ -42,49 +49,54 @@ directiveAction (DDefault tot) = do updateIState (\i -> i { default_total = tot
42
49
43directiveAction (DLogging lvl) = setLogLevel (fromInteger lvl)
50directiveAction (DLogging lvl) = setLogLevel (fromInteger lvl)
44
51
45−directiveAction (DDynamicLibs libs) = do added <- addDyLib libs
52+directiveAction (DDynamicLibs libs) = do
53+ added <- addDyLib libs
46− case added of
54+ case added of
47− Left lib -> addIBC (IBCDyLib (lib_name lib))
55+ Left lib -> addIBC (IBCDyLib (lib_name lib))
48− Right msg -> fail $ msg
56+ Right msg -> fail $ msg
49−
57+
50−directiveAction (DNameHint ty tyFC ns) = do ty' <- disambiguate ty
58+directiveAction (DNameHint ty tyFC ns) = do
59+ ty' <- disambiguate ty
51− mapM_ (addNameHint ty' . fst) ns
60+ mapM_ (addNameHint ty' . fst) ns
52− mapM_ (\n -> addIBC (IBCNameHint (ty', fst n))) ns
61+ mapM_ (\n -> addIBC (IBCNameHint (ty', fst n))) ns
53− sendHighlighting $
62+ sendHighlighting $
54− [(tyFC, AnnName ty' Nothing Nothing Nothing)] ++
63+ [(tyFC, AnnName ty' Nothing Nothing Nothing)] ++ map (\(n, fc) -> (fc, AnnBoundName n False)) ns
55− map (\(n, fc) -> (fc, AnnBoundName n False)) ns
64+
56−
57−directiveAction (DErrorHandlers fn nfc arg afc ns) =
65+directiveAction (DErrorHandlers fn nfc arg afc ns) = do
58− do fn' <- disambiguate fn
66+ fn' <- disambiguate fn
67+ ns' <- mapM (\(n, fc) -> do
59− ns' <- mapM (\(n, fc) -> do n' <- disambiguate n
68+ n' <- disambiguate n
60− return (n', fc)) ns
69+ return (n', fc)) ns
61− addFunctionErrorHandlers fn' arg (map fst ns')
70+ addFunctionErrorHandlers fn' arg (map fst ns')
62− mapM_ (addIBC .
63− IBCFunctionErrorHandler fn' arg . fst) ns'
71+ mapM_ (addIBC . IBCFunctionErrorHandler fn' arg . fst) ns'
64− sendHighlighting $
72+ sendHighlighting $
65− [(nfc, AnnName fn' Nothing Nothing Nothing),
73+ [ (nfc, AnnName fn' Nothing Nothing Nothing)
66− (afc, AnnBoundName arg False)] ++
74+ , (afc, AnnBoundName arg False)
67− map (\(n, fc) -> (fc, AnnName n Nothing Nothing Nothing)) ns'
75+ ] ++ map (\(n, fc) -> (fc, AnnName n Nothing Nothing Nothing)) ns'
68
76
69directiveAction (DLanguage ext) = addLangExt ext
77directiveAction (DLanguage ext) = addLangExt ext
78+
70−directiveAction (DDeprecate n reason)
79+directiveAction (DDeprecate n reason) = do
71− = do n' <- disambiguate n
80+ n' <- disambiguate n
72− addDeprecated n' reason
81+ addDeprecated n' reason
73− addIBC (IBCDeprecate n' reason)
82+ addIBC (IBCDeprecate n' reason)
83+
74−directiveAction (DAutoImplicits b)
84+directiveAction (DAutoImplicits b) = setAutoImpls b
75− = setAutoImpls b
76−directiveAction (DUsed fc fn arg) = addUsedName fc fn arg
85+directiveAction (DUsed fc fn arg) = addUsedName fc fn arg
77
86
78disambiguate :: Name -> Idris Name
87disambiguate :: Name -> Idris Name
79−disambiguate n = do i <- getIState
88+disambiguate n = do
89+ i <- getIState
80− case lookupCtxtName n (idris_implicits i) of
90+ case lookupCtxtName n (idris_implicits i) of
81− [(n', _)] -> return n'
91+ [(n', _)] -> return n'
82− [] -> throwError (NoSuchVariable n)
92+ [] -> throwError (NoSuchVariable n)
83− more -> throwError (CantResolveAlts (map fst more))
93+ more -> throwError (CantResolveAlts (map fst more))
94+
84
95
85allNamespaces :: Name -> Idris [Name]
96allNamespaces :: Name -> Idris [Name]
86−allNamespaces n = do i <- getIState
97+allNamespaces n = do
98+ i <- getIState
87− case lookupCtxtName n (idris_implicits i) of
99+ case lookupCtxtName n (idris_implicits i) of
88− [(n', _)] -> return [n']
100+ [(n', _)] -> return [n']
89− [] -> throwError (NoSuchVariable n)
101+ [] -> throwError (NoSuchVariable n)
90− more -> return (map fst more)
102+ more -> return (map fst more)