/[mojave]/metaprl/library/nuprl5.ml
ViewVC logotype

Contents of /metaprl/library/nuprl5.ml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2149 - (show annotations) (download)
Wed Apr 22 18:25:10 1998 UTC (23 years, 3 months ago) by eaton
File size: 2004 byte(s)
.

1 open Term
2 open Opname
3 open Num
4
5 let nuprl5_opname = mk_opname "!nuprl5_implementation!" nil_opname
6
7 (* parameter mapping *)
8
9 let make_bool_parameter b =
10 make_param (ParmList
11 [(make_param (Token "bool")); (make_param (Number (Num.Int (if b then 1 else 0))))])
12
13 let make_time_parameter time =
14 make_param (ParmList
15 [(make_param (Token "time")); (make_param (Number time))])
16
17 let time_parameter_p p =
18 match (dest_param p) with
19 ParmList [h; a; b] -> (match (dest_param h) with
20 Token s -> if s = "time" then (match (dest_param a) with
21 Number i -> (match (dest_param b) with
22 Number i -> true
23 | _ -> false)
24 | _ -> false) else false
25 | _ -> false)
26 | _ -> false
27
28 let bool_parameter_p p =
29 match (dest_param p) with
30 ParmList [h; v] -> (match (dest_param h) with
31 Token s -> if s = "bool" then (match (dest_param v) with
32 Number (Num.Int i) -> (i = 1) or (i = 0)
33 | _ -> false) else false
34 | _ -> false)
35 | _ -> false
36
37 let destruct_time_parameter p =
38 match (dest_param p) with
39 ParmList [h; n] -> (match (dest_param h) with
40 Token s -> (if s = "time" then (match (dest_param n) with
41 Number i -> i
42 | _ -> raise (Invalid_argument "destruct_time_parameter_b"))
43 else raise (Invalid_argument "destruct_time_parameter_c"))
44 | _ -> raise (Invalid_argument "destruct_time_parameter_d"))
45 | _ -> raise (Invalid_argument "destruct_time_parameter_e")
46
47
48 let destruct_bool_parameter p =
49 match (dest_param p) with
50 ParmList [h; v] -> (match (dest_param h) with
51 Token s -> if s = "bool" then (match (dest_param v) with
52 Number (Num.Int i) -> i = 1
53 | _ -> raise (Invalid_argument "destruct_bool_parameter"))
54 else raise (Invalid_argument "destruct_bool_parameter")
55 | _ -> raise (Invalid_argument "destruct_bool_parameter"))
56 | _ -> raise (Invalid_argument "destruct_bool_parameter")
57
58 (* common terms *)
59
60 (*
61 let itoken_term s = mk_token_term nuprl5_opname s
62 let inatural_term i = mk_number_term nuprl5_opname i
63 *)
64
65
66

Properties

Name Value
svn:eol-style native
svn:keywords Author Date Id Revision

  ViewVC Help
Powered by ViewVC 1.1.26