[Fencommits] fenserve: add renderExp' line for Call potions

[Benja Fallenstein]

Wed Jun 13 23:33:24 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add renderExp' line for Call potions
diff -rN -u old-fenserve/fendata/Rendering.hs new-fenserve/fendata/Rendering.hs
--- old-fenserve/fendata/Rendering.hs	2007-06-14 01:11:04.000000000 +0300
+++ new-fenserve/fendata/Rendering.hs	2007-06-14 01:11:04.000000000 +0300
@@ -58,14 +58,14 @@
 varType :: (?db :: DB) => Int -> RenderExp ()
 varType i = ask >>= return . toHTML . renderType . snd . (!! i) >>= tell
 
-varName :: (?db :: DB) => Int -> RenderExp ()
+varName :: (?db :: DB, ?funs :: Map FunId Fun) => Int -> RenderExp ()
 varName i = fmap (!! i) ask >>= \(name,_) -> ren ("'", ital name, "'")
 
 mintVar :: Type -> (Int -> RenderExp a) -> RenderExp a
 mintVar t f = do var <- get; put (var + 1); local (("v"++show var,t):) (f var)
 
 
-class RenderOne a where renderOne :: (?db :: DB) => a -> RenderExp ()
+class RenderOne a where renderOne :: (?db :: DB, ?funs :: Map FunId Fun) => a -> RenderExp ()
     
 instance RenderOne (RenderExp a) where renderOne m = m >> return ()
 instance RenderOne Type where renderOne = renderOne . renderType
@@ -73,16 +73,19 @@
 instance RenderOne (Cx CxExp) where renderOne (Cx (e,cx)) = renderExp' e
 instance ToHTML a => RenderOne a where renderOne x = tell (toHTML x)
 
-class Ren a where ren :: (?db :: DB) => a -> RenderExp ()
+class Ren a where ren :: (?db :: DB, ?funs :: Map FunId Fun) => a -> RenderExp ()
 
 instance Ren () where ren () = return ()
 instance (RenderOne x, Ren xs, Tuple x xs t) => Ren t where
     ren t | (x,xs) <- tsplit1 t = renderOne x >> ren xs
 
 
-renderExp' :: (?db :: DB) => CxExp -> RenderExp ()
+renderExp' :: (?db :: DB, ?funs :: Map FunId Fun) => CxExp -> RenderExp ()
 renderExp' (Var i) = ren ( varType i, " ", varName i )
---renderExp' (Call fun exps) = 
+renderExp' (Call fun exps) = f template exps where
+    f (TCons h x xs) (e:es) = ren (h, e, f xs es)
+    f (TNil h) [] = ren (I h)
+    Fun template _ body = ?funs Map.! fun
 renderExp' (Literal vals) = ren ( I vals )
 renderExp' (GetField field exp) = ren
   ( "the ", fieldName $ getField field, " of ", exp )