Upgrade unitary compiler for primitives

examples/matrix_search/demo.hs

@@ -5,9 +5,10 @@
 module Main where
 
 import Text.Parsec.String (parseFromFile)
-import qualified Traq.Data.Context as Ctx
 import qualified Traq.Data.Symbolic as Sym
 
+import Lens.Micro.GHC
+
 import qualified Traq.Analysis as A
 import Traq.Prelude
 import qualified Traq.ProtoLang as P
@@ -47,7 +48,7 @@ expectedCost n m matrix eps = do
   program_annotated <- either fail pure $ A.annotateProgWithErrorBudget (A.failProb eps) program
 
   -- the functionality of Matrix, provided as input data
-  let interp = Ctx.singleton "Matrix" (matrixToFun matrix)
+  let interp = mempty & at "Matrix" ?~ matrixToFun matrix
 
   return $ getCost $ A.expCostQProg program_annotated mempty interp
 

examples/tree_generator/demo.hs

@@ -6,9 +6,9 @@
 module Main where
 
 import Text.Parsec.String (parseFromFile)
-import qualified Traq.Data.Context as Ctx
 import qualified Traq.Data.Symbolic as Sym
 
+import Lens.Micro.GHC
 import qualified Traq.Analysis as A
 import Traq.Prelude
 import qualified Traq.ProtoLang as P
@@ -83,11 +83,10 @@ expectedCost ctx@Ctx{..} eps = do
 
   -- the functionality of Matrix, provided as input data
   let interp =
-        Ctx.fromList
-          [ ("Capacity", \_ -> [P.toValue capacity])
-          , ("Profit", listToFun profits)
-          , ("Weight", listToFun weights)
-          ]
+        mempty
+          & (at "Capacity" ?~ \_ -> [P.toValue capacity])
+          & (at "Profit" ?~ listToFun profits)
+          & (at "Weight" ?~ listToFun weights)
 
   return $ getCost $ A.expCostQProg program_annotated mempty interp
 

experiments/compile_loc.hs

@@ -5,9 +5,11 @@ module Main where
 import Control.Monad (when)
 import Text.Parsec.String (parseFromFile)
 import Text.Printf (printf)
+
+import qualified Traq.Data.Symbolic as Sym
+
 import qualified Traq.Analysis as Traq
 import qualified Traq.Compiler.Quantum
-import qualified Traq.Data.Symbolic as Sym
 import Traq.Prelude
 import qualified Traq.Primitives as Traq
 import qualified Traq.ProtoLang as P

experiments/matrixsearchqcost.hs

@@ -11,7 +11,7 @@ import System.Random.Shuffle (shuffleM)
 import System.TimeIt (timeIt)
 import Text.Printf (printf)
 
-import qualified Traq.Data.Context as Ctx
+import Lens.Micro.GHC
 
 import qualified Traq.Analysis as A
 import Traq.Analysis.CostModel.QueryCost (SimpleQueryCost (..))
@@ -108,7 +108,7 @@ qcost _ eps mat = getCost cost
   ex = matrixExample @primsT n m
   ex' = either error id $ A.annotateProgWithErrorBudget eps ex
 
-  dataCtx = Ctx.singleton "Matrix" (toValueFun mat)
+  dataCtx = mempty & at "Matrix" ?~ toValueFun mat
 
   cost = A.expCostQProg ex' [] dataCtx
 

experiments/timing.hs

@@ -4,17 +4,20 @@
 module Main where
 
 import Control.Monad (forM_, replicateM, when)
-import Lens.Micro.GHC
+import qualified Data.Map as Map
 import System.Random (randomIO)
 import System.TimeIt (timeItT)
 import Text.Parsec.String (parseFromFile)
 import Text.Printf (printf)
+
+import Lens.Micro.GHC
+
+import qualified Traq.Data.Symbolic as Sym
+
 import qualified Traq.Analysis as Traq
 import qualified Traq.Analysis.CostModel.QueryCost as Traq
 import qualified Traq.CQPL as CQPL
 import qualified Traq.Compiler
-import qualified Traq.Data.Context as Ctx
-import qualified Traq.Data.Symbolic as Sym
 import Traq.Examples.MatrixSearch (matrixExampleS)
 import Traq.Prelude
 import qualified Traq.Primitives as Traq
@@ -83,7 +86,7 @@ matrixSearchExpt = do
     let mat = \case
           [P.FinV i, P.FinV j] -> [P.FinV $ if i == j then 1 else 0]
           _ -> undefined
-    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Ctx.singleton "Matrix" mat)
+    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Map.singleton "Matrix" mat)
     putStrLn $ printf "%d, %.5f, %d" n wallTime numQubits
 
 depth3NAND :: IO ()
@@ -105,7 +108,7 @@ depth3NAND = do
     let f = \case
           [P.FinV i, P.FinV j, P.FinV k] -> [P.FinV $ if i == j || j == k then 1 else 0]
           _ -> undefined
-    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Ctx.singleton "f" f)
+    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Map.singleton "f" f)
     putStrLn $ printf "%d, %.5f, %d" n wallTime numQubits
 
 hillClimbExpt :: IO ()
@@ -121,7 +124,7 @@ hillClimbExpt = do
     -- compute the weight of an assignment
     let phi _ = [P.FinV 0]
 
-    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Ctx.singleton "Phi" phi)
+    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Map.singleton "Phi" phi)
     putStrLn $ printf "%d, %.5f, %d" n wallTime numQubits
 
 triangleFinding :: IO ()
@@ -137,7 +140,7 @@ triangleFinding = do
     let f = \case
           [P.FinV u, P.FinV v] -> [P.toValue $ adj !! u !! v]
           _ -> undefined
-    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Ctx.singleton "Adj" f)
+    ExptResult{wallTime, numQubits} <- runExpt' prog eps (Map.singleton "Adj" f)
     putStrLn $ printf "%d, %.5f, %d" n wallTime numQubits
 main :: IO ()
 main = do

src/Traq/Analysis/Annotate/SplitBudget.hs

@@ -25,7 +25,7 @@ import Traq.Data.Default (default_)
 import Traq.Analysis.Annotate.Basic
 import Traq.Analysis.Annotate.Prelude
 import Traq.Analysis.Error.Prelude
-import Traq.Analysis.Prelude (sizeToPrec)
+import Traq.Analysis.Prelude
 import Traq.Prelude
 import Traq.ProtoLang
 
@@ -140,7 +140,7 @@ instance AnnotateWithErrorBudgetU1 Expr where
   annEpsU1 eps (PrimCallE ext') = PrimCallE <$> annEpsU eps ext'
   annEpsU1 eps LoopE{..} = do
     fn@FunDef{param_types} <- use (_funCtx . Ctx.at loop_body_fun) >>= maybeWithError "cannot find loop body function"
-    let Fin n_iters = last param_types
+    let n_iters = last param_types ^?! _Fin
     let eps' = splitFailProb eps (sizeToPrec n_iters)
     annEpsU1 eps' (NamedFunDef loop_body_fun fn)
     pure LoopE{..}
@@ -155,7 +155,7 @@ instance AnnotateWithErrorBudgetQ1 Expr where
   annEpsQ1 eps (PrimCallE ext) = PrimCallE <$> annEpsQ eps ext
   annEpsQ1 eps LoopE{..} = do
     fn@FunDef{param_types} <- use (_funCtx . Ctx.at loop_body_fun) >>= maybeWithError "cannot find loop body function"
-    let Fin n_iters = last param_types
+    let n_iters = last param_types ^?! _Fin
     let eps' = splitFailProb eps (sizeToPrec n_iters)
     annEpsQ1 eps' (NamedFunDef loop_body_fun fn)
     pure LoopE{..}