mirror of
https://github.com/github/semantic.git
synced 2025-01-03 13:02:37 +03:00
First, sort of working eval of path, term pairs
This commit is contained in:
parent
6d1dc86761
commit
90fcf481ae
@ -19,13 +19,15 @@ import Data.Function (fix)
|
||||
import Data.Functor.Foldable (Base, Recursive(..), ListF(..))
|
||||
import Data.Semigroup
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
-- | The effects necessary for concrete interpretation.
|
||||
type Evaluating v
|
||||
= '[ Fail -- For 'MonadFail'.
|
||||
, State (Store (LocationFor v) v) -- For 'MonadStore'.
|
||||
, Reader (Environment (LocationFor v) v) -- For 'MonadEnv'.
|
||||
, Reader (Linker v) -- For 'MonadLinker'.
|
||||
, Reader (Live (LocationFor v) v) -- For 'MonadGC'.
|
||||
, Reader (Linker v) -- For 'MonadLinker'.
|
||||
]
|
||||
|
||||
-- | Evaluate a term to a value.
|
||||
@ -52,15 +54,16 @@ evaluates :: forall v term
|
||||
, Recursive term
|
||||
, AbstractValue v
|
||||
, MonadAddress (LocationFor v) (Eff (Evaluating v))
|
||||
, MonadLinker v (Eff (Evaluating v))
|
||||
-- , MonadLinker v (Eff (Evaluating v))
|
||||
, Eval term v (Eff (Evaluating v)) (Base term)
|
||||
)
|
||||
=> [term]
|
||||
=> [(FilePath, term)]
|
||||
-> Final (Evaluating v) v
|
||||
evaluates = run @(Evaluating v) . fix go pure
|
||||
where
|
||||
go recur yield [] = yield unit
|
||||
go recur yield [a] = eval (\x y -> recur x [y]) pure (project a) >>= yield
|
||||
go recur yield (a:as) = do
|
||||
linker <- askLinker :: (Eff (Evaluating v)) (Linker v)
|
||||
eval (const (const (go recur pure as))) pure (project a) >>= yield
|
||||
go _ yield [] = yield unit
|
||||
go recur yield [(f, a)] = trace ("[]:" <> show f) $ eval (\_ term -> recur pure [(f, term)]) yield (project a)
|
||||
go recur yield ((f, a):as) = do
|
||||
x <- trace ("[a:as] " <> show f) $
|
||||
eval (const (const (go recur pure as))) pure (project a)
|
||||
localLinker (linkerInsert f x) (yield x)
|
||||
|
@ -3,11 +3,13 @@ module Data.Syntax.Declaration where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad.Effect.Address
|
||||
import Control.Monad.Effect.Linker
|
||||
import Control.Monad.Effect.Env
|
||||
import Control.Monad.Effect.Fresh
|
||||
import Control.Monad.Effect.Store
|
||||
import Data.Abstract.Address
|
||||
import Data.Abstract.Environment
|
||||
import Data.Abstract.Linker
|
||||
import Data.Abstract.Eval
|
||||
import Data.Abstract.FreeVariables
|
||||
import Data.Abstract.Type hiding (Type)
|
||||
@ -23,6 +25,9 @@ import Data.Union
|
||||
import Diffing.Algorithm
|
||||
import GHC.Generics
|
||||
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import Debug.Trace
|
||||
|
||||
data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
|
||||
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
|
||||
|
||||
@ -259,7 +264,19 @@ instance Ord1 Import where liftCompare = genericLiftCompare
|
||||
instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
|
||||
|
||||
-- TODO: Implement Eval instance for Import
|
||||
instance (MonadFail m) => Eval t v m Import
|
||||
instance ( MonadFail m
|
||||
, MonadLinker v m
|
||||
, AbstractValue v
|
||||
, FreeVariables t
|
||||
, Show v
|
||||
)
|
||||
=> Eval t v m Import where
|
||||
eval recur yield (Import from alias _) = do
|
||||
let [name] = toList (freeVariables from)
|
||||
|
||||
linker <- askLinker @v
|
||||
let v = linkerLookup (BC.unpack name <> ".py") linker
|
||||
trace ("name: " <> show name <> " v: " <> show v) $ yield unit
|
||||
|
||||
-- | An imported symbol
|
||||
data ImportSymbol a = ImportSymbol { importSymbolName :: !a, importSymbolAlias :: !a }
|
||||
|
Loading…
Reference in New Issue
Block a user