(* Copyright 2019 Chetan Murthy, All rights reserved. *)

#use "topfind";;

#require "camlp5";;
#require "pa_ppx.testutils";;
#require"pa_ppx.runtime_fat" ;;
#require "qc_ocaml";;
#require "oUnit";;
#print_length 1048576 ;;

open Gg ;;
open Asttools ;;
open Pa_ppx_utils ;;
open Coll ;;
open Std ;;
open Misc_functions ;;
open Qc_misc ;;
open Qc ;;
open Qasm2syntax ;;
open OUnit2 ;;
open Qc_quat ;;

Pa_ppx_base.Pp_MLast.Ploc.pp_loc_verbose := true ;;
Pa_ppx_runtime_fat.Exceptions.Ploc.pp_loc_verbose := true ;;

#install_printer Fpath.pp ;;

let lexbuf_contents lb =
  let open Lexing in
  let pos = lb.lex_curr_pos in
  let len = lb.lex_buffer_len - lb.lex_curr_pos in
  (Bytes.to_string (Bytes.sub lb.lex_buffer pos len))
;;

let pp_lexbuf lb =
  Format.print_string "#<lexbuf:<";
  Format.print_string (lexbuf_contents lb);
  Format.print_string ">>"
;;
#install_printer pp_lexbuf ;;

let pp_tokenaux (t : Qc_misc.TokenAux.t) = Fmt.(pf stdout "<tokenaux>") ;;
#install_printer pp_tokenaux ;;


open Qlam_syntax ;;
open Qlam_ops ;;
open Qlam_env ;;
module LATEX = Qc_latex ;;

let id_pp x = Fmt.(pf stdout "<:id<%a>>" ID.pp_hum x) ;;
#install_printer id_pp ;;

let qvar_pp x = Fmt.(pf stdout "<:qvar<%a>>" SYN.QV.pp_hum x) ;;
#install_printer qvar_pp ;;

let cvar_pp x = Fmt.(pf stdout "<:cvar<%a>>" SYN.CV.pp_hum x) ;;
#install_printer cvar_pp ;;

let bi_pp x = Fmt.(pf stdout "<:bi< %a >>" SYN.BI.pp_hum x) ;;
#install_printer bi_pp ;;

let qgn_pp x = Fmt.(pf stdout "<:qgn<%a>>" SYN.QG.pp_hum x) ;;
(*
#install_printer qgn_pp ;;
 *)
let qcircuit_pp qc = Fmt.(pf stdout "<:circuit< %a >>" Qlam.Circ.pp_hum qc) ;;
#install_printer qcircuit_pp ;;

let gate_item_pp gi = Fmt.(pf stdout "<:gate_item< %a >>" Qlam.Gate.pp_hum gi) ;;
(*
#install_printer gate_item_pp ;;
 *)
let item_pp gi = Fmt.(pf stdout "<:item< %a >>" PP.item gi) ;;
#install_printer item_pp ;;

let read_file_tolam s0 =
  let (env,instrs) = with_include_path ~path:["testdata"] Qasm2.of_file s0 in
  Qlam.Prog.of_qasm2 (env, instrs)
;;

let pp_qvfvs x = Fmt.(pf stdout "<:qvfvs<%a>>" SYN.QVSet.pp_hum x) ;;
let pp_cvfvs x = Fmt.(pf stdout "<:cvfvs<%a>>" SYN.CVSet.pp_hum x) ;;

let pp_qv_corr l = Fmt.(pf stdout "<:qvcorr<%a>>" (list ~sep:(const string "; ") (parens (pair ~sep:(const string ", ") SYN.QV.pp_hum SYN.QV.pp_hum))) (SYN.QVMap.bindings l)) ;;
let pp_cv_corr l = Fmt.(pf stdout "<:cvcorr<%a>>" (list ~sep:(const string "; ") (parens (pair ~sep:(const string ", ") SYN.CV.pp_hum SYN.CV.pp_hum))) (SYN.CVMap.bindings l)) ;;

#install_printer pp_qvfvs ;;
#install_printer pp_cvfvs ;;
#install_printer pp_qv_corr ;;
#install_printer pp_cv_corr ;;

let pp_layout l = Fmt.(pf stdout "<:layout< %a >>" Qlam_ops.LO.pp_hum l) ;;
#install_printer pp_layout ;;

let pp_logical2qvar m = Fmt.(pf stdout "<:logical2qvar< %a >>" (SYN.BIMap.pp_hum SYN.QV.pp_hum) m) ;; 
#install_printer pp_logical2qvar ;;

let pp_ab_env x = Fmt.(pf stdout "<:abenv< %a >>" Qlam_ops.AB.Env.pp_hum x) ;;
#install_printer pp_ab_env ;;

let pp_quat x = Fmt.(pf stdout "<:quat< %a >>" Quat.pp x) ;;
#install_printer pp_quat ;;

let pp_m3 x = Fmt.(pf stdout "<:m3< %a >>" M3.pp x) ;;
#install_printer pp_m3 ;;

let pp_v3 x = Fmt.(pf stdout "<:v3< %a >>" V3.pp x) ;;
#install_printer pp_v3 ;;

#load "test_helpers.cmo";;
#load "qasm2_tests.cmo";;
open Test_helpers ;;
open Qasm2_tests ;;


#load "qlam_tests.cmo";;
open Qlam_tests ;;

#load "qclatex_tests.cmo";;
open Qclatex_tests ;;

#load "quaternion_tests.cmo";;
open Quaternion_tests ;;


let optimize_1q_test_ok ?(basis=["U";"CX";"cx"]) (name, input_qasm, expect_qlam) =
    let cmp = Ops.AlphaEq.qcircuit ~eps in
    let printer qc = Fmt.(str "%a\n%!" Qlam.Circ.pp_hum (Ops.UnsafeLower.qcircuit qc)) in
    let p0 = parse_tolam input_qasm in
    let (genv0, p1) = Ops.Standard.program ~env0 p0 in
    let p2 = Ops.Unroll.program ~except:(basis |> List.map SYN.QG.of_string) p1 in
    let (genv, p3) = Ops.Standard.program ~env0 p2 in
    let p4 = Ops.Optimize1q.program ~eps genv0 ~env0 p3 in
    let (genv0, (_, qc) as p5) = Ops.Standard.program ~env0 p4 in
    let expected_qc = Qlam.Circ.of_string expect_qlam in
    assert_equal ~printer ~cmp expected_qc qc
;;


let pp_unroll_env m = Fmt.(pf stdout "<:unroll_env< %a >>" (SYN.QGMap.pp_hum PP.qgatelam) m) ;; 
#install_printer pp_unroll_env ;;

let pp_opt_env m = Fmt.(pf stdout "<:optenv< %a >>" Ops.Optimize1q.pp_hum_env_t m) ;;
#install_printer pp_opt_env ;;

(*
#trace Ops.AlphaEq.alpharec ;;
#trace SYN.PE.equal ;;
 *)
#trace Ops.UnsafeLower.qcircuit ;;
#trace Ops.AlphaEq.qcircuit ;;
#trace Ops.Optimize1q.optimize_1q ;;
#trace Ops.Optimize1q.program ;;

optimize_1q_test_ok("collapse_identity_equivalent",
{|
OPENQASM 2.0;
include "qelib1.inc";
qreg qr[2];
creg cr[2];
h qr[0];
cx qr[1],qr[0];
u1(2*pi) qr[0];
cx qr[1],qr[0];
u1(pi/2) qr[0];
u1(pi) qr[0];
u1(pi/2) qr[0];
cx qr[1],qr[0];
u1(pi) qr[1];
u1(pi) qr[1];
measure qr[0] -> cr[0];
measure qr[1] -> cr[1];
|},
{|
let q = qubit #0 () in
(q)
|}) ;;

(* Local Variables: *)
(* mode: tuareg *)
(* End: *)
