{-# OPTIONS  #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Language.Python.Common.ParserUtils 
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- Various utilities to support the Python parser. 
-----------------------------------------------------------------------------

module Language.Python.Common.ParserUtils where

import Data.List (foldl')
import Data.Maybe (isJust)
import Language.Python.Common.AST as AST
import Language.Python.Common.Token as Token 
import Language.Python.Common.ParserMonad hiding (location)
import Language.Python.Common.SrcLocation 

makeConditionalExpr :: ExprSpan -> Maybe (ExprSpan, ExprSpan) -> ExprSpan
makeConditionalExpr :: ExprSpan -> Maybe (ExprSpan, ExprSpan) -> ExprSpan
makeConditionalExpr ExprSpan
e Maybe (ExprSpan, ExprSpan)
Nothing = ExprSpan
e
makeConditionalExpr ExprSpan
e opt :: Maybe (ExprSpan, ExprSpan)
opt@(Just (ExprSpan
cond, ExprSpan
false_branch))
   = ExprSpan -> ExprSpan -> ExprSpan -> SrcSpan -> ExprSpan
forall annot.
Expr annot -> Expr annot -> Expr annot -> annot -> Expr annot
CondExpr ExprSpan
e ExprSpan
cond ExprSpan
false_branch (ExprSpan -> Maybe (ExprSpan, ExprSpan) -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Maybe (ExprSpan, ExprSpan)
opt)

makeBinOp :: ExprSpan -> [(OpSpan, ExprSpan)] -> ExprSpan
makeBinOp :: ExprSpan -> [(OpSpan, ExprSpan)] -> ExprSpan
makeBinOp ExprSpan
e [(OpSpan, ExprSpan)]
es
   = (ExprSpan -> (OpSpan, ExprSpan) -> ExprSpan)
-> ExprSpan -> [(OpSpan, ExprSpan)] -> ExprSpan
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ExprSpan -> (OpSpan, ExprSpan) -> ExprSpan
mkOp ExprSpan
e [(OpSpan, ExprSpan)]
es
   where
   mkOp :: ExprSpan -> (OpSpan, ExprSpan) -> ExprSpan
mkOp ExprSpan
e1 (OpSpan
op, ExprSpan
e2) = OpSpan -> ExprSpan -> ExprSpan -> SrcSpan -> ExprSpan
forall annot.
Op annot -> Expr annot -> Expr annot -> annot -> Expr annot
BinaryOp OpSpan
op ExprSpan
e1 ExprSpan
e2 (ExprSpan -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e1 ExprSpan
e2)

parseError :: Token -> P a 
parseError :: forall a. Token -> P a
parseError = ParseError -> P a
forall a. ParseError -> P a
throwError (ParseError -> P a) -> (Token -> ParseError) -> Token -> P a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> ParseError
UnexpectedToken 

data Trailer
   = TrailerCall { Trailer -> [ArgumentSpan]
trailer_call_args :: [ArgumentSpan], Trailer -> SrcSpan
trailer_span :: SrcSpan }
   | TrailerSubscript { Trailer -> [Subscript]
trailer_subs :: [Subscript], trailer_span :: SrcSpan }
   | TrailerDot { Trailer -> IdentSpan
trailer_dot_ident :: IdentSpan, Trailer -> SrcSpan
dot_span :: SrcSpan, trailer_span :: SrcSpan }

instance Span Trailer where
  getSpan :: Trailer -> SrcSpan
getSpan = Trailer -> SrcSpan
trailer_span

data Subscript
   = SubscriptExpr { Subscript -> ExprSpan
subscription :: ExprSpan, Subscript -> SrcSpan
subscript_span :: SrcSpan }
   | SubscriptSlice 
     { Subscript -> Maybe ExprSpan
subscript_slice_span1 :: Maybe ExprSpan
     , Subscript -> Maybe ExprSpan
subscript_slice_span2 :: Maybe ExprSpan
     , Subscript -> Maybe (Maybe ExprSpan)
subscript_slice_span3 :: Maybe (Maybe ExprSpan)
     , subscript_span :: SrcSpan
     }
   | SubscriptSliceEllipsis { subscript_span :: SrcSpan }

instance Span Subscript where
   getSpan :: Subscript -> SrcSpan
getSpan = Subscript -> SrcSpan
subscript_span

isProperSlice :: Subscript -> Bool
isProperSlice :: Subscript -> Bool
isProperSlice (SubscriptSlice {}) = Bool
True
isProperSlice (SubscriptSliceEllipsis {}) = Bool
True
isProperSlice Subscript
other = Bool
False

subscriptToSlice :: Subscript -> SliceSpan
subscriptToSlice :: Subscript -> SliceSpan
subscriptToSlice (SubscriptSlice Maybe ExprSpan
lower Maybe ExprSpan
upper Maybe (Maybe ExprSpan)
stride SrcSpan
span)
   = Maybe ExprSpan
-> Maybe ExprSpan -> Maybe (Maybe ExprSpan) -> SrcSpan -> SliceSpan
forall annot.
Maybe (Expr annot)
-> Maybe (Expr annot)
-> Maybe (Maybe (Expr annot))
-> annot
-> Slice annot
SliceProper Maybe ExprSpan
lower Maybe ExprSpan
upper Maybe (Maybe ExprSpan)
stride SrcSpan
span
subscriptToSlice (SubscriptExpr ExprSpan
e SrcSpan
span)
   = ExprSpan -> SrcSpan -> SliceSpan
forall annot. Expr annot -> annot -> Slice annot
SliceExpr ExprSpan
e SrcSpan
span
subscriptToSlice (SubscriptSliceEllipsis SrcSpan
span)
   = SrcSpan -> SliceSpan
forall annot. annot -> Slice annot
SliceEllipsis SrcSpan
span

subscriptToExpr :: Subscript -> ExprSpan
subscriptToExpr :: Subscript -> ExprSpan
subscriptToExpr (SubscriptExpr { subscription :: Subscript -> ExprSpan
subscription = ExprSpan
s }) = ExprSpan
s
subscriptToExpr Subscript
other = [Char] -> ExprSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"subscriptToExpr applied to non subscript"

subscriptsToExpr :: [Subscript] -> ExprSpan
subscriptsToExpr :: [Subscript] -> ExprSpan
subscriptsToExpr [Subscript]
subs
   | [Subscript] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Subscript]
subs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Tuple ((Subscript -> ExprSpan) -> [Subscript] -> [ExprSpan]
forall a b. (a -> b) -> [a] -> [b]
map Subscript -> ExprSpan
subscriptToExpr [Subscript]
subs) ([Subscript] -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan [Subscript]
subs)
   | [Subscript] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Subscript]
subs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Subscript -> ExprSpan
subscriptToExpr (Subscript -> ExprSpan) -> Subscript -> ExprSpan
forall a b. (a -> b) -> a -> b
$ [Subscript] -> Subscript
forall a. HasCallStack => [a] -> a
head [Subscript]
subs
   | Bool
otherwise = [Char] -> ExprSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"subscriptsToExpr: empty subscript list"

addTrailer :: ExprSpan -> [Trailer] -> ExprSpan
addTrailer :: ExprSpan -> [Trailer] -> ExprSpan
addTrailer
   = (ExprSpan -> Trailer -> ExprSpan)
-> ExprSpan -> [Trailer] -> ExprSpan
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ExprSpan -> Trailer -> ExprSpan
trail
   where
   trail :: ExprSpan -> Trailer -> ExprSpan
   -- XXX fix the span
   trail :: ExprSpan -> Trailer -> ExprSpan
trail ExprSpan
e trail :: Trailer
trail@(TrailerCall { trailer_call_args :: Trailer -> [ArgumentSpan]
trailer_call_args = [ArgumentSpan]
args }) = ExprSpan -> [ArgumentSpan] -> SrcSpan -> ExprSpan
forall annot. Expr annot -> [Argument annot] -> annot -> Expr annot
Call ExprSpan
e [ArgumentSpan]
args (ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail)
   trail ExprSpan
e trail :: Trailer
trail@(TrailerSubscript { trailer_subs :: Trailer -> [Subscript]
trailer_subs = [Subscript]
subs })
      | (Subscript -> Bool) -> [Subscript] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Subscript -> Bool
isProperSlice [Subscript]
subs
           = ExprSpan -> [SliceSpan] -> SrcSpan -> ExprSpan
forall annot. Expr annot -> [Slice annot] -> annot -> Expr annot
SlicedExpr ExprSpan
e ((Subscript -> SliceSpan) -> [Subscript] -> [SliceSpan]
forall a b. (a -> b) -> [a] -> [b]
map Subscript -> SliceSpan
subscriptToSlice [Subscript]
subs) (ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail) 
      | Bool
otherwise 
           = ExprSpan -> ExprSpan -> SrcSpan -> ExprSpan
forall annot. Expr annot -> Expr annot -> annot -> Expr annot
Subscript ExprSpan
e ([Subscript] -> ExprSpan
subscriptsToExpr [Subscript]
subs) (ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail) 
   trail ExprSpan
e trail :: Trailer
trail@(TrailerDot { trailer_dot_ident :: Trailer -> IdentSpan
trailer_dot_ident = IdentSpan
ident, dot_span :: Trailer -> SrcSpan
dot_span = SrcSpan
ds })
      = Dot { dot_expr :: ExprSpan
dot_expr = ExprSpan
e, dot_attribute :: IdentSpan
dot_attribute = IdentSpan
ident, expr_annot :: SrcSpan
expr_annot = ExprSpan -> Trailer -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e Trailer
trail }

makeTupleOrExpr :: [ExprSpan] -> Maybe Token -> ExprSpan
makeTupleOrExpr :: [ExprSpan] -> Maybe Token -> ExprSpan
makeTupleOrExpr [ExprSpan
e] Maybe Token
Nothing = ExprSpan
e
makeTupleOrExpr es :: [ExprSpan]
es@(ExprSpan
_:[ExprSpan]
_) (Just Token
t) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Tuple [ExprSpan]
es ([ExprSpan] -> Token -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning [ExprSpan]
es Token
t) 
makeTupleOrExpr es :: [ExprSpan]
es@(ExprSpan
_:[ExprSpan]
_) Maybe Token
Nothing  = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Tuple [ExprSpan]
es ([ExprSpan] -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan [ExprSpan]
es)
makeTupleOrExpr [] Maybe Token
_ = [Char] -> ExprSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"makeTupleOrExpr should never be called with an empty list"

makeAssignmentOrExpr :: ExprSpan -> Either [ExprSpan] (AssignOpSpan, ExprSpan) -> StatementSpan
makeAssignmentOrExpr :: ExprSpan
-> Either [ExprSpan] (AssignOpSpan, ExprSpan) -> StatementSpan
makeAssignmentOrExpr ExprSpan
e (Left [ExprSpan]
es) 
   = ExprSpan -> [ExprSpan] -> StatementSpan
makeNormalAssignment ExprSpan
e [ExprSpan]
es
makeAssignmentOrExpr ExprSpan
e (Right (AssignOpSpan, ExprSpan)
ope2)
   = ExprSpan -> (AssignOpSpan, ExprSpan) -> StatementSpan
makeAugAssignment ExprSpan
e (AssignOpSpan, ExprSpan)
ope2

makeAugAssignment :: ExprSpan -> (AssignOpSpan, ExprSpan) -> StatementSpan
makeAugAssignment :: ExprSpan -> (AssignOpSpan, ExprSpan) -> StatementSpan
makeAugAssignment ExprSpan
e1 (AssignOpSpan
op, ExprSpan
e2)
  = ExprSpan -> AssignOpSpan -> ExprSpan -> SrcSpan -> StatementSpan
forall annot.
Expr annot
-> AssignOp annot -> Expr annot -> annot -> Statement annot
AST.AugmentedAssign ExprSpan
e1 AssignOpSpan
op ExprSpan
e2 (ExprSpan -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e1 ExprSpan
e2)

makeNormalAssignment :: ExprSpan -> [ExprSpan] -> StatementSpan
makeNormalAssignment :: ExprSpan -> [ExprSpan] -> StatementSpan
makeNormalAssignment ExprSpan
e [] = ExprSpan -> SrcSpan -> StatementSpan
forall annot. Expr annot -> annot -> Statement annot
StmtExpr ExprSpan
e (ExprSpan -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan ExprSpan
e)
makeNormalAssignment ExprSpan
e [ExprSpan]
es
  = [ExprSpan] -> ExprSpan -> SrcSpan -> StatementSpan
forall annot.
[Expr annot] -> Expr annot -> annot -> Statement annot
AST.Assign (ExprSpan
e ExprSpan -> [ExprSpan] -> [ExprSpan]
forall a. a -> [a] -> [a]
: [ExprSpan]
front) ([ExprSpan] -> ExprSpan
forall a. HasCallStack => [a] -> a
head [ExprSpan]
back) (ExprSpan -> [ExprSpan] -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e [ExprSpan]
es)
  where
  ([ExprSpan]
front, [ExprSpan]
back) = Int -> [ExprSpan] -> ([ExprSpan], [ExprSpan])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [ExprSpan]
es
  len :: Int
len = [ExprSpan] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExprSpan]
es

makeAnnAssignment :: ExprSpan -> (ExprSpan, Maybe ExprSpan) -> StatementSpan
makeAnnAssignment :: ExprSpan -> (ExprSpan, Maybe ExprSpan) -> StatementSpan
makeAnnAssignment ExprSpan
ato (ExprSpan
annotation, Maybe ExprSpan
ae) = ExprSpan -> ExprSpan -> Maybe ExprSpan -> SrcSpan -> StatementSpan
forall annot.
Expr annot
-> Expr annot -> Maybe (Expr annot) -> annot -> Statement annot
AST.AnnotatedAssign ExprSpan
annotation ExprSpan
ato Maybe ExprSpan
ae (Maybe ExprSpan -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Maybe ExprSpan
ae ExprSpan
ato)

makeTry :: Token -> SuiteSpan -> ([HandlerSpan], [StatementSpan], [StatementSpan]) -> StatementSpan
makeTry :: Token
-> SuiteSpan
-> ([HandlerSpan], SuiteSpan, SuiteSpan)
-> StatementSpan
makeTry Token
t1 SuiteSpan
body ([HandlerSpan]
handlers, SuiteSpan
elses, SuiteSpan
finally)
   = SuiteSpan
-> [HandlerSpan]
-> SuiteSpan
-> SuiteSpan
-> SrcSpan
-> StatementSpan
forall annot.
Suite annot
-> [Handler annot]
-> Suite annot
-> Suite annot
-> annot
-> Statement annot
AST.Try SuiteSpan
body [HandlerSpan]
handlers SuiteSpan
elses SuiteSpan
finally 
     (SrcSpan -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (SrcSpan -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (SrcSpan -> [HandlerSpan] -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (Token -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 SuiteSpan
body) [HandlerSpan]
handlers) SuiteSpan
elses) SuiteSpan
finally)

makeParam :: (IdentSpan, Maybe ExprSpan) -> Maybe ExprSpan -> ParameterSpan
makeParam :: (IdentSpan, Maybe ExprSpan) -> Maybe ExprSpan -> ParameterSpan
makeParam (IdentSpan
name, Maybe ExprSpan
annot) Maybe ExprSpan
defaultVal
   = IdentSpan
-> Maybe ExprSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot
-> Maybe (Expr annot)
-> Maybe (Expr annot)
-> annot
-> Parameter annot
Param IdentSpan
name Maybe ExprSpan
annot Maybe ExprSpan
defaultVal SrcSpan
paramSpan
   where
   paramSpan :: SrcSpan
paramSpan = SrcSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (IdentSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning IdentSpan
name Maybe ExprSpan
annot) Maybe ExprSpan
defaultVal

makeStarParam :: Token -> Maybe (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarParam :: Token -> Maybe (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarParam Token
t1 Maybe (IdentSpan, Maybe ExprSpan)
Nothing = SrcSpan -> ParameterSpan
forall annot. annot -> Parameter annot
EndPositional (Token -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan Token
t1) 
makeStarParam Token
t1 (Just (IdentSpan
name, Maybe ExprSpan
annot))
   = IdentSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot -> Maybe (Expr annot) -> annot -> Parameter annot
VarArgsPos IdentSpan
name Maybe ExprSpan
annot (Token -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 Maybe ExprSpan
annot) 

makeStarStarParam :: Token -> (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarStarParam :: Token -> (IdentSpan, Maybe ExprSpan) -> ParameterSpan
makeStarStarParam Token
t1 (IdentSpan
name, Maybe ExprSpan
annot)
   = IdentSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot -> Maybe (Expr annot) -> annot -> Parameter annot
VarArgsKeyword IdentSpan
name Maybe ExprSpan
annot (SrcSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (Token -> IdentSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 IdentSpan
name) Maybe ExprSpan
annot) 

-- version 2 only 
makeTupleParam :: ParamTupleSpan -> Maybe ExprSpan -> ParameterSpan
-- just a name
makeTupleParam :: ParamTupleSpan -> Maybe ExprSpan -> ParameterSpan
makeTupleParam p :: ParamTupleSpan
p@(ParamTupleName {}) Maybe ExprSpan
optDefault = 
   IdentSpan
-> Maybe ExprSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
Ident annot
-> Maybe (Expr annot)
-> Maybe (Expr annot)
-> annot
-> Parameter annot
Param (ParamTupleSpan -> IdentSpan
forall annot. ParamTuple annot -> Ident annot
param_tuple_name ParamTupleSpan
p) Maybe ExprSpan
forall a. Maybe a
Nothing Maybe ExprSpan
optDefault (ParamTupleSpan -> Maybe ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ParamTupleSpan
p Maybe ExprSpan
optDefault)
-- a parenthesised tuple. NOTE: we do not distinguish between (foo) and (foo,)
makeTupleParam p :: ParamTupleSpan
p@(ParamTuple { param_tuple_annot :: forall annot. ParamTuple annot -> annot
param_tuple_annot = SrcSpan
span }) Maybe ExprSpan
optDefault =
   ParamTupleSpan -> Maybe ExprSpan -> SrcSpan -> ParameterSpan
forall annot.
ParamTuple annot -> Maybe (Expr annot) -> annot -> Parameter annot
UnPackTuple ParamTupleSpan
p Maybe ExprSpan
optDefault SrcSpan
span 

makeComprehension :: ExprSpan -> CompForSpan -> ComprehensionSpan
makeComprehension :: ExprSpan -> CompForSpan -> ComprehensionSpan
makeComprehension ExprSpan
e CompForSpan
for = ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (ExprSpan -> ComprehensionExpr SrcSpan
forall annot. Expr annot -> ComprehensionExpr annot
ComprehensionExpr ExprSpan
e) CompForSpan
for (ExprSpan -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e CompForSpan
for)

makeListForm :: SrcSpan -> Either ExprSpan ComprehensionSpan -> ExprSpan
makeListForm :: SrcSpan -> Either ExprSpan ComprehensionSpan -> ExprSpan
makeListForm SrcSpan
span (Left tuple :: ExprSpan
tuple@(Tuple {})) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
List (ExprSpan -> [ExprSpan]
forall annot. Expr annot -> [Expr annot]
tuple_exprs ExprSpan
tuple) SrcSpan
span
makeListForm SrcSpan
span (Left ExprSpan
other) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
List [ExprSpan
other] SrcSpan
span 
makeListForm SrcSpan
span (Right ComprehensionSpan
comprehension) = ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
ListComp ComprehensionSpan
comprehension SrcSpan
span

makeSet :: ExprSpan -> Either CompForSpan [ExprSpan] -> SrcSpan -> ExprSpan
makeSet :: ExprSpan -> Either CompForSpan [ExprSpan] -> SrcSpan -> ExprSpan
makeSet ExprSpan
e (Left CompForSpan
compFor) = ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
SetComp (ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (ExprSpan -> ComprehensionExpr SrcSpan
forall annot. Expr annot -> ComprehensionExpr annot
ComprehensionExpr ExprSpan
e) CompForSpan
compFor (ExprSpan -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
e CompForSpan
compFor))
makeSet ExprSpan
e (Right [ExprSpan]
es) = [ExprSpan] -> SrcSpan -> ExprSpan
forall annot. [Expr annot] -> annot -> Expr annot
Set (ExprSpan
eExprSpan -> [ExprSpan] -> [ExprSpan]
forall a. a -> [a] -> [a]
:[ExprSpan]
es)

-- The Either (ExprSpan, ExprSpan) ExprSpan refers to a (key, value) pair or a dictionary unpacking expression.
makeDictionary :: Either (ExprSpan, ExprSpan) ExprSpan -> Either CompForSpan [Either (ExprSpan, ExprSpan) ExprSpan] -> SrcSpan -> ExprSpan
makeDictionary :: Either (ExprSpan, ExprSpan) ExprSpan
-> Either CompForSpan [Either (ExprSpan, ExprSpan) ExprSpan]
-> SrcSpan
-> ExprSpan
makeDictionary (Left mapping :: (ExprSpan, ExprSpan)
mapping@(ExprSpan
key, ExprSpan
val)) (Left CompForSpan
compFor) =
   ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
DictComp (ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (DictKeyDatumList SrcSpan -> ComprehensionExpr SrcSpan
forall annot. DictKeyDatumList annot -> ComprehensionExpr annot
ComprehensionDict (ExprSpan -> ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> Expr annot -> DictKeyDatumList annot
DictMappingPair ExprSpan
key ExprSpan
val)) CompForSpan
compFor ((ExprSpan, ExprSpan) -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning (ExprSpan, ExprSpan)
mapping CompForSpan
compFor))
-- This is allowed by the grammar, but will produce a runtime syntax error:
-- dict unpacking cannot be used in dict comprehension
makeDictionary (Right ExprSpan
unpacking) (Left CompForSpan
compFor) =
   ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
DictComp (ComprehensionExpr SrcSpan
-> CompForSpan -> SrcSpan -> ComprehensionSpan
forall annot.
ComprehensionExpr annot
-> CompFor annot -> annot -> Comprehension annot
Comprehension (DictKeyDatumList SrcSpan -> ComprehensionExpr SrcSpan
forall annot. DictKeyDatumList annot -> ComprehensionExpr annot
ComprehensionDict (ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> DictKeyDatumList annot
DictUnpacking ExprSpan
unpacking)) CompForSpan
compFor (ExprSpan -> CompForSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning ExprSpan
unpacking CompForSpan
compFor))
makeDictionary Either (ExprSpan, ExprSpan) ExprSpan
item (Right [Either (ExprSpan, ExprSpan) ExprSpan]
es) = [DictKeyDatumList SrcSpan] -> SrcSpan -> ExprSpan
forall annot. [DictKeyDatumList annot] -> annot -> Expr annot
Dictionary ([DictKeyDatumList SrcSpan] -> SrcSpan -> ExprSpan)
-> [DictKeyDatumList SrcSpan] -> SrcSpan -> ExprSpan
forall a b. (a -> b) -> a -> b
$ Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan
toKeyDatumList (Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan)
-> [Either (ExprSpan, ExprSpan) ExprSpan]
-> [DictKeyDatumList SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either (ExprSpan, ExprSpan) ExprSpan
item Either (ExprSpan, ExprSpan) ExprSpan
-> [Either (ExprSpan, ExprSpan) ExprSpan]
-> [Either (ExprSpan, ExprSpan) ExprSpan]
forall a. a -> [a] -> [a]
: [Either (ExprSpan, ExprSpan) ExprSpan]
es


toKeyDatumList :: Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan
toKeyDatumList :: Either (ExprSpan, ExprSpan) ExprSpan -> DictKeyDatumList SrcSpan
toKeyDatumList (Left (ExprSpan
key, ExprSpan
value)) = ExprSpan -> ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> Expr annot -> DictKeyDatumList annot
DictMappingPair ExprSpan
key ExprSpan
value
toKeyDatumList (Right ExprSpan
unpacking) = ExprSpan -> DictKeyDatumList SrcSpan
forall annot. Expr annot -> DictKeyDatumList annot
DictUnpacking ExprSpan
unpacking


fromEither :: Either a a -> a
fromEither :: forall a. Either a a -> a
fromEither (Left a
x) = a
x
fromEither (Right a
x) = a
x

makeDecorator :: Token -> DottedNameSpan -> [ArgumentSpan] -> DecoratorSpan
makeDecorator :: Token -> DottedNameSpan -> [ArgumentSpan] -> DecoratorSpan
makeDecorator Token
t1 DottedNameSpan
name [] = DottedNameSpan -> [ArgumentSpan] -> SrcSpan -> DecoratorSpan
forall annot.
DottedName annot -> [Argument annot] -> annot -> Decorator annot
Decorator DottedNameSpan
name [] (Token -> DottedNameSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 DottedNameSpan
name)
makeDecorator Token
t1 DottedNameSpan
name [ArgumentSpan]
args = DottedNameSpan -> [ArgumentSpan] -> SrcSpan -> DecoratorSpan
forall annot.
DottedName annot -> [Argument annot] -> annot -> Decorator annot
Decorator DottedNameSpan
name [ArgumentSpan]
args (Token -> [ArgumentSpan] -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 [ArgumentSpan]
args)

-- parser guarantees that the first list is non-empty
makeDecorated :: [DecoratorSpan] -> StatementSpan -> StatementSpan
makeDecorated :: [DecoratorSpan] -> StatementSpan -> StatementSpan
makeDecorated ds :: [DecoratorSpan]
ds@(DecoratorSpan
d:[DecoratorSpan]
_) StatementSpan
def = [DecoratorSpan] -> StatementSpan -> SrcSpan -> StatementSpan
forall annot.
[Decorator annot] -> Statement annot -> annot -> Statement annot
Decorated [DecoratorSpan]
ds StatementSpan
def (DecoratorSpan -> StatementSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning DecoratorSpan
d StatementSpan
def)
makeDecorated [] StatementSpan
_ = [Char] -> StatementSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"parser guarantees that makeDecorated's first argument is non-empty"

-- suite can't be empty so it is safe to take span over it
makeFun :: Token -> IdentSpan -> [ParameterSpan] -> Maybe ExprSpan -> SuiteSpan -> StatementSpan
makeFun :: Token
-> IdentSpan
-> [ParameterSpan]
-> Maybe ExprSpan
-> SuiteSpan
-> StatementSpan
makeFun Token
t1 IdentSpan
name [ParameterSpan]
params Maybe ExprSpan
annot SuiteSpan
body = 
   IdentSpan
-> [ParameterSpan]
-> Maybe ExprSpan
-> SuiteSpan
-> SrcSpan
-> StatementSpan
forall annot.
Ident annot
-> [Parameter annot]
-> Maybe (Expr annot)
-> Suite annot
-> annot
-> Statement annot
Fun IdentSpan
name [ParameterSpan]
params Maybe ExprSpan
annot SuiteSpan
body (SrcSpan -> StatementSpan) -> SrcSpan -> StatementSpan
forall a b. (a -> b) -> a -> b
$ Token -> SuiteSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 SuiteSpan
body 

makeReturn :: Token -> Maybe ExprSpan -> StatementSpan
makeReturn :: Token -> Maybe ExprSpan -> StatementSpan
makeReturn Token
t1 Maybe ExprSpan
Nothing = Maybe ExprSpan -> SrcSpan -> StatementSpan
forall annot. Maybe (Expr annot) -> annot -> Statement annot
AST.Return Maybe ExprSpan
forall a. Maybe a
Nothing (Token -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan Token
t1)
makeReturn Token
t1 expr :: Maybe ExprSpan
expr@(Just ExprSpan
e) = Maybe ExprSpan -> SrcSpan -> StatementSpan
forall annot. Maybe (Expr annot) -> annot -> Statement annot
AST.Return Maybe ExprSpan
expr (Token -> ExprSpan -> SrcSpan
forall a b. (Span a, Span b) => a -> b -> SrcSpan
spanning Token
t1 ExprSpan
e)

makeParenOrGenerator :: Either ExprSpan ComprehensionSpan -> SrcSpan -> ExprSpan
makeParenOrGenerator :: Either ExprSpan ComprehensionSpan -> SrcSpan -> ExprSpan
makeParenOrGenerator (Left ExprSpan
e) SrcSpan
span = ExprSpan -> SrcSpan -> ExprSpan
forall annot. Expr annot -> annot -> Expr annot
Paren ExprSpan
e SrcSpan
span
makeParenOrGenerator (Right ComprehensionSpan
comp) SrcSpan
span = ComprehensionSpan -> SrcSpan -> ExprSpan
forall annot. Comprehension annot -> annot -> Expr annot
Generator ComprehensionSpan
comp SrcSpan
span

makePrint :: Bool -> Maybe ([ExprSpan], Maybe Token) -> SrcSpan -> StatementSpan
makePrint :: Bool -> Maybe ([ExprSpan], Maybe Token) -> SrcSpan -> StatementSpan
makePrint Bool
chevron Maybe ([ExprSpan], Maybe Token)
Nothing SrcSpan
span = Bool -> [ExprSpan] -> Bool -> SrcSpan -> StatementSpan
forall annot.
Bool -> [Expr annot] -> Bool -> annot -> Statement annot
AST.Print Bool
chevron [] Bool
False SrcSpan
span
makePrint Bool
chevron (Just ([ExprSpan]
args, Maybe Token
last_comma)) SrcSpan
span =
   Bool -> [ExprSpan] -> Bool -> SrcSpan -> StatementSpan
forall annot.
Bool -> [Expr annot] -> Bool -> annot -> Statement annot
AST.Print Bool
chevron [ExprSpan]
args (Maybe Token -> Bool
forall a. Maybe a -> Bool
isJust Maybe Token
last_comma) SrcSpan
span
   
makeRelative :: [Either Token DottedNameSpan] -> ImportRelativeSpan
makeRelative :: [Either Token DottedNameSpan] -> ImportRelativeSpan
makeRelative [Either Token DottedNameSpan]
items =
   Int -> Maybe DottedNameSpan -> SrcSpan -> ImportRelativeSpan
forall annot.
Int -> Maybe (DottedName annot) -> annot -> ImportRelative annot
ImportRelative Int
ndots Maybe DottedNameSpan
maybeName ([Either Token DottedNameSpan] -> SrcSpan
forall a. Span a => a -> SrcSpan
getSpan [Either Token DottedNameSpan]
items) 
   where
   (Int
ndots, Maybe DottedNameSpan
maybeName) = Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
countDots Int
0 [Either Token DottedNameSpan]
items
   -- parser ensures that the dotted name will be at the end 
   -- of the list if it is there at all
   countDots :: Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
   countDots :: Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
countDots Int
count [] = (Int
count, Maybe DottedNameSpan
forall a. Maybe a
Nothing)
   countDots Int
count (Right DottedNameSpan
name:[Either Token DottedNameSpan]
_) = (Int
count, DottedNameSpan -> Maybe DottedNameSpan
forall a. a -> Maybe a
Just DottedNameSpan
name)
   countDots Int
count (Left Token
token:[Either Token DottedNameSpan]
rest) = Int -> [Either Token DottedNameSpan] -> (Int, Maybe DottedNameSpan)
countDots (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Token -> Int
forall {a}. Num a => Token -> a
dots Token
token) [Either Token DottedNameSpan]
rest 
   dots :: Token -> a
dots (DotToken {}) = a
1
   dots (EllipsisToken {}) = a
3
   dots Token
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Parser ensures dots is only called on DotToken or EllipsisToken."

{-
   See: http://docs.python.org/3.0/reference/expressions.html#calls

   arglist: (argument ',')* (argument [',']
                         |'*' test (',' argument)* [',' '**' test]
                         |'**' test)

   (state 1) Positional arguments come first.
   (state 2) Then keyword arguments.
   (state 3) Then the single star form.
   (state 4) Then more keyword arguments (but no positional arguments).
   (state 5) Then the double star form.

XXX fixme: we need to include SrcLocations for the errors.
-}

checkArguments :: [ArgumentSpan] -> P [ArgumentSpan]
checkArguments :: [ArgumentSpan] -> P [ArgumentSpan]
checkArguments [ArgumentSpan]
args = do
   Int -> [ArgumentSpan] -> P ()
check Int
1 [ArgumentSpan]
args
   [ArgumentSpan] -> P [ArgumentSpan]
forall a. a -> StateT ParseState (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ArgumentSpan]
args
   where
   check :: Int -> [ArgumentSpan] -> P ()
   check :: Int -> [ArgumentSpan] -> P ()
check Int
state [] = () -> P ()
forall a. a -> StateT ParseState (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   check Int
5 (ArgumentSpan
arg:[ArgumentSpan]
_) = ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg [Char]
"an **argument must not be followed by any other arguments"
   check Int
state (ArgumentSpan
arg:[ArgumentSpan]
rest) = do
      case ArgumentSpan
arg of
         ArgExpr {}
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Int -> [ArgumentSpan] -> P ()
check Int
state [ArgumentSpan]
rest
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg [Char]
"a positional argument must not follow a keyword argument"
            | Bool
otherwise -> ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg [Char]
"a positional argument must not follow a *argument"
         ArgKeyword {}
            | Int
state Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
2] -> Int -> [ArgumentSpan] -> P ()
check Int
2 [ArgumentSpan]
rest
            | Int
state Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
3,Int
4] -> Int -> [ArgumentSpan] -> P ()
check Int
4 [ArgumentSpan]
rest
            | Bool
otherwise -> [Char] -> P ()
forall a. HasCallStack => [Char] -> a
error [Char]
"state should always be in range 1..4 here"
         ArgVarArgsPos {}
            | Int
state Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
2] -> Int -> [ArgumentSpan] -> P ()
check Int
3 [ArgumentSpan]
rest
            | Int
state Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
3,Int
4] -> ArgumentSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ArgumentSpan
arg [Char]
"there must not be two *arguments in an argument list"
            | Bool
otherwise -> [Char] -> P ()
forall a. HasCallStack => [Char] -> a
error [Char]
"state should always be in range 1..4 here"
         ArgVarArgsKeyword {} -> Int -> [ArgumentSpan] -> P ()
check Int
5 [ArgumentSpan]
rest

{-
   See: http://docs.python.org/3.1/reference/compound_stmts.html#grammar-token-parameter_list

   parameter_list ::=  (defparameter ",")*
                    (  "*" [parameter] ("," defparameter)*
                    [, "**" parameter]
                    | "**" parameter
                    | defparameter [","] )

   (state 1) Parameters/unpack tuples first.
   (state 2) Then the single star (on its own or with parameter)
   (state 3) Then more parameters. 
   (state 4) Then the double star form.

   XXX fixme, add support for version 2 unpack tuple.
-}

checkParameters :: [ParameterSpan] -> P [ParameterSpan]
checkParameters :: [ParameterSpan] -> P [ParameterSpan]
checkParameters [ParameterSpan]
params = do
   Int -> [ParameterSpan] -> P ()
check Int
1 [ParameterSpan]
params 
   [ParameterSpan] -> P [ParameterSpan]
forall a. a -> StateT ParseState (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParameterSpan]
params
   where
   check :: Int -> [ParameterSpan] -> P ()
   check :: Int -> [ParameterSpan] -> P ()
check Int
state [] = () -> P ()
forall a. a -> StateT ParseState (Either ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
   check Int
4 (ParameterSpan
param:[ParameterSpan]
_) = ParameterSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ParameterSpan
param [Char]
"a **parameter must not be followed by any other parameters"
   check Int
state (ParameterSpan
param:[ParameterSpan]
rest) = do
      case ParameterSpan
param of
         -- Param and UnPackTuple are treated the same.
         UnPackTuple {}
            | Int
state Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
3] -> Int -> [ParameterSpan] -> P ()
check Int
state [ParameterSpan]
rest
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> Int -> [ParameterSpan] -> P ()
check Int
3 [ParameterSpan]
rest 
            | Bool
otherwise -> [Char] -> P ()
forall a. HasCallStack => [Char] -> a
error [Char]
"state should always be in range 1..3 here"
         Param {}
            | Int
state Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
1,Int
3] -> Int -> [ParameterSpan] -> P ()
check Int
state [ParameterSpan]
rest
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 -> Int -> [ParameterSpan] -> P ()
check Int
3 [ParameterSpan]
rest 
            | Bool
otherwise -> [Char] -> P ()
forall a. HasCallStack => [Char] -> a
error [Char]
"state should always be in range 1..3 here"
         EndPositional {}
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Int -> [ParameterSpan] -> P ()
check Int
2 [ParameterSpan]
rest
            | Bool
otherwise -> ParameterSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ParameterSpan
param [Char]
"there must not be two *parameters in a parameter list"
         VarArgsPos {}
            | Int
state Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Int -> [ParameterSpan] -> P ()
check Int
2 [ParameterSpan]
rest
            | Bool
otherwise -> ParameterSpan -> [Char] -> P ()
forall a b. Span a => a -> [Char] -> P b
spanError ParameterSpan
param [Char]
"there must not be two *parameters in a parameter list"
         VarArgsKeyword {} -> Int -> [ParameterSpan] -> P ()
check Int
4 [ParameterSpan]
rest

{-
spanError :: Span a => a -> String -> P ()
spanError x str = throwError $ StrError $ unwords [prettyText $ getSpan x, str]
-}