1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Abstract load/require over the term evaluator.

This commit is contained in:
Rob Rix 2018-03-01 15:08:58 -05:00
parent c2a60138c6
commit 32609034a0

View File

@ -33,12 +33,11 @@ type Evaluating t v
-- --
-- Looks up the term's name in the cache of evaluated modules first, returns a value if found, otherwise loads/evaluates the module. -- Looks up the term's name in the cache of evaluated modules first, returns a value if found, otherwise loads/evaluates the module.
require :: ( AbstractValue v require :: ( AbstractValue v
, Evaluatable (Base term)
, FreeVariables term , FreeVariables term
, MonadAddressable (LocationFor v) v m , MonadAddressable (LocationFor v) v m
, MonadAnalysis term v m
, MonadEvaluator term v m , MonadEvaluator term v m
, MonadFunction term v m , MonadFunction term v m
, Recursive term
, Semigroup (Cell (LocationFor v) v) , Semigroup (Cell (LocationFor v) v)
) )
=> term => term
@ -50,12 +49,11 @@ require term = getModuleTable >>= maybe (load term) pure . linkerLookup name
-- --
-- Always loads/evaluates. -- Always loads/evaluates.
load :: ( AbstractValue v load :: ( AbstractValue v
, Evaluatable (Base term)
, FreeVariables term , FreeVariables term
, MonadAddressable (LocationFor v) v m , MonadAddressable (LocationFor v) v m
, MonadAnalysis term v m
, MonadFunction term v m , MonadFunction term v m
, MonadEvaluator term v m , MonadEvaluator term v m
, Recursive term
, Semigroup (Cell (LocationFor v) v) , Semigroup (Cell (LocationFor v) v)
) )
=> term => term
@ -64,7 +62,7 @@ load term = askModuleTable >>= maybe notFound evalAndCache . linkerLookup name
where name = moduleName term where name = moduleName term
notFound = fail ("cannot find " <> show name) notFound = fail ("cannot find " <> show name)
evalAndCache e = do evalAndCache e = do
v <- foldSubterms eval e v <- evaluateTerm e
modifyModuleTable (linkerInsert name v) modifyModuleTable (linkerInsert name v)
pure v pure v