general.icl 2.48 KB
Newer Older
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
1
2
3
4
implementation module general

import StdEnv

5
6
:: P a b = P !a !b

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
7
8
9
10
11
::	Bind a b =
	{	bind_src :: !a
	,	bind_dst :: !b
	}	

12
::	Env a b :== [.Bind a b]
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
13
14
15
16
17
18
19

::	Optional x = Yes !x | No

cMAXINT :== 2147483647

::	BITVECT :== Int

20
21
22
23
hasOption :: (Optional x) -> Bool
hasOption (Yes _) 	= True
hasOption No 		= False

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
instance ~ Bool
where ~ b = not b

instance <<< Bool
where
	(<<<) file bool = file <<< (toString bool)

instance <<< (a,b) | <<< a & <<< b
where
	(<<<) file (x,y) = file <<< '(' <<< x <<< ", " <<< y <<< ") "

instance <<< (a,b,c) | <<< a & <<< b & <<< c
where
	(<<<) file (x,y,z) = file <<< '(' <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "

instance <<< (a,b,c,d) | <<< a & <<< b & <<< c & <<< d
where
	(<<<) file (w,x,y,z) = file <<< '(' <<< w <<< ", " <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "

instance <<< (a,b,c,d,e) | <<< a & <<< b & <<< c & <<< d & <<< e
where
	(<<<) file (v,w,x,y,z) = file <<< '(' <<< v <<< ", " <<< w <<< ", " <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "

47
48
49
50
51
52
53
54
instance <<< (a,b,c,d,e,f) | <<< a & <<< b & <<< c & <<< d & <<< e & <<< f
where
	(<<<) file (u,v,w,x,y,z) = file <<< '(' <<< u <<< ", " <<< v <<< ", " <<< w <<< ", " <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "

instance <<< (a,b,c,d,e,f,g) | <<< a & <<< b & <<< c & <<< d & <<< e & <<< f & <<< g
where
	(<<<) file (t,u,v,w,x,y,z) = file <<< '(' <<< t <<< ", " <<< u <<< ", " <<< v <<< ", " <<< w <<< ", " <<< x <<< ", " <<< y <<< ", " <<< z <<< ") "

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
55
56
57
58
59
60
61
62
63
64
65
instance <<< [a] | <<< a
where
	(<<<) file [] = file <<< "[]"
	(<<<) file l  = showTail (file <<< "[") l
	where
		showTail f [x]   = f <<< x <<< "] "
		showTail f [a:x] = showTail (f <<< a <<< ", ") x
		showTail f []    = f <<< "] "

(--->) infix :: .a !b -> .a | <<< b
(--->) val message
Sjaak Smetsers's avatar
Sjaak Smetsers committed
66
67
	| file_to_true (stderr <<< message <<< '\n')
		= val
68
		= halt
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
69

70
71
72
73
74
75
76
77
78
79
80
// Strict version of --->, which evaluates its lhs first
(<---) infix :: !.a !b -> .a | <<< b
(<---) value message = value ---> message

// Tracing evaluation of a value, otherwise acts like identity
traceValue :: !String !String .a -> .a
traceValue contextdesc valuedesc value
= (value <--- (contextdesc+++" <<== "+++valuedesc)) ---> (contextdesc+++" ==>> "+++valuedesc)



Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
81
82
(-?->) infix :: .a !(!Bool, !b) -> .a | <<< b
(-?->) val (cond, message)  
Sjaak Smetsers's avatar
Sjaak Smetsers committed
83
84
85
	| cond
		| file_to_true (stderr <<< message <<< '\n')
			= val
86
			= halt
Sjaak Smetsers's avatar
Sjaak Smetsers committed
87
		= val
Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
88
89
90
91
92
93
94
95
96

file_to_true :: !File -> Bool
file_to_true file = code {
  .inline file_to_true
          pop_b 2
          pushB TRUE
  .end
  }

97
98
99
100
101
halt :: .a
halt = code {
	halt
 }

Ronny Wichers Schreur's avatar
Ronny Wichers Schreur committed
102
103
104
instance + {#Char}
where
	(+) s t = s +++ t