Reopen classes

src/Control/Abstract/Heap.hs

@@ -10,6 +10,7 @@ module Control.Abstract.Heap
 , putSlotDeclarationScope
 , alloc
 , dealloc
+, maybeLookupDeclaration
 , lookupDeclaration
 , lookupDeclarationFrame
 , deref
@@ -245,6 +246,26 @@ putSlotDeclarationScope Slot{..} assocScope = do
   modify @(ScopeGraph address) (putDeclarationScopeAtPosition scopeAddress position assocScope)
 
 
+maybeLookupDeclaration :: forall value address term sig m. ( Member (State (Heap address address value)) sig
+                     , Member (State (ScopeGraph address)) sig
+                     , Member (Reader (address, address)) sig
+                     , Member (Resumable (BaseError (ScopeError address))) sig
+                     , Member (Resumable (BaseError (HeapError address))) sig
+                     , Member (Reader ModuleInfo) sig
+                     , Member (Reader Span) sig
+                     , Ord address
+                     , Carrier sig m
+                     )
+                  => Declaration
+                  -> Evaluator term address value m (Maybe (Slot address))
+maybeLookupDeclaration decl = do
+  path <- maybeLookupScopePath decl
+  case path of
+    Just path -> do
+      frameAddress <- lookupFrameAddress path
+      pure (Just $ Slot frameAddress (Heap.pathPosition path))
+    Nothing -> pure Nothing
+
 lookupDeclaration :: forall value address term sig m. ( Member (State (Heap address address value)) sig
                      , Member (State (ScopeGraph address)) sig
                      , Member (Reader (address, address)) sig

src/Control/Abstract/ScopeGraph.hs

@@ -19,6 +19,7 @@ module Control.Abstract.ScopeGraph
   , putDeclarationSpan
   , insertImportReference
   , lookupScopePath
+  , maybeLookupScopePath
   , lookupDeclarationScope
   , lookupScope
   , Allocator(..)
@@ -170,6 +171,21 @@ insertScope :: ( Member (State (ScopeGraph address)) sig
             -> Evaluator term address value m ()
 insertScope scopeAddress scope = modify (ScopeGraph.insertScope scopeAddress scope)
 
+maybeLookupScopePath :: ( Member (Resumable (BaseError (ScopeError address))) sig
+                , Member (Reader ModuleInfo) sig
+                , Member (Reader Span) sig
+                , Member (State (ScopeGraph address)) sig
+                , Member (Reader (address, address)) sig
+                , Carrier sig m
+                , Ord address
+                )
+             => Declaration
+             -> Evaluator term address value m (Maybe (ScopeGraph.Path address))
+maybeLookupScopePath decl@Declaration{..} = do
+  currentAddress <- currentScope
+  scopeGraph <- get
+  pure (ScopeGraph.lookupScopePath unDeclaration currentAddress scopeGraph)
+
 lookupScopePath :: ( Member (Resumable (BaseError (ScopeError address))) sig
                 , Member (Reader ModuleInfo) sig
                 , Member (Reader Span) sig

src/Language/Ruby/Syntax.hs

@@ -183,32 +183,43 @@ instance Evaluatable Class where
     span <- ask @Span
     currentScope' <- currentScope
 
-    let classSuperclasses = maybeToList classSuperClass
-    superScopes <- for classSuperclasses $ \superclass -> do
-      name <- maybeM (throwEvalError NoNameError) (declaredName superclass)
-      scope <- associatedScope (Declaration name)
-      slot <- lookupDeclaration (Declaration name)
-      superclassFrame <- scopedEnvironment =<< deref slot
-      pure $ case (scope, superclassFrame) of
-        (Just scope, Just frame) -> Just (scope, frame)
-        _ -> Nothing
+    let declaration = (Declaration name)
+    maybeSlot <- maybeLookupDeclaration declaration
 
-    let superclassEdges = fmap (Superclass, ) . fmap (pure . fst) . catMaybes $ superScopes
-        current = fmap (Lexical, ) . pure . pure $ currentScope'
-        edges = Map.fromList (superclassEdges <> current)
-    childScope <- newScope edges
-    declare (Declaration name) span (Just childScope)
+    case maybeSlot of
+      Just slot -> do
+        classVal <- deref slot
+        maybeFrame <- scopedEnvironment classVal
+        case maybeFrame of
+          Just classFrame -> withScopeAndFrame classFrame (eval classBody)
+          Nothing -> throwEvalError (DerefError classVal)
+      Nothing -> do
+        let classSuperclasses = maybeToList classSuperClass
+        superScopes <- for classSuperclasses $ \superclass -> do
+          name <- maybeM (throwEvalError NoNameError) (declaredName superclass)
+          scope <- associatedScope (Declaration name)
+          slot <- lookupDeclaration (Declaration name)
+          superclassFrame <- scopedEnvironment =<< deref slot
+          pure $ case (scope, superclassFrame) of
+            (Just scope, Just frame) -> Just (scope, frame)
+            _ -> Nothing
 
-    let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes))
-    childFrame <- newFrame childScope frameEdges
+        let superclassEdges = fmap (Superclass, ) . fmap (pure . fst) . catMaybes $ superScopes
+            current = fmap (Lexical, ) . pure . pure $ currentScope'
+            edges = Map.fromList (superclassEdges <> current)
+        childScope <- newScope edges
+        declare (Declaration name) span (Just childScope)
 
-    withScopeAndFrame childFrame $ do
-      void $ eval classBody
+        let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes))
+        childFrame <- newFrame childScope frameEdges
 
-    classSlot <- lookupDeclaration (Declaration name)
-    assign classSlot =<< klass (Declaration name) childFrame
+        withScopeAndFrame childFrame $ do
+          void $ eval classBody
 
-    rvalBox unit
+        classSlot <- lookupDeclaration (Declaration name)
+        assign classSlot =<< klass (Declaration name) childFrame
+
+        rvalBox unit
 
 instance Declarations1 Class where
   liftDeclaredName declaredName = declaredName . classIdentifier