src/HOL/Tools/res_skolem_function.ML
author haftmann
Sat, 04 Jun 2005 21:43:55 +0200
changeset 16240 95cc0e8f8a17
parent 15347 14585bc8fa09
child 16803 014090d1e64b
permissions -rw-r--r--
added shellcmd style
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
15347
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     1
(*  Author: Jia Meng, Cambridge University Computer Laboratory
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     2
    ID: $Id$
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     3
    Copyright 2004 University of Cambridge
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     4
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     5
Generation of unique Skolem functions (with types) as Term.term.
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     6
*)
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     7
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     8
signature RES_SKOLEM_FUNCTION =
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
     9
sig
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    10
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    11
val gen_skolem: Term.term list -> Term.typ  -> Term.term
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    12
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    13
end;
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    14
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    15
structure ResSkolemFunction: RES_SKOLEM_FUNCTION  =
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    16
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    17
struct
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    18
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    19
val skolem_prefix = "sk_";
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    20
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    21
(* internal reference starting from 0. *)
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    22
val skolem_id = ref 0;
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    23
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    24
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    25
fun gen_skolem_name () = 
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    26
    let val new_id = !skolem_id
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    27
	val sk_fun = skolem_prefix ^ (string_of_int new_id)
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    28
    in
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    29
	(skolem_id := new_id + 1; sk_fun) (* increment id by 1. *)
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    30
    end;
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    31
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    32
fun sk_type_of_aux [Var(_,tp1)] tp = Type("fun",[tp1,tp])
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    33
  | sk_type_of_aux (Var(_,tp1)::vars) tp = 
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    34
    let val tp' = sk_type_of_aux vars tp
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    35
    in
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    36
	Type("fun",[tp1,tp'])
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    37
    end;
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    38
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    39
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    40
fun sk_type_of [] tp = tp
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    41
  | sk_type_of vars tp = sk_type_of_aux vars tp; 
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    42
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    43
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    44
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    45
fun gen_skolem univ_vars tp = 
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    46
    let val new_sk_name = gen_skolem_name ()
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    47
	val new_sk_type = sk_type_of univ_vars tp
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    48
	val skolem_term = Const(new_sk_name,new_sk_type)
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    49
	fun app [] sf = sf
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    50
	  | app (var::vars) sf= app vars (sf $ var)
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    51
    in
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    52
	app univ_vars skolem_term
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    53
    end;
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    54
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    55
14585bc8fa09 resolution package tools by Jia Meng
paulson
parents:
diff changeset
    56
end;