Commits

Mattias Lundell  committed b289044

changes in pthreads, switched to new Kindlered.hs

  • Participants
  • Parent commits c2b7c87

Comments (0)

Files changed (8)

File lib/RandomGenerator.t

 --
 -- Copyright 2008-2009 Johan Nordlander <nordland@csee.ltu.se>
 -- All rights reserved.
--- 
+--
 -- Redistribution and use in source and binary forms, with or without
 -- modification, are permitted provided that the following conditions
 -- are met:
--- 
+--
 -- 1. Redistributions of source code must retain the above copyright
 --    notice, this list of conditions and the following disclaimer.
--- 
+--
 -- 2. Redistributions in binary form must reproduce the above copyright
 --    notice, this list of conditions and the following disclaimer in the
 --    documentation and/or other materials provided with the distribution.
--- 
+--
 -- 3. Neither the names of the copyright holder and any identified
---    contributors, nor the names of their affiliations, may be used to 
---    endorse or promote products derived from this software without 
+--    contributors, nor the names of their affiliations, may be used to
+--    endorse or promote products derived from this software without
 --    specific prior written permission.
--- 
+--
 -- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
 -- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 -- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 
 struct Generator a where
   next :: Request a
-  
+
 -- Lehmer/Schrage random number generator. Simple and not too bad.
 -- baseGen generates integers in the range [1..m-1] on 32 bit machines.
 -- The n-th number produced is (seed * a^n) mod m but with calculations organised to avoid overflow.
   r = 2836         -- = m `mod` a
 
   state := seed
-  
+
   next = request
     tmp = a * (state `mod` q) - r * (state `div` q)
     state := if tmp > 0 then tmp else tmp + m
     result state
 
   result Generator{..}
-

File rtsPOSIX/config.log

 configure:3276: result: no
 configure:3148: checking whether pthreads work without any flags
 configure:3246: gcc -o conftest -g -O2 -m32    conftest.c   >&5
-/tmp/ccU4krri.o: In function `main':
+/tmp/ccS7PyBX.o: In function `main':
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:12: undefined reference to `pthread_join'
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:13: undefined reference to `__pthread_register_cancel'
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:14: undefined reference to `pthread_create'
 configure:3153: checking whether pthreads work with -Kthread
 configure:3246: gcc -o conftest -g -O2 -m32 -Kthread   conftest.c   >&5
 gcc: unrecognized option '-Kthread'
-/tmp/ccy17Djy.o: In function `main':
+/tmp/ccCfvsG6.o: In function `main':
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:12: undefined reference to `pthread_join'
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:13: undefined reference to `__pthread_register_cancel'
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:14: undefined reference to `pthread_create'
 configure:3153: checking whether pthreads work with -kthread
 configure:3246: gcc -o conftest -g -O2 -m32 -kthread   conftest.c   >&5
 gcc: unrecognized option '-kthread'
-/tmp/cc6C5UZG.o: In function `main':
+/tmp/cc05uCeg.o: In function `main':
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:12: undefined reference to `pthread_join'
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:13: undefined reference to `__pthread_register_cancel'
 /home/capitrane/timber-llvm/rtsPOSIX/conftest.c:14: undefined reference to `pthread_create'

File rtsPOSIX/rts.c

     gcInit();
     gcThread = newThread(NULL, prio_min, garbageCollector, pagesize);
     newThread(NULL, prio_max, timerHandler, pagesize);
-    
+
     ENABLE(rts);
 }
 
-void new(ADDR* addr, size_t words) { 
+void new(ADDR* addr, size_t words) {
     //printf("New-call: addr=%x words=%x hp=%x\n", (int)addr, (int)words, (int)hp);
     ADDR top,stop;
-    do { 
-        *addr = hp; 
-        stop = lim; 
-        top = (*addr+words); 
+    do {
+        *addr = hp;
+        stop = lim;
+        top = (*addr+words);
     } while (!CAS(*addr,top,&hp));
-    
-    if (top>=stop) { 
+
+    if (top>=stop) {
         *addr = force(words,*addr<stop?*addr:0);
     }
 }

File rtsPOSIX/rts.h

 
 // new does the same thing as the macro NEW but as a callable function
 inline void new(ADDR* addr, size_t bytes);
-//void new(ADDR* addr, size_t bytes) __attribute__((always_inline));
+//void __attribute__((always_inline)) new(ADDR* addr, size_t bytes) ;
 #endif

File src/Execution.hs

 -- Execution control.
 --
 -- This module contains an interface to the backend and functions to
--- control the execution of the compiler. 
+-- control the execution of the compiler.
 --
 ---------------------------------------------------------------------------
 
                   linkO,
                   linkBC
                  ) where
-    
+
 import System (system, exitWith, ExitCode(..))
 import qualified Monad
 import qualified Directory
                putStrLn ("[compiling " ++ ll_file ++ "]")
                execCmd clo cmdLLVMAS
              else return ()
-  where checkUpToDate ll_file bc_file = return False --do 
+  where checkUpToDate ll_file bc_file = return False --do
 -- XXX change this, all files are recomiled each time to prevent name clashes when linking
 --          bc_exists <- Directory.doesFileExist bc_file
 --          if bc_exists then do llvm_time <- Directory.getModificationTime ll_file
 --                       else return False
 
 
--- | Compile a C-file. 
-compileC global_cfg clo c_file = do 
+-- | Compile a C-file.
+compileC global_cfg clo c_file = do
   let o_file = rmSuffix ".c" (rmDirs c_file) ++ ".o"
   res <- checkUpToDate c_file o_file
   if not res then do
                cfg <- fileCfg clo c_file global_cfg
                let cmd = cCompiler cfg
                          ++ " -c " ++ compileFlags cfg
-                         ++ " -I " ++ libDir clo ++ " " 
-                         ++ " -I " ++ includeDir clo 
-                         ++ " -I " ++ rtsDir clo ++ " " 
+                         ++ " -I " ++ libDir clo ++ " "
+                         ++ " -I " ++ includeDir clo
+                         ++ " -I " ++ rtsDir clo ++ " "
                          ++ " -I . "
                          ++ c_file
                execCmd clo cmd
              else return ()
-      where checkUpToDate c_file o_file = do 
+      where checkUpToDate c_file o_file = do
                                    o_exists <- Directory.doesFileExist o_file
                                    if not o_exists then return False
                                                     else do
   cfg <- foldr ((=<<) . fileCfg clo) (return global_cfg) bc_files
   let rootId     = name2str r
       Just rMod = fromMod r
-      initId     = "_init_" ++ modToundSc rMod 
+      initId     = "_init_" ++ modToundSc rMod
       -- link bc_files with libTimber.bc
       cmd1 = llvmLINK cfg ++ " "
              ++ unwords bc_files
              ++ " -adce -mem2reg -std-link-opts -std-compile-opts "
              ++ llvmOptFlags clo ++ " "
              ++ tmp_bcfile
-             ++ " -f -o " 
+             ++ " -f -o "
              ++ tmp_bcfile
       -- compile to native code
-      cmd3 = llvmLLC cfg 
-             ++ tmp_bcfile ++ 
-             " -O3 -filetype=asm -o " 
-             ++ s_file 
-      -- link 
+      cmd3 = llvmLLC cfg
+             ++ tmp_bcfile ++
+             " -filetype=asm -o "
+             ++ s_file
+      -- link
       cmd4 = llvmCLANG cfg
-             ++ " -Wno-implicit-function-declaration"
+             ++ " -Wno-implicit-function-declaration -internalize "
              ++ " -L" ++ rtsDir clo
-             ++ " -O3 -m32 -DPOSIX -pthread"
+             ++ " -m32 -DPOSIX -pthread"
              ++ " -o " ++ outfile clo ++ " "
              ++ s_file
              ++ " -DROOT=" ++ rootId
              ++ " -DROOTINIT=" ++ initId ++ " "
-             ++ rtsMain clo 
-             ++ linkLibs cfg             
+             ++ rtsMain clo
+             ++ linkLibs cfg
   execCmd clo cmd1
   execCmd clo cmd2
   execCmd clo cmd3
                                        ++ compileFlags cfg
                                        ++ " -o " ++ outfile clo ++ " "
                                        ++ unwords o_files ++ " "
-                                       ++ " -L" ++ rtsDir clo ++ " " 
-                                       ++ " -I" ++ includeDir clo ++ " " 
-                                       ++ " -I" ++ libDir clo ++ " " 
-                                       ++ " -I " ++ rtsDir clo ++ " " 
-                                       ++ " -I . "  
+                                       ++ " -L" ++ rtsDir clo ++ " "
+                                       ++ " -I" ++ includeDir clo ++ " "
+                                       ++ " -I" ++ libDir clo ++ " "
+                                       ++ " -I " ++ rtsDir clo ++ " "
+                                       ++ " -I . "
                                        ++ " -DROOT=" ++ rootId ++ " "
                                        ++ " -DROOTINIT=" ++ initId ++ " "
-                                       ++ rtsMain clo 
+                                       ++ rtsMain clo
                                        ++ linkLibs cfg
-                             tr $ cmd
                              execCmd clo cmd
 
 -- | Return with exit code /= 0
 
 execCmd clo cmd       = do Monad.when (isVerbose clo)
                                     (putStrLn ("exec: " ++ show cmd))
-                           exitCode <- system $ cmd     
+                           exitCode <- system $ cmd
                            case exitCode of
                              ExitSuccess -> return ()
                              _           -> stopCompiler

File src/Kindlered.hs

 
 
 -- Convert a binding
-redBind env (x, Fun vs t te c)          = do c <- redCmd env c
-                                             c <- tailOptimize x te c
-                                             return (x, Fun vs t te c)
+redBind env (f, Fun vs t te c)          = do c <- redCmd env c
+                                             c <- tailOptimize f t te c
+                                             return (f, Fun vs t te c)
 redBind env (x, Val t e)                = do e <- redExp env e
                                              return (x, Val t e)
 -- Tail recursion optimization
 
-tailOptimize x te c
-  | isTailRecursive x c                 = do c <- redTailCall x te c
+tailOptimize f t te c
+  | isTailRecursive f c                 = do c <- redTailCall f te c
                                              return (CWhile (ELit (lInt 1)) c (CRaise (ELit (lInt 1))))
-  | otherwise                           = return c
+tailOptimize f t@(TCon (Prim LIST _) [t']) te c
+  | isTailRecModCONS f c                = do x <- newName tempSym
+                                             p <- newName paramSym
+                                             c <- redTailCallModCONS f x p te c
+                                             let c' = CWhile (ELit (lInt 1)) c (CRaise (ELit (lInt 1)))
+                                                 e = ENew (prim CONS) ts [(selA, v0 t'), (selB, v0 t)]
+                                                 v0 t = Val t (ECast t (ELit (lInt 0))) 
+                                                 TCon n ts = t
+                                                 tc = TCon (prim CONS) [t']
+                                             return (cBind [(x,Val tc e)] (cBind [(p,Val tc (EVar x))] c'))
+tailOptimize f t te c                   = return c
 
-isTailRecursive x (CBind False [(_, Val t (ECall y _ _))] (CRet (ENew (Tuple 0 _) _ _)))
-  |t == tUNIT                           = x == y
-isTailRecursive x (CRet (ECall y _ _))  = x == y
-isTailRecursive x (CRun _ c)            = isTailRecursive x c
-isTailRecursive x (CBind _ _ c)         = isTailRecursive x c
-isTailRecursive x (CUpd _ _ c)          = isTailRecursive x c
-isTailRecursive x (CUpdS _ _ _ c)       = isTailRecursive x c
-isTailRecursive x (CUpdA _ _ _ c)       = isTailRecursive x c
-isTailRecursive x (CSwitch _ alts)      = or [isTailRecursiveAlt x a | a <- alts]
-isTailRecursive x (CSeq c1 c2)          = (isTailRecursive x c1) || (isTailRecursive x c2)
-isTailRecursive x (CWhile _ c1 c2)      = isTailRecursive x c2
-isTailRecursive _ _                     =  False
+{-
 
-isTailRecursiveAlt x (ACon _ _ _ c)     = isTailRecursive x c
-isTailRecursiveAlt x (ALit _ c)         = isTailRecursive x c
-isTailRecursiveAlt x (AWild c)          = isTailRecursive x c
+  f (xs) {                         f (xs) {}
+     ...                               while (1) {
+     return f(es)                          ...
+     ...                                   xs = es; continue;
+  }                                        ...
+                                       }
+                                   }
+-}
 
-redTailCall x vs (CBind False [(_, Val t (ECall y ts es))] (CRet (ENew (Tuple 0 _) _ _)))
-  |t == tUNIT && x == y                 = updateParams vs es
-redTailCall x vs (CRet (ECall y ts es))    
-  | x == y                              = updateParams vs es
-redTailCall x vs (CBind r bs c)         = liftM (CBind r bs) (redTailCall x vs c)
-redTailCall x vs (CRun e c)             = liftM (CRun e) (redTailCall x vs c)
-redTailCall x vs (CUpd y e c)           = liftM (CUpd y e) (redTailCall x vs c)
-redTailCall x vs (CUpdS e y v c)        = liftM (CUpdS e y v) (redTailCall x vs c)
-redTailCall x vs (CUpdA e i e' c)       = liftM (CUpdA e i e') (redTailCall x vs c)
-redTailCall x vs (CSwitch e alts)       = liftM (CSwitch e) (mapM (redTailAlt x vs) alts)
-redTailCall x vs (CSeq c c')            = liftM2 CSeq (redTailCall x vs c) (redTailCall x vs c')
-redTailCall x vs (CWhile e c c')        = liftM2 (CWhile e) (redTailCall x vs c) (redTailCall x vs c')
-redTailCall _ _ c                       = return c
+isTailRecursive f (CRet (ECall g _ _))  = f == g
+isTailRecursive f (CRun _ c)            = isTailRecursive f c
+isTailRecursive f (CBind _ _ c)         = isTailRecursive f c
+isTailRecursive f (CUpd _ _ c)          = isTailRecursive f c
+isTailRecursive f (CUpdS _ _ _ c)       = isTailRecursive f c
+isTailRecursive f (CUpdA _ _ _ c)       = isTailRecursive f c
+isTailRecursive f (CSwitch _ alts)      = or [isTailRecursiveAlt f a | a <- alts]
+isTailRecursive f (CSeq c1 c2)          = isTailRecursive f c1 || isTailRecursive f c2
+isTailRecursive f (CWhile _ c1 c2)      = isTailRecursive f c2
+isTailRecursive _ _                     = False
 
-redTailAlt x vs (ACon y us te c)        = liftM (ACon y us te) (redTailCall x vs c)
-redTailAlt x vs (ALit l c)              = liftM (ALit l) (redTailCall x vs c)
-redTailAlt x vs (AWild c)               = liftM AWild (redTailCall x vs c)
+isTailRecursiveAlt f (ACon _ _ _ c)     = isTailRecursive f c
+isTailRecursiveAlt f (ALit _ c)         = isTailRecursive f c
+isTailRecursiveAlt f (AWild c)          = isTailRecursive f c
+
+
+redTailCall f vs (CRet (ECall g _ es))
+  | f == g                              = updateParams vs es
+redTailCall f vs (CBind r bs c)         = liftM (CBind r bs) (redTailCall f vs c)
+redTailCall f vs (CRun e c)             = liftM (CRun e) (redTailCall f vs c)
+redTailCall f vs (CUpd y e c)           = liftM (CUpd y e) (redTailCall f vs c)
+redTailCall f vs (CUpdS e y v c)        = liftM (CUpdS e y v) (redTailCall f vs c)
+redTailCall f vs (CUpdA e i e' c)       = liftM (CUpdA e i e') (redTailCall f vs c)
+redTailCall f vs (CSwitch e alts)       = liftM (CSwitch e) (mapM (redTailAlt f vs) alts)
+redTailCall f vs (CSeq c c')            = liftM2 CSeq (redTailCall f vs c) (redTailCall f vs c')
+redTailCall f vs (CWhile e c c')        = liftM2 (CWhile e) (redTailCall f vs c) (redTailCall f vs c')
+redTailCall f _ c                       = return c
+
+redTailAlt f vs (ACon y us te c)        = liftM (ACon y us te) (redTailCall f vs c)
+redTailAlt f vs (ALit l c)              = liftM (ALit l) (redTailCall f vs c)
+redTailAlt f vs (AWild c)               = liftM AWild (redTailCall f vs c)
 
 updateParams [] []                      = return CCont
 updateParams ((x,t):te) (e:es)
                                              return (CUpd x e c)
 
 
+{-
+
+  f (xs) {                         f (xs) {}
+     ...                               CONS x = CONS(_, _)
+     return NIL                        CONS p = x
+     ...                               while (1) {
+     return CONS(e, f(es))                ...
+     ...                                  p.tl = NIL; return x.tl
+                                          ...
+  }                                       p.tl = CONS(e, _); p = p.tl; xs = es; continue
+                                          ...
+                                       }
+-}
+
+selA                                    = head abcSupply
+selB                                    = head (tail abcSupply)
+
+isTailRecModCONS f (CRet (ECast _ (ENew (Prim CONS _) _ bs)))
+  | Just (Val _ (ECall g _ _)) <- lookup selB bs
+                                        = f == g
+isTailRecModCONS f (CRet (ECast _ (ENew (Prim NIL _) _ [])))
+                                        = True
+isTailRecModCONS f (CRet (ECall (Prim Raise _) _ _))
+                                        = True
+isTailRecModCONS f (CRun _ c)           = isTailRecModCONS f c
+isTailRecModCONS f (CBind _ _ c)        = isTailRecModCONS f c
+isTailRecModCONS f (CUpd _ _ c)         = isTailRecModCONS f c
+isTailRecModCONS f (CUpdS _ _ _ c)      = isTailRecModCONS f c
+isTailRecModCONS f (CUpdA _ _ _ c)      = isTailRecModCONS f c
+isTailRecModCONS f (CSwitch _ alts)     = and [isTailRecModCONSAlt f a | a <- alts]
+isTailRecModCONS f (CSeq c1 c2)         = isTailRecModCONS f c1 && isTailRecModCONS f c2
+isTailRecModCONS f (CWhile _ c1 c2)     = isTailRecModCONS f c2
+isTailRecModCONS f (CBreak)             = True
+isTailRecModCONS f (CCont)              = True
+isTailRecModCONS f (CRaise _)           = True
+isTailRecModCONS _ _                    = False
+
+isTailRecModCONSAlt f (ACon _ _ _ c)    = isTailRecModCONS f c
+isTailRecModCONSAlt f (ALit _ c)        = isTailRecModCONS f c
+isTailRecModCONSAlt f (AWild c)         = isTailRecModCONS f c
+
+
+redTailCallModCONS f x p vs (CRet (ECast t (ENew (Prim CONS _) ts bs)))
+  | Just (Val _ (ECall g _ es)) <- lookup selB bs
+                                                = do c <- updateParams vs es
+                                                     return (CUpdS (EVar p) selB e (CUpd p (ESel (EVar p) selB) c))
+  where e                                       = ECast t (ENew (prim CONS) ts [(selA,lookup' bs selA),(selB,Val t e')])
+        e'                                      = ECast t (ELit (lInt 0))
+redTailCallModCONS f x p vs (CRet e@(ECast _ (ENew (Prim NIL _) _ [])))
+                                                = return (CUpdS (EVar p) selB e (CRet (ESel (EVar x) selB)))
+redTailCallModCONS f x p vs (CBind r bs c)      = liftM (CBind r bs) (redTailCallModCONS f x p vs c)
+redTailCallModCONS f x p vs (CRun e c)          = liftM (CRun e) (redTailCallModCONS f x p vs c)
+redTailCallModCONS f x p vs (CUpd y e c)        = liftM (CUpd y e) (redTailCallModCONS f x p vs c)
+redTailCallModCONS f x p vs (CUpdS e y v c)     = liftM (CUpdS e y v) (redTailCallModCONS f x p vs c)
+redTailCallModCONS f x p vs (CUpdA e i e' c)    = liftM (CUpdA e i e') (redTailCallModCONS f x p vs c)
+redTailCallModCONS f x p vs (CSwitch e alts)    = liftM (CSwitch e) (mapM (redTailCallModCONSAlt f x p vs) alts)
+redTailCallModCONS f x p vs (CSeq c c')         = liftM2 CSeq (redTailCallModCONS f x p vs c) (redTailCallModCONS f x p vs c')
+redTailCallModCONS f x p vs (CWhile e c c')     = liftM2 (CWhile e) (redTailCallModCONS f x p vs c) (redTailCallModCONS f x p vs c')
+redTailCallModCONS f x p _ c                    = return c
+
+redTailCallModCONSAlt f x p vs (ACon y us te c) = liftM (ACon y us te) (redTailCallModCONS f x p vs c)
+redTailCallModCONSAlt f x p vs (ALit l c)       = liftM (ALit l) (redTailCallModCONS f x p vs c)
+redTailCallModCONSAlt f x p vs (AWild c)        = liftM AWild (redTailCallModCONS f x p vs c)
+
 
 single x e                              = length (filter (==x) (evars e)) == 1
 
   where constElems (ENew (Prim CONS _) _ bs)
                                     = do es <- constElems eb
                                          return (ea:es)
-          where Val _ ea            = lookup' bs (head abcSupply)
-                Val _ eb            = lookup' bs (head (tail abcSupply))
+          where Val _ ea            = lookup' bs selA
+                Val _ eb            = lookup' bs selB
         constElems (ENew (Prim NIL _) _ bs)
                                     = Just []
         constElems _                = Nothing
 import Data.List.Split (chunk)
 import Numeric
 
-data LLVMCallingConvention = Cc | Fastcc | Coldcc
-                              
+data LLVMCallingConvention = Cc | Fastcc
+
 instance Show LLVMCallingConvention where
     show Cc     = "cc"
     show Fastcc = "fastcc"
-    show Coldcc  = "coldcc"
 
 data LLVMVisibilityStyle = Default | Hidden | Protected
 
 instance Show LLVMVisibilityStyle where
     show Default   = "default"
     show Hidden    = "hidden"
-    show Protected = "protected" 
+    show Protected = "protected"
 
-data LLVMLinkage = Private 
-                 | LinkerPrivate 
-                 | Internal 
+data LLVMLinkage = Private
+                 | LinkerPrivate
+                 | Internal
                  | AvailableExternally
-                 | Linkonce 
-                 | Weak 
-                 | Common 
-                 | Appending 
+                 | Linkonce
+                 | Weak
+                 | Common
+                 | Appending
                  | ExternWeak
-                 | LinkonceOdr 
+                 | LinkonceOdr
                  | WeakOdr
                  | External
                  | Global   -- not a real linkage
     show Internal            = "internal"
     show AvailableExternally = "available_externally"
     show Linkonce            = "linkonce"
-    show Weak                = "weak" 
+    show Weak                = "weak"
     show Common              = "common"
     show Appending           = "appending"
     show ExternWeak          = "extern_weak"
     show External            = "external"
     show Global              = "global"   -- not a real linkage
     show Constant            = "constant" -- not a real linkage
-                 
+
 data LLVMType = Tint Int
               | Tfloat
               | Tdouble
     show Tfloat              = "float"
     show Tdouble             = "double"
     show (Tptr typ)          = show typ ++ "*"
-    show (Tarray nelem typ)  = "[" ++ show nelem ++ " x " ++ show typ ++ "]" 
+    show (Tarray nelem typ)  = "[" ++ show nelem ++ " x " ++ show typ ++ "]"
     show Tvoid               = "void"
     show (Tstruct sname)     = '%' : sname
     show Topaque             = "opaque"
-    show (Tvector nelem typ) = "<" ++ show nelem ++ " x " ++ show typ ++ ">" 
-    show (Tunion typs)       = 
+    show (Tvector nelem typ) = "<" ++ show nelem ++ " x " ++ show typ ++ ">"
+    show (Tunion typs)       =
         "union {" ++ intercalate ", " (map show typs) ++ "}"
-    show (Tfun rettyp args)  = 
-        show rettyp ++ " (" ++ intercalate ", " (map show args) ++ ")" 
+    show (Tfun rettyp args)  =
+        show rettyp ++ " (" ++ intercalate ", " (map show args) ++ ")"
 
 data LLVMParameterAttribute = Zeroext
                             | Signext
                             | Nocapture
                             | Nest
 
-instance Show LLVMParameterAttribute where                            
+instance Show LLVMParameterAttribute where
     show Zeroext   = "zeroext"
     show Signext   = "signext"
     show Inreg     = "inreg"
     show Naked           = "naked"
 
 data LLVMGlobalInitializer = Zeroinitializer | Null deriving (Eq)
-                             
+
 instance Show LLVMGlobalInitializer where
     show Zeroinitializer = "zeroinitializer"
     show Null            = "null"
 getTyp (LLVMConstant typ _) = typ
 
 showWtyp :: LLVMValue -> String
-showWtyp (LLVMRegister typ reg (TagGlobal _ _)) = 
+showWtyp (LLVMRegister typ reg (TagGlobal _ _)) =
     show typ ++ " @" ++ reg
-showWtyp (LLVMRegister typ reg TagLocal) = 
+showWtyp (LLVMRegister typ reg TagLocal) =
     show typ ++ " %" ++ reg
-showWtyp (LLVMConstant Tvoid _)   = "void"  
+showWtyp (LLVMConstant Tvoid _)   = "void"
 showWtyp (LLVMConstant typ const) = show typ ++ " " ++ show const
 
 showWOtyp :: LLVMValue -> String
                 | NullConst
                   deriving (Eq)
 
-instance Show ConstValue where 
+instance Show ConstValue where
     show (IntConst i)      = show i
     show (FloatConst f)    = "0x" ++ toHex (fromRational f :: Float)
     show (CharConst c)     = show.ord $ c
       mantissa = zpad 52 f
       f = if (head.fst $ tup) == 1 then tail.fst $ tup else fst tup
       s = snd tup
-      zpad n xs = take n $ xs ++ repeat 0 
+      zpad n xs = take n $ xs ++ repeat 0
       padz n xs = reverse.zpad n $ reverse xs
       tup = floatToDigits 2 (abs num)
       fromBase b ds = foldl' (\n k -> n * b + k) 0 ds
 
 digits :: Integral n => n -> n -> [n]
 digits base = reverse.digitsRev base
-              where 
+              where
                 digitsRev base i = case i of
                                      0 -> []
                                      _ -> lastDigit : digitsRev base rest
                                          where (rest, lastDigit) = quotRem i base
 
 -- =============================================================================
--- COMPARING 
+-- COMPARING
 -- =============================================================================
 
-data IcmpArg = IcmpEQ  
-             | IcmpNE 
-             | IcmpUGT 
-             | IcmpUGE 
-             | IcmpULT 
-             | IcmpULE 
-             | IcmpSGT 
-             | IcmpSGE 
-             | IcmpSLT 
+data IcmpArg = IcmpEQ
+             | IcmpNE
+             | IcmpUGT
+             | IcmpUGE
+             | IcmpULT
+             | IcmpULE
+             | IcmpSGT
+             | IcmpSGE
+             | IcmpSLT
              | IcmpSLE
                deriving (Eq)
 
 -- =============================================================================
 -- INSTRUCTIONS
 -- =============================================================================
-     
+
 data LLVMInstruction where
     Add  :: LLVMValue -> LLVMValue -> LLVMValue -> LLVMInstruction
     Fadd :: LLVMValue -> LLVMValue -> LLVMValue -> LLVMInstruction
     Fptrunc  :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction
     Fpext    :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction
     Fptoui   :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction
-    Fptosi   :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction    
+    Fptosi   :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction
     Uitofp   :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction
     Sitofp   :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction
     Ptrtoint :: LLVMValue -> LLVMValue -> LLVMType -> LLVMInstruction

File src/LLVMKindle.hs

   fds  <- cgmGets cgmEFunctions
   cs   <- cgmGets cgmConstants
   fs   <- cgmGets cgmLFunctions
-  return $ LLVMModule name (Map.elems td) (filterLocalGC gs cs) 
+  return $ LLVMModule name (Map.elems td) (filterLocalGC gs cs)
             (DL.toList fds) (Map.elems cs) (DL.toList fs)
          where
            -- remove local gcinfo from globals
-           filterLocalGC gs cs = 
-               Map.elems (Map.filterWithKey 
+           filterLocalGC gs cs =
+               Map.elems (Map.filterWithKey
                           (\x _ -> x `notElem` localGC cs) gs)
            -- get keys of all local gcinfo
-           localGC cs = Map.keys . Map.filterWithKey 
+           localGC cs = Map.keys . Map.filterWithKey
                         (\x _ -> "__GC__" `isPrefixOf` x) $ cs
 
 getFunType :: String -> CodeGen LLVMType
 
 getString :: String -> CodeGen LLVMValue
 getString s = do
-  cs <- cgmGets cgmConstants 
+  cs <- cgmGets cgmConstants
   (LLVMTopLevelConstant reg _ _) <- lookup s cs
   getarrayelemptr [intConst 0] reg
 
 getLocalGC :: String -> CodeGen LLVMValue
-getLocalGC styp = do 
+getLocalGC styp = do
     cs <- cgmGets cgmConstants
     (LLVMTopLevelConstant reg _ _) <- lookup styp cs
     return reg
   cgmModify (\s -> s { cgmLFunctions = DL.snoc (cgmLFunctions s) fun })
 
 addGlobalVar :: String -> LLVMValue -> CodeGen ()
-addGlobalVar name reg  = 
+addGlobalVar name reg =
     cgmModify (\s -> s { cgmGlobals = Map.insert name reg (cgmGlobals s) })
 
 getNextLabel :: CodeGen LLVMLabel
   return $ Label label
 
 emit :: LLVMInstruction -> CodeGen ()
-emit c = cgfModify (\s -> s { cgfCode = DL.snoc (cgfCode s) c }) 
+emit c = cgfModify (\s -> s { cgfCode = DL.snoc (cgfCode s) c })
 
 setMname :: String -> CodeGen ()
 setMname n = cgmModify (\s -> s {cgmName = n})
 addExternalFun name rettyp argtyps = do
   let funtyp  = Tfun rettyp argtyps
       fundecl = LLVMFunctionDecl [] name funtyp
-  cgmModify (\s -> s { cgmFunEnv = Map.insert name funtyp (cgmFunEnv s) }) 
+  cgmModify (\s -> s { cgmFunEnv = Map.insert name funtyp (cgmFunEnv s) })
   cgmModify (\s -> s { cgmEFunctions = DL.snoc (cgmEFunctions s) fundecl })
 
 addExternalGC :: String -> LLVMType -> CodeGen ()
 dropBreakLabel = cgfModify (\s -> s { cgfBreakLabel = tail (cgfBreakLabel s) })
 
 addVar :: String -> LLVMValue -> CodeGen ()
-addVar var reg = 
+addVar var reg =
     modify (\s -> s { cgfVarEnv = Map.insert var reg (cgfVarEnv s) })
 
 getVar :: String -> CodeGen LLVMValue
 -- =============================================================================
 
 calcStructSize [] = return 0
-calcStructSize ((_,typ):rest) = do 
-  size <- typeSize typ 
-  rest <- calcStructSize rest 
+calcStructSize ((_,typ):rest) = do
+  size <- typeSize typ
+  rest <- calcStructSize rest
   return $ size + rest
 
 words :: Int -> Int