Introduce QualifiedIdentifer syntax

src/Data/Syntax.hs

@@ -126,6 +126,25 @@ instance ( Addressable (LocationFor v) es
 instance FreeVariables1 Identifier where
   liftFreeVariables _ (Identifier x) = point x
 
+newtype QualifiedIdentifier a = QualifiedIdentifier a
+  deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
+
+instance Eq1 QualifiedIdentifier where liftEq = genericLiftEq
+instance Ord1 QualifiedIdentifier where liftCompare = genericLiftCompare
+instance Show1 QualifiedIdentifier where liftShowsPrec = genericLiftShowsPrec
+
+instance ( Addressable (LocationFor v) es
+         , Member Fail es
+         , Member (Reader (EnvironmentFor v)) es
+         , Member (State (StoreFor v)) es
+         , FreeVariables t
+         ) => Evaluatable es t v QualifiedIdentifier where
+  eval (QualifiedIdentifier xs) = do
+    env <- ask
+    let name = qualifiedName (subterm xs)
+    maybe (fail ("free variable: " <> unpack name)) deref (envLookup name env)
+
+
 newtype Program a = Program [a]
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
 

src/Data/Syntax/Expression.hs

@@ -195,35 +195,7 @@ instance Ord1 MemberAccess where liftCompare = genericLiftCompare
 instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
 
 -- TODO: Implement Eval instance for MemberAccess
-instance ( FreeVariables t
+instance Member Fail es => Evaluatable es t v MemberAccess
-         , Ord l
-         , Show l
-         , Show t
-         , Show (Cell l (Value l t))
-         , CellValue l (Value l t)
-         , Member Fail es
-         , Member (State (EnvironmentFor (Value l t))) es
-         , Member (Reader (EnvironmentFor (Value l t))) es
-         , Member (State (StoreFor (Value l t))) es
-         ) => Evaluatable es t (Value l t) MemberAccess where
-  eval (MemberAccess a b) = do
-    let scope = qualifiedName (subterm a)
-    env <- get @(EnvironmentFor (Value l t))
-    case envLookup scope env of
-      Nothing -> fail ("qualified name not found: " <> show scope)
-      Just addr -> do
-        store <- get @(StoreFor (Value l t))
-        case storeLookup addr store of
-          Nothing -> fail "address not found"
-          Just c -> do
-            let interface = val c
-            Interface _ env <- maybe
-                                 (fail ("expected an interface, but got: " <> show interface))
-                                 pure
-                                 (prj interface :: Maybe (Interface l t))
-            local (const env) (subtermValue b)
-
-instance Member Fail es => Evaluatable es t Type.Type MemberAccess where
 
 -- | Subscript (e.g a[1])
 data Subscript a

src/Language/Python/Assignment.hs

@@ -79,6 +79,7 @@ type Syntax =
    , Syntax.Empty
    , Syntax.Error
    , Syntax.Identifier
+   , Syntax.QualifiedIdentifier
    , Syntax.Program
    , Type.Annotation
    , []
@@ -451,8 +452,14 @@ slice = makeTerm <$> symbol Slice <*> children
                           <*> (term expression <|> emptyTerm))
 
 call :: Assignment
-call = makeTerm <$> symbol Call <*> children (Expression.Call <$> pure [] <*> term expression <*> (symbol ArgumentList *> children (manyTerm expression)
+call = makeTerm <$> symbol Call <*> children (Expression.Call <$> pure [] <*> term qualifiedIdentifier <*> (symbol ArgumentList *> children (manyTerm expression) <|> someTerm comprehension) <*> emptyTerm)
-                                                                                <|> someTerm comprehension) <*> emptyTerm)
+  where
+    qualifiedIdentifier =  makeQualifiedIdentifier <$> symbol Attribute <*> children (some identifier)
+                       <|> plainIdentifier
+    plainIdentifier = makeTerm <$> location <*> (Syntax.QualifiedIdentifier <$> identifier)
+    makeQualifiedIdentifier loc [x] = makeTerm loc (Syntax.QualifiedIdentifier x)
+    makeQualifiedIdentifier loc xs = makeTerm loc (Syntax.QualifiedIdentifier (makeTerm' loc (inj xs)))
+
 
 boolean :: Assignment
 boolean =  makeTerm <$> token Grammar.True <*> pure Literal.true