1 files changed, 123 insertions, 0 deletions
diff --git a/CleanC.icl b/CleanC.icl
new file mode 100644
index 0000000..8b32c65
--- /dev/null
+++ b/CleanC.icl
@@ -0,0 +1,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
+