1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
implementation module CleanC
import StdEnv
from GenEq import generic gEq
:: State :== Int
derive gEq CType
cNewState :: *State
cNewState = 42
instance toInt CParam where toInt (CI i) = i
instance toString CParam where toString (CS s) = s
instance toReal CParam where toReal (CR r) = r
instance fromCParam Int where fromCParam (CI i) = i
instance fromCParam String where fromCParam (CS s) = s
instance fromCParam Real where fromCParam (CR r) = r
instance fromInt CParam where fromInt i = CI i
instance fromString CParam where fromString s = CS s
instance fromReal CParam where fromReal r = CR r
instance toCParam Int where toCParam i = CI i
instance toCParam String where toCParam s = CS s
instance toCParam Real where toCParam r = CR r
instance toCParamList [CParam] where toCParamList ps = ps
instance toCParamList Int where toCParamList i = [CI i]
instance toCParamList String where toCParamList s = [CS s]
instance toCParamList Real where toCParamList r = [CR r]
instance toCParamList (a,b) | toCParam a & toCParam b
where toCParamList (x,y) = [toCParam x, toCParam y]
instance toCParamList (a,b,c) | toCParam a & toCParam b & toCParam c
where toCParamList (a,b,c) = [toCParam a, toCParam b, toCParam c]
instance toCParamList (a,b,c,d) | toCParam a & toCParam b & toCParam c & toCParam d
where toCParamList (a,b,c,d) = [toCParam a, toCParam b, toCParam c, toCParam d]
instance toCParamList (a,b,c,d,e) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e
where toCParamList (a,b,c,d,e) = [toCParam a, toCParam b, toCParam c, toCParam d, toCParam e]
instance toCParamList (a,b,c,d,e,f) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e & toCParam f
where toCParamList (a,b,c,d,e,f) = [toCParam a, toCParam b, toCParam c, toCParam d, toCParam e, toCParam f]
instance toCParamList (a,b,c,d,e,f,g) | toCParam a & toCParam b & toCParam c & toCParam d & toCParam e & toCParam f & toCParam g
where toCParamList (a,b,c,d,e,f,g) = [toCParam a, toCParam b, toCParam c, toCParam d, toCParam e, toCParam f, toCParam g]
cInit :: !*State -> *State
cInit s = code inline {
ccall cleanInit ":V:I"
}
cPuti :: !Int !*State -> *State
cPuti i s = code inline {
ccall cleanPuti "I:V:I"
}
cPuts :: !String !*State -> *State
cPuts s st = code inline {
ccall cleanPuts "S:V:I"
}
cPutr :: !Real !*State -> *State
cPutr r st = code inline {
ccall cleanPutr "R:V:I"
}
cPutParam :: !CParam -> *State -> *State
cPutParam (CI i) = cPuti i
cPutParam (CS s) = cPuts s
cPutParam (CR r) = cPutr r
cSetReturnType_ :: !Int !*State -> *State
cSetReturnType_ i s = code inline {
ccall cleanSetReturnType "I:V:I"
}
cSetReturnType :: !CType -> *State -> *State
cSetReturnType Int = cSetReturnType_ 0
cSetReturnType String = cSetReturnType_ 1
cSetReturnType Real = cSetReturnType_ 2
cCall_ :: !String !*State -> *State
cCall_ f s = code inline {
ccall cleanCall "S:V:I"
}
cGeti :: !*State -> (!Int, !*State)
cGeti s = code inline {
ccall cleanGeti ":I:I"
}
cGets :: !*State -> (!String, !*State)
cGets s = code inline {
ccall cleanGets ":S:I"
}
cGetr :: !*State -> (!Real, !*State)
cGetr s = code inline {
ccall cleanGetr ":R:I"
}
cGetParam :: !CType !*State -> (!CParam, !*State)
cGetParam Int s
# (i,s)=cGeti s
= (CI i, s)
cGetParam String st
# (s,st) = cGets st
= (CS s, st)
cGetParam Real s
# (r,s)=cGetr s
= (CR r, s)
cCall :: !CType !String !a !*State -> (!CParam, !*State) | toCParamList a
cCall t f ps s = cCall` t f (toCParamList ps) s
where
cCall` :: !CType !String ![CParam] !*State -> (!CParam, !*State)
cCall` t f [] s
# s = cSetReturnType t s
# s = cCall_ f s
= cGetParam t s
cCall` t f [p:ps] s
# s = cPutParam p s
= cCall` t f ps s
|
