Verified Commit 2b6446a6 authored by Camil Staps's avatar Camil Staps 🚀

Cache requests while resolving ranking constraints

parent a2a620fa
...@@ -13,6 +13,8 @@ import Data.Error ...@@ -13,6 +13,8 @@ import Data.Error
from Data.Foldable import class Foldable(foldr1) from Data.Foldable import class Foldable(foldr1)
from Data.Func import $ from Data.Func import $
import Data.Functor import Data.Functor
from Data.GenLexOrd import :: LexOrd, generic gLexOrd
import qualified Data.GenLexOrd
from Data.List import instance Foldable [] from Data.List import instance Foldable []
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
...@@ -160,7 +162,7 @@ where ...@@ -160,7 +162,7 @@ where
rankConstraints :: ![(Request, RankConstraint)] !*CloogleDB -> *([String], *CloogleDB) rankConstraints :: ![(Request, RankConstraint)] !*CloogleDB -> *([String], *CloogleDB)
rankConstraints constraints cdb rankConstraints constraints cdb
# (constraints,cdb) = findConstraints constraints cdb # (constraints,cdb) = findConstraints constraints 'M'.newMap cdb
= (default ++ constraints,cdb) = (default ++ constraints,cdb)
where where
default = default =
...@@ -178,16 +180,25 @@ where ...@@ -178,16 +180,25 @@ where
, "(declare-const rs_lib_stdenv Real)" , "(declare-const rs_lib_stdenv Real)"
] ]
findConstraints :: ![(Request, RankConstraint)] !*CloogleDB -> *([String], *CloogleDB) derive gLexOrd Request, Maybe
findConstraints [(req,LT urid1 urid2):rest] cdb instance < Request where < a b = (gLexOrd{|*|} a b)=:'Data.GenLexOrd'.LT
# (orgsearchtype,allsyns,usedsyns,entries,cdb) = search` req cdb
findConstraints ::
![(Request, RankConstraint)]
!(Map Request (!Maybe Type,!Map String [TypeDef],![TypeDef],![(!CloogleEntry,![Annotation])]))
!*CloogleDB -> *([String], *CloogleDB)
findConstraints [(req,LT urid1 urid2):rest] results cdb
# (orgsearchtype,allsyns,usedsyns,entries,cdb) = case 'M'.get req results of
Just (t,as,us,es) -> (t,as,us,es,cdb)
_ -> search` req cdb
# results = 'M'.put req (orgsearchtype,allsyns,usedsyns,entries) results
# (e1,annots1,cdb) = findEntry orgsearchtype allsyns usedsyns urid1 entries cdb # (e1,annots1,cdb) = findEntry orgsearchtype allsyns usedsyns urid1 entries cdb
# (e2,annots2,cdb) = findEntry orgsearchtype allsyns usedsyns urid2 entries cdb # (e2,annots2,cdb) = findEntry orgsearchtype allsyns usedsyns urid2 entries cdb
# ri1 = symbolicDistance e1 annots1 # ri1 = symbolicDistance e1 annots1
# ri2 = symbolicDistance e2 annots2 # ri2 = symbolicDistance e2 annots2
# this = "(assert (< (" +++ formula ri1 +++ ") (" +++ formula ri2 +++ ")))" # this = "(assert (< (" +++ formula ri1 +++ ") (" +++ formula ri2 +++ ")))"
# cdb = resetDB cdb # cdb = resetDB cdb
# (rest,cdb) = findConstraints rest cdb # (rest,cdb) = findConstraints rest results cdb
= ([this:rest],cdb) = ([this:rest],cdb)
where where
findEntry orgsearchtype allsyns usedsyns urid=:(_,mod,name) entries cdb findEntry orgsearchtype allsyns usedsyns urid=:(_,mod,name) entries cdb
...@@ -225,4 +236,4 @@ where ...@@ -225,4 +236,4 @@ where
sum [t:ts] sum [t:ts]
# s = sum ts # s = sum ts
= "+ (" +++ t +++ ") (" +++ s +++ ")" = "+ (" +++ t +++ ") (" +++ s +++ ")"
findConstraints [] cdb = ([],cdb) findConstraints [] _ cdb = ([],cdb)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment