@@ -35,6 +35,7 @@ import Data.List.NonEmpty (NonEmpty (..))
35
35
import qualified Data.List.NonEmpty as NonEmpty
36
36
import qualified Data.ScopeGraph as ScopeGraph
37
37
import qualified Data.Text as Text
38
+ import Data.Traversable
38
39
import Debug.Trace
39
40
import GHC.Records
40
41
import GHC.TypeLits
@@ -81,13 +82,13 @@ onField =
81
82
. getField @ field
82
83
83
84
-- ([(node_for_the_name, ast_for_the_decl)], ...)
84
- type ClassBodyBinders = Py. Assignment
85
+ type ClassBodyBinder = Py. Assignment
85
86
:+: Py. AugmentedAss
10000
ignment
86
87
:+: Py. FunctionDefinition
87
88
:+: Py. ClassDefinition
88
89
:+: Py. DecoratedDefinition
89
90
90
- type BodyStruct a b = ([(Stack. Node , [ ClassBodyBinders a ] )], b )
91
+ type BodyStruct a b = ([(Stack. Node , ClassBodyBinder a )], b )
91
92
92
93
noBindings :: b -> BodyStruct a b
93
94
noBindings x = ([] ,x)
@@ -108,8 +109,14 @@ instance ToScopeGraph Py.Assignment where
108
109
scopeGraph asgn@ (Py. Assignment ann (SingleIdentifier identifier) (Just val) _typ) = do
109
110
-- TODO: What should we do with the type of an assignment?
110
111
-- TODO: What should we do with the right hand side of an assignment?
111
- _ <- scopeGraph val
112
- pure (Complete ([_], Stack. Declaration identifier Scope. Identifier ann))
112
+ res <- scopeGraph val
113
+ let propagateThese = case res of
114
+ Complete (Left (Left (bindings, _))) -> bindings
115
+ Complete (Left (Right (bindings, _))) -> bindings
116
+ Complete (Right (Left (bindings, _))) -> bindings
117
+ Complete (Right (Right (bindings, _))) -> bindings
118
+ decl = Stack. Declaration identifier Scope. Identifier ann
119
+ pure (Complete ((decl,L1 asgn) : propagateThese, decl))
113
120
scopeGraph x = todo x
114
121
115
122
instance ToScopeGraph Py. Await where
@@ -205,49 +212,31 @@ instance ToScopeGraph Py.ClassDefinition where
205
212
res <- scopeGraph body
206
213
case res of
207
214
Complete (bindings, _) -> do
208
- for_ bindings $ \ (node, statements) ->
209
- _
210
- {-
211
- do
215
+ for_ bindings $ \ (node, statement) ->
212
216
if isInstanceMember statement then
213
217
modify (Stack. addEdge (Stack. InstanceMembers " IM" ) node)
214
218
else if isClassMember statement then
215
219
modify (Stack. addEdge (Stack. ClassMembers " CM" ) node)
216
220
else pure ()
217
- -}
218
221
pure ()
219
222
res -> pure ()
220
223
221
224
-- TODO: replace R1L1 with injection
222
- pure (Complete ([(declaration,[ R1 (R1 (R1 (L1 def)))] )], [] ))
225
+ pure (Complete ([(declaration,R1 (R1 (R1 (L1 def))))], [] ))
223
226
224
227
-- for_ bindings $ \(node, statement) -> do
225
228
-- -- let callNode = Stack.PopSymbol "()"
226
229
-- undefined
227
230
228
- isInstanceMember :: ClassBodyBinders a -> Bool
229
- isInstanceMember statement = case statement of
230
- L1 (Py. SimpleStatement _) -> False
231
- R1 (Py. CompoundStatement compoundStatement) -> case compoundStatement of
232
- Prj (Py. FunctionDefinition {}) -> True
233
- _ -> False
234
-
235
- isClassMember :: ClassBodyBinders a -> Bool
236
- isClassMember statement = case statement of
237
- L1 (Py. SimpleStatement simpleStatement) -> case simpleStatement of
238
- Prj (Py. ExpressionStatement _ expressions) -> all isAssignment expressions
239
- _ -> False
240
- R1 (Py. CompoundStatement compoundStatement) -> case compoundStatement of
241
- _ -> False
242
-
243
- isAssignment :: (:+: )
244
- (Py. Expression :+: Py. Assignment )
245
- (Py. AugmentedAssignment :+: Py. Yield )
246
- a -> Bool
247
- isAssignment expressionStatement = case expressionStatement of
248
- Prj (Py. Assignment {}) -> True
249
- Prj (Py. AugmentedAssignment {}) -> True
250
- _ -> False
231
+ isInstanceMember :: ClassBodyBinder a -> Bool
232
+ isInstanceMember (Prj (Py. FunctionDefinition {})) = True
233
+ isInstanceMember _ = False
234
+
235
+ isClassMember :: ClassBodyBinder a -> Bool
236
+ isClassMember (Prj (Py. Assignment {})) = True
237
+ isClassMember (Prj (Py. ClassDefinition {})) = True
238
+ isClassMember (Prj (Py. DecoratedDefinition {})) = True
239
+ isClassMember _ = False
251
240
252
241
instance ToScopeGraph Py. ConcatenatedString where
253
242
type FocalPoint Py. ConcatenatedString a = BodyStruct a Stack. Node
@@ -318,8 +307,14 @@ instance ToScopeGraph Py.ExecStatement where
318
307
319
308
instance ToScopeGraph Py. ExpressionStatement where
320
309
type FocalPoint Py. ExpressionStatement a = BodyStruct a [Stack. Node ]
321
- scopeGraph x = do
322
- todo x
310
+ scopeGraph (Py. ExpressionStatement _ statements) = do
311
+ bindings <- for statements $ \ stmt -> do
312
+ res <- scopeGraph stmt
313
+ let flattenEithers = fst . fromEither . bimap fromEither fromEither
314
+ case res of
315
+ Complete r -> pure (flattenEithers r)
316
+ _ -> pure []
317
+ pure (Complete (concat (toList bindings), [] ))
323
318
324
319
instance ToScopeGraph Py. ExpressionList where
325
320
type FocalPoint Py. ExpressionList a = BodyStruct a [Stack. Node ]
@@ -593,7 +588,12 @@ instance ToScopeGraph Py.PrimaryExpression where
593
588
594
589
instance ToScopeGraph Py. SimpleStatement where
595
590
type FocalPoint Py. SimpleStatement a = BodyStruct a [Stack. Node ]
596
- scopeGraph = todo
591
+ scopeGraph (Py. SimpleStatement stmt) =
592
+ fmap (either (either (either id fromEither)
593
+ (either fromEither fromEither))
594
+ (either (either fromEither fromEither)
595
+ (either fromEither fromEither)))
596
+ <$> (scopeGraph stmt)
597
597
598
598
instance ToScopeGraph Py. RaiseStatement where
599
599
type FocalPoint Py. RaiseStatement a = BodyStruct a [Stack. Node ]
0 commit comments