Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Use Clang fix-its.
  • Loading branch information
Eelis committed May 17, 2015
1 parent a15eca4 commit 93b72f9
Show file tree
Hide file tree
Showing 13 changed files with 239 additions and 121 deletions.
2 changes: 1 addition & 1 deletion etc/compile-config
@@ -1,4 +1,4 @@
GCC="/usr/local/bin/g++"
CLANG="/usr/local/bin/clang++"
GCC_COMPILE_FLAGS="-finput-charset=UTF-8 -std=c++1z -pedantic-errors -Wfatal-errors -Wall -Wextra -Wno-empty-body -Wno-missing-field-initializers -Wwrite-strings -Wno-deprecated -Wno-unused-parameter -Wno-unused-variable -Wno-non-virtual-dtor -Wno-variadic-macros -fno-diagnostics-show-option -fno-use-linker-plugin -fmessage-length=0 -ftemplate-depth-128 -fno-merge-constants -fno-nonansi-builtins -fno-gnu-keywords -fno-elide-constructors -fstrict-aliasing -fstack-protector-all -Winvalid-pch -D_GLIBCXX_DEBUG -D_GLIBCXX_DEBUG_PEDANTIC -Wno-deprecated -Winit-self"
CLANG_COMPILE_FLAGS="-finput-charset=UTF-8 -std=c++1z -pedantic-errors -Wfatal-errors -Wall -Wextra -Wno-empty-body -Wno-missing-field-initializers -Wwrite-strings -Wno-deprecated -Wno-unused-parameter -Wno-unused-variable -Wno-non-virtual-dtor -Wno-variadic-macros -fno-diagnostics-show-option -fmessage-length=0 -ftemplate-depth-128 -fno-gnu-keywords -fno-elide-constructors -fstrict-aliasing -fstack-protector-all -Winvalid-pch -D_GLIBCXX_DEBUG -D_GLIBCXX_DEBUG_PEDANTIC -Wno-deprecated -Winit-self -fsanitize=undefined"
CLANG_COMPILE_FLAGS="-finput-charset=UTF-8 -std=c++1z -pedantic-errors -Wfatal-errors -Wall -Wextra -Wno-empty-body -Wno-missing-field-initializers -Wwrite-strings -Wno-deprecated -Wno-unused-parameter -Wno-unused-variable -Wno-non-virtual-dtor -Wno-variadic-macros -fno-diagnostics-show-option -fmessage-length=0 -ftemplate-depth-128 -fno-gnu-keywords -fno-elide-constructors -fstrict-aliasing -fstack-protector-all -Winvalid-pch -D_GLIBCXX_DEBUG -D_GLIBCXX_DEBUG_PEDANTIC -Wno-deprecated -Winit-self -fsanitize=undefined -fdiagnostics-parseable-fixits"
9 changes: 4 additions & 5 deletions src/Cxx/Basics.hs
Expand Up @@ -53,11 +53,10 @@ make_type_keywords = words "function functions pointer pointers reference refere
data Findable = FindableDataType DataType | FindableConstr Constr | BodyOf DeclaratorId | DeclarationOf DeclaratorId | Constructor | Destructor | ConversionFunction | FindableParameterDeclaration | TemplateParameter | TemplateArgument
-- Todo: ParameterDeclarationOf, TemplateParameterOf, ParameterDeclarationClauseOf, similar to BodyOf. Would be nice to do it in a generic fashion.

data ShortCode
= LongForm Code
| Print Code Code -- Does not include the semicolon.
| Block Code Code -- Does not include Curlies.
| Call Code Code -- /Does/ include Parens.
data AbbreviatedMain
= Print Code -- Does not include the semicolon.
| Block Code -- Does not include Curlies.
| Call Code -- /Does/ include Parens.

data Chunk
= CharLiteral String | StringLiteral' String | RawStringLiteral String String
Expand Down
75 changes: 45 additions & 30 deletions src/Cxx/Operations.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances, PatternGuards, Rank2Types, OverlappingInstances, ScopedTypeVariables, ExistentialQuantification, TypeSynonymInstances, CPP, ViewPatterns #-}
{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, UndecidableInstances, PatternGuards, Rank2Types, OverlappingInstances, ScopedTypeVariables, ExistentialQuantification, TypeSynonymInstances, CPP, ViewPatterns, TupleSections #-}

module Cxx.Operations (apply, mapply, squared, parenthesized, is_primary_TypeSpecifier, split_all_decls, map_plain, shortcut_syntaxes, blob, resume, expand, line_breaks, specT, find, is_pointer_or_reference, namedPathTo, findable_productions, make_edits) where
module Cxx.Operations (apply, mapply, squared, parenthesized, is_primary_TypeSpecifier, split_all_decls, map_plain, parseAbbrMain, requestBody, resume, expand, line_breaks, specT, find, is_pointer_or_reference, namedPathTo, findable_productions, make_edits) where

import qualified Cxx.Show
import qualified Data.List as List
Expand Down Expand Up @@ -31,50 +31,65 @@ map_plain f (Parens c) = Parens $ map (map_plain f) c
map_plain f (Squares c) = Squares $ map (map_plain f) c
map_plain _ x = x

expand :: ShortCode (Code, Maybe Code)
expand (LongForm c) = (c, Nothing)
expand (Block c c') = (c', Just [Plain "\nint main(int argc, char * argv[])", Curlies c])
expand (Call c c') = expand $ Block ([Plain "printf"] ++ c ++ [Plain "\n;"]) c'
expand (Print c c') = expand $ Block ([Plain "::std::cout << "] ++ c ++ [Plain "\n;"]) c'
-- The newline before the semicolon makes //-style comments work.
int_main :: String
int_main = "\nint main(int argc, char * argv[])"

gen :: String String String TString
gen left middle right
= map (, 0) left
++ zip middle [0..]
++ map (, length middle) right

generateMain :: AbbreviatedMain TString
generateMain (Block c) = gen int_main ("{" ++ show c ++ "}") ""
generateMain (Call c) = gen (int_main ++ "{printf") (show c) "\n;}"
generateMain (Print c) = gen (int_main ++ "{::std::cout") ("<<" ++ show c) "\n;}"
-- The newlines make //-style comments work.

cstyle_comments :: Code Code
cstyle_comments = map f where f (SingleComment s) = MultiComment s; f c = c

type ShortCode = (Maybe AbbreviatedMain, Code)

expand_without_main :: ShortCode Code
expand_without_main (LongForm d) = erase_main d
expand_without_main (Nothing, d) = erase_main d
where
erase_main (Plain s : Parens _ : Curlies _ : c) | "main" `List.isInfixOf` s = c
erase_main (Plain s : Parens _ : Plain t : Curlies _ : c)
| "main" `List.isInfixOf` s, all Char.isSpace t = c
erase_main (x : y) = (x :) $ erase_main y
erase_main c = c
expand_without_main (Print _ c) = c
expand_without_main (Call _ c) = c
expand_without_main (Block _ c) = c
expand_without_main (Just _, c) = c

instance Show AbbreviatedMain where
show (Block c) = show [Curlies c]
show (Call c) = show c
show (Print c) = show $ [Plain "<<"] ++ c

blob :: ShortCode Code
blob (LongForm c) = c
blob (Print c c') = [Plain "<<"] ++ c ++ [Plain ";"] ++ c'
blob (Block c c') = Curlies c : c'
blob (Call c c') = c ++ [Plain ";"] ++ c'
requestBody :: ShortCode String
requestBody (m, c) = maybe "" show m ++ show c

resume :: ShortCode ShortCode ShortCode
resume (cstyle_comments . expand_without_main old) new =
case new of
LongForm c LongForm $ old ++ c
Print (cstyle_comments c) c' Print c $ old ++ c'
Block (cstyle_comments c) c' Block c $ old ++ c'
Call (cstyle_comments c) c' Call c $ old ++ c'

shortcut_syntaxes :: Code ShortCode
shortcut_syntaxes (Curlies c : b) = Block c b
shortcut_syntaxes (Plain ('<':'<':x) : y) = uncurry Print $ second total_tail $ break (== Plain ";") $ Plain x : y
shortcut_syntaxes (Parens c : b) = Call (Parens c : x) (total_tail y)
resume (cstyle_comments . expand_without_main old) (m, new) = (m, old ++ new)

type TString = [(Char, Int {- position in the request body -})]

expand :: Code -> (Maybe TString {- generated main -}, TString {- rest -})
expand requestChunks =
( generateMain . mAbbrMain
, zip (show rest) [maybe 0 (length . show) mAbbrMain ..])
where
(mAbbrMain, rest) = parseAbbrMain requestChunks

parseAbbrMain :: Code (Maybe AbbreviatedMain, Code)
parseAbbrMain (Curlies c : b) = (Just (Block c), b)
parseAbbrMain (Plain ('<':'<':a) : b) = (Just (Print x), total_tail y)
where (x, y) = break (== Plain ";") $ Plain a : b
parseAbbrMain (Parens c : b) = (Just (Call (Parens c : x)), total_tail y)
where (x, y) = break (== Plain ";") b
shortcut_syntaxes c = LongForm c
parseAbbrMain c = (Nothing, c)

line_breaks ::Code Code
line_breaks :: Code Code
line_breaks = map $ map_plain $ map $ \c if c == '\\' then '\n' else c

-- Convenience constructors
Expand Down
2 changes: 1 addition & 1 deletion src/Cxx/Parse.hs
Expand Up @@ -24,7 +24,7 @@ This C++ parser is probably extremely inefficient. Fortunately, geordi only ever
-}

module Cxx.Parse (Code, Chunk(..), code, charLit, stringLit, makeType, precedence, parseRequest, makeDeclParser, declaratorIdParser, highlight) where
module Cxx.Parse (Chunk(..), code, charLit, stringLit, makeType, precedence, parseRequest, makeDeclParser, declaratorIdParser, highlight) where

import qualified Data.Char as Char
import qualified Data.List as List
Expand Down
1 change: 1 addition & 0 deletions src/Editing/Commands.hs
Expand Up @@ -76,6 +76,7 @@ data Command
| Swap Substrs (Maybe Substrs)
| Make MakeSubject Cxx.Basics.MakeDeclaration
| Use (AndList UseClause)
| Fix

data FinalCommand
= Show (Maybe Substrs)
Expand Down
22 changes: 14 additions & 8 deletions src/Editing/EditsPreparation.hs
Expand Up @@ -35,6 +35,7 @@ Since most edit clauses refer to parts of a subject snippet, the translation fro
data ResolutionContext = ResolutionContext
{ context_suffix :: String
, _given :: String
, fixIt :: Maybe (TextEdit Char)
, search_range :: Range Char -- Todo: Should this not be an StickyRange?
, well_formed :: E (Cxx.Basics.GeordiRequest, Anchor Char E (Anchor Char))
}
Expand All @@ -58,7 +59,7 @@ fail_with_context s = (s ++) . context_suffix . ask >>= throwError
-- Find instances for things like Relative typically invoke Find instances for constituent clauses on subranges of the range they received themselves. For this we define |narrow|, which simultaneously modifies the search_range and extends the context_suffix:

narrow :: String Range Char Resolver a Resolver a
narrow x y = local $ \(ResolutionContext z v _ w) ResolutionContext (" " ++ x ++ z) v y w
narrow x y = local $ \(ResolutionContext z v f _ w) ResolutionContext (" " ++ x ++ z) v f y w

{- To motivate the well_formed field in ResolutionContext and the InGiven_to_InWf class, we must first describe some general edit command properties we desire.
Expand All @@ -79,7 +80,7 @@ instance Functor FindResult where fmap f (Found x y) = Found x (f y)

instance Find String (NeList (FindResult DualStickyRange)) where
find x = do
ResolutionContext _ s r _ ask
ResolutionContext _ s _ r _ ask
case nonEmpty $ find_occs x $ selectRange r s of
Nothing fail_with_context $ "String `" ++ x ++ "` does not occur"
Just l return $ (Found InGiven . convert . (\o tightRange $ rangeFromTo (offset (pos (start r)) o :: Pos Char) (offset (pos (start r) + length x) o))) . l
Expand All @@ -96,12 +97,12 @@ instance (Find a (NeList b)) ⇒ Find (In a) (NeList b) where
-- For the nontrivial case, we first simply search for incl, which yields a number of DualStickyRanges, which we map to their full_range components. Then, for each StickyRange x that was found, we distinguish between two cases. If x is relative to the current _given, we just use |narrow| to focus our attention on x, and try to find |o| there. If x is relative to the well-formed snippet, then we should find |o| in there, too. So in this case, we want to force the Find instance for |o| to search in the well-formed snippet. We do this by first changing _given to the well-formed snippet and setting the Anchor transformer in well_formed to |return|, and then proceeding with |narrow| as before. We realize this with the following utility function:

inwf :: InGiven_to_InWf a Resolver a Resolver a
inwf re = ReaderT $ \(ResolutionContext w _ r wf) do
inwf re = ReaderT $ \(ResolutionContext w _ f r wf) do
(tree, anchor_trans) or_fail wf
Anchor _ a anchor_trans $ Anchor Before $ start r
Anchor _ b anchor_trans $ Anchor Before $ end r
(inGiven_to_inWf .) $ runReaderT re $ ResolutionContext w
(Cxx.Show.show_simple tree) (rangeFromTo a b) (Right (tree, return))
(Cxx.Show.show_simple tree) f (rangeFromTo a b) (Right (tree, return))

-- Results returned by the re-contexted resolver may be marked as Found InGiven, but since we changed _given to the well-formed snippet, these are really Found InWf, so inwf should adjust them, and that's where the InGiven_to_InWf class comes in.

Expand Down Expand Up @@ -157,8 +158,8 @@ instance (Invertible a, Find a b, Convert (FindResult (StickyRange Char)) b) ⇒

-- More documentation some other time!

findInStr :: Find a b String (E (Cxx.Basics.GeordiRequest, Anchor Char E (Anchor Char))) a E b
findInStr s e x = runReaderT (find x) $ ResolutionContext "." s (fullRange s) e
findInStr :: Find a b String Maybe (TextEdit Char) -> (E (Cxx.Basics.GeordiRequest, Anchor Char E (Anchor Char))) a E b
findInStr s f e x = runReaderT (find x) $ ResolutionContext "." s f (fullRange s) e

instance Find (Around Substrs) (NeList (FindResult DualStickyRange)) where find (Around x) = find x

Expand Down Expand Up @@ -325,7 +326,7 @@ instance Find Position (FindResult (Anchor Char)) where

instance Find UsePattern (FindResult (Range Char)) where
find (UsePattern z) = do
ResolutionContext _ s r _ ask
ResolutionContext _ s _ r _ ask
let
text_tokens = edit_tokens Char.isAlphaNum $ selectRange r s
pattern_tokens = edit_tokens Char.isAlphaNum z
Expand Down Expand Up @@ -395,6 +396,11 @@ instance Find Command [FindResult RequestEdit] where
l (fmap (\(Found _ x) replace_range x)) . find s
(Found InGiven .) . concat . toList . forM l (\x
(TextEdit .) . Cxx.Operations.make_edits (convert x) b 0 tree)
find Fix = do
mf fixIt . ask
case mf of
Nothing throwError "No fix available."
Just f return [Found InGiven $ TextEdit f]

use_tests :: IO ()
use_tests = do
Expand Down Expand Up @@ -455,7 +461,7 @@ use_tests = do
where
u :: String String String String String IO ()
u txt pattern match d rd =
case runReaderT (find (UseString $ flip In Nothing $ Absolute $ UsePattern pattern)) (ResolutionContext "." txt (fullRange txt) (Left "-")) of
case runReaderT (find (UseString $ flip In Nothing $ Absolute $ UsePattern pattern)) (ResolutionContext "." txt Nothing (fullRange txt) (Left "-")) of
Left e fail e
Right (neElim (Found _ (TextEdit (RangeReplaceEdit rng _)), [])) do
test_cmp pattern match (selectRange rng txt)
Expand Down
10 changes: 5 additions & 5 deletions src/Editing/Execute.hs
Expand Up @@ -70,12 +70,12 @@ sequence_edit fs (Found f e) = do
maybe return fold_edit t fs
_ fold_edit e fs

exec_cmd :: String FoldState Command E FoldState
exec_cmd s fs = (>>= foldM sequence_edit fs) .
findInStr s ((tree &&& anchorAdjuster . adjust_to_wf) . milepost fs)
exec_cmd :: Maybe (TextEdit Char) -> String FoldState Command E FoldState
exec_cmd fixit s fs = (>>= foldM sequence_edit fs) .
findInStr s fixit ((tree &&& anchorAdjuster . adjust_to_wf) . milepost fs)

execute :: [Command] EditableRequest E EditableRequest
execute l r@(EditableRequest _ s) = current_request . foldM (exec_cmd s) fs l
execute :: Maybe (TextEdit Char) -> [Command] EditableRequest E EditableRequest
execute fixit l r@(EditableRequest _ s) = current_request . foldM (exec_cmd fixit s) fs l
where
f t = WellFormedMilepost t mempty mempty
fs = (FoldState mempty r $ f . Cxx.Parse.parseRequest s)
1 change: 1 addition & 0 deletions src/Editing/Parse.hs
Expand Up @@ -353,6 +353,7 @@ instance Parse Command where
(kwd ["change"] >>> commit (auto1 Change)) <||>
(kwd ["make"] >>> commit (auto2 Make)) <||>
(kwd ["use"] >>> commit (auto1 Use)) <||>
(kwd ["fix"] >>> commit (arr (const Fix))) <||>
(kwd ["move"] >>> commit (auto1 Move)) <||>
(kwd ["swap"] >>> commit (liftA2 Swap parse (option (kwd ["with"] >>> parse))))

Expand Down
51 changes: 40 additions & 11 deletions src/EvalCxx.hsc
Expand Up @@ -32,24 +32,25 @@ In our code, M is close_range_end.
-}

module EvalCxx (evaluator, WithEvaluation, withEvaluation, noEvaluation, EvaluationResult(..), Request(..), CompileConfig(..)) where
module EvalCxx (evaluator, WithEvaluation, withEvaluation, noEvaluation, EvaluationResult(..), Request(..), CompileConfig(..), Fix(..), Line, Column) where

import qualified ErrorFilters
import qualified System.Directory
import qualified System.Posix.Process (getProcessID)
import qualified Data.Char as Char

import Data.Pointed (Pointed(..))
import Data.Maybe (isNothing)
import Sys (strsignal, strerror)
import Control.Monad (when, liftM2, forM_)
import System.Environment (getEnvironment)
import System.IO (withFile, IOMode(..), hSetEncoding, utf8, hPutStrLn, hGetContents)
import System.IO.Error (tryIOError, ioeGetErrorType, permissionErrorType)
import System.IO (withFile, IOMode(..), hSetEncoding, utf8, hPutStr, hGetContents)
import GHC.IO.Encoding.UTF8 (mkUTF8)
import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
import Foreign.C (CInt, eOK)
import System.Exit (ExitCode(..))
import Data.List ((\\), isPrefixOf)
import Text.Regex (Regex, mkRegex, matchRegex)
import System.Process (createProcess, CmdSpec(..), CreateProcess(..), StdStream(..), waitForProcess)
import System.Posix
(Signal, sigSEGV, sigILL, Resource(..), ResourceLimit(..), ResourceLimits(..), setResourceLimit)
Expand Down Expand Up @@ -122,20 +123,33 @@ subst_parseps = f
s' ' ' : s'
f (c:s) = c : f s

data EvaluationResult = EvaluationResult Stage CaptureResult
-- The capture result of the last stage attempted.
type Line = Int
type Column = Int

data Fix = Fix
{ fix_file :: Int
, fix_begin, fix_end :: (Line, Column)
, fix_replacement :: String }

data EvaluationResult = EvaluationResult
{ stage :: Stage
, captureResult :: CaptureResult
-- The capture result of the last stage attempted.
, returnedFix :: (Maybe Fix) }

instance Show EvaluationResult where
show (EvaluationResult stage (CaptureResult r o)) = subst_parseps $ ErrorFilters.cleanup_output stage o ++
show (EvaluationResult stage (CaptureResult r o) f) =
subst_parseps $ ErrorFilters.cleanup_output stage o ++
if stage == Run
then case r of
Exited ExitSuccess ""
Signaled s | s [sigSEGV, sigILL] parsep : "Undefined behavior detected."
_ (parsep : show r)
else case r of
Exited ExitSuccess if null o then strerror eOK else ""
Exited (ExitFailure _) | not (null o) ""
Exited ExitSuccess if null o then strerror eOK else fixNote
Exited (ExitFailure _) | not (null o) fixNote
_ parsep : show stage ++ ": " ++ show r
where fixNote = if isNothing f then "" else " (fix known)"

compile_env :: [(String, String)]
compile_env =
Expand Down Expand Up @@ -164,7 +178,7 @@ evaluate cfg Request{..} extra_env = do
namedUnits = zip [show i | i <- [0..9::Int]] units

forM_ namedUnits $ \(unit, code) ->
withFile unit WriteMode $ \h hSetEncoding h utf8 >> hPutStrLn h code
withFile unit WriteMode $ \h hSetEncoding h utf8 >> hPutStr h code

baseEnv filter (pass_env . fst) . getEnvironment
let
Expand All @@ -173,9 +187,9 @@ evaluate cfg Request{..} extra_env = do
runStages ((unit, stage) : more) = do
capture_restricted (path stage) (argv unit stage) (envi stage) >>= \case
CaptureResult (Exited (ExitFailure _)) (isMainMissingDiagnostic -> True) | stage == Link
return $ EvaluationResult Compile (CaptureResult (Exited ExitSuccess) "")
return $ EvaluationResult Compile (CaptureResult (Exited ExitSuccess) "") Nothing
CaptureResult (Exited ExitSuccess) "" | not (null more) runStages more
cr return $ EvaluationResult stage cr
cr return $ EvaluationResult stage cr (findFix $ output cr)

path :: Stage String
path Run = "/geordi/run/t"
Expand Down Expand Up @@ -219,6 +233,21 @@ evaluate cfg Request{..} extra_env = do

runStages $ [(unit, s) | (unit, _) <- namedUnits, s <- stages_per_unit] ++ (([],) . final_stages)

unescape :: String String
unescape "" = ""
unescape ('\\':'t':xs) = '\t' : unescape xs
unescape ('\\':'n':xs) = '\n' : unescape xs
unescape ('\\':'"':xs) = '"' : unescape xs
unescape (x:xs) = x : unescape xs

fixitRegex :: Regex
fixitRegex = mkRegex "\nfix-it:\"([0-9])\":\\{([0-9]{1,3}):([0-9]{1,3})-([0-9]{1,3}):([0-9]{1,3})\\}:\"(([^\\]|\\\\(\\\\|n|t|\"))*)\""

findFix :: String Maybe Fix
findFix (matchRegex fixitRegex Just [file, line, col, line', col', s, _, _]) =
Just $ Fix (read file) (read line, read col) (read line', read col') (unescape s)
findFix _ = Nothing

data WithEvaluation a
= WithoutEvaluation a
| WithEvaluation Request (EvaluationResult a)
Expand Down

0 comments on commit 93b72f9

Please sign in to comment.