(*
    ||M||  This file is part of HELM, an Hypertextual, Electronic        
    ||A||  Library of Mathematics, developed at the Computer Science     
    ||T||  Department, University of Bologna, Italy.                     
    ||I||                                                                
    ||T||  HELM is free software; you can redistribute it and/or         
    ||A||  modify it under the terms of the GNU General Public License   
    \   /  version 2 or (at your option) any later version.              
     \ /   This software is distributed as is, NO WARRANTY.              
      V_______________________________________________________________ *)

module L  = Log
module E  = Entity
module G  = Options
module S  = Status
module B  = Brg
module BE = BrgEnvironment
module BR = BrgReduction

(* Internal functions *******************************************************)

let level = 3

let message1 st1 m t1 =
   L.et_items1 "In the environment" m st1 t1

let log1 s m t =
   let s =  s ^ " the term" in
   L.log BR.specs level (message1 s m t) 

let error1 err s m t =
   err (message1 s m t)

let message2 m1 t1 m2 t2 =    
   let sm2, st2 = "In the environment", "the term" in
   let sm1, st1 = "is valid, but in the environment", "it must be of type" in
   L.et_items2 sm2 m2 st2 t2 ~sc2:sm1 ~c2:m1 st1 t1

let error2 err m1 t1 m2 t2 =
   err (message2 m1 t1 m2 t2)

let zero = Some 0

let one = Some 1

let assert_convertibility err f st m u t =
   if BR.are_convertible st m zero u m one t then f () else
   error2 err m u m t

let assert_applicability err f st m v t =
   match BR.xwhd st m None t with 
      | _, B.Sort _                      ->
         error1 err "not a function" m t
      | mw, B.Bind (_, B.Abst (_, w), _) ->
         if BR.are_convertible st mw zero w m one v then f () else
	 error2 err mw w m v
      | _                                -> assert false (**)

let rec b_validate err f st m x =
   if !G.trace >= level then log1 "Now checking" m x;
   match x with
   | B.Sort _         -> f ()
   | B.LRef (_, i)    ->
      begin match BR.get m i with
         | B.Abst _
	 | B.Abbr _ -> f ()
	 | B.Void   -> 
	    error1 err "reference to excluded variable" m x
      end
   | B.GRef (_, uri)  ->
      begin match BE.get_entity uri with
         | _, _, E.Abst _
	 | _, _, E.Abbr _ -> f ()
	 | _, _, E.Void   ->
            error1 err "reference to unknown entry" m x
      end
   | B.Bind (a, b, t) ->
      let f () = b_validate err f st (BR.push m a b) t in
      begin match b with 
         | B.Abst (n, u) -> validate err f st m u
         | B.Abbr v      -> validate err f st m v
         | B.Void        -> f ()
      end
   | B.Appl (_, v, t)        ->
      let f () = assert_applicability err f st m v t in
      let f () = b_validate err f st m t in
      validate err f st m v
   | B.Cast (_, u, t)        ->
      let f () = assert_convertibility err f st m u t in
      let f () = b_validate err f st m t in
      validate err f st m u

(* Interface functions ******************************************************)

and validate err f st m x = b_validate err f st m x