b49000a · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Support linking external .o files in new compiler

commitb49000a41528f2b44548d0e40c5ccdd91b5b1384 authorEdwin Brady <eb@cs.st-andrews.ac.uk> dateThu 20 Sep 2012, 14:44 (14 years ago) parentef1d7ba

8 files changed+37−23

compare with master

unifiedsplit

contribs/lib/SQLite3/sqlexpr.idr+15−15 contribs/lib/SQLite3/sqlite3api.c+1−1 idris.cabal+1−1 lib/prelude/fin.idr+4 rts/idris_rts.h+1−1 src/IRTS/CodegenC.hs+6−3 src/IRTS/Compiler.hs+8−1 src/IRTS/LParser.hs+1−1

contribs/lib/SQLite3/sqlexpr.idr+15−15

@@ -66,21 +66,21 @@ data SQL = SELECT SelVar SQL Clause

6666 | CREATE SQL (List (Value, ColType , Constr))

6767

6868-- remember to remove these funcs later

69−foldr1 : (a -> a -> a) -> List a -> a

70−foldr1 f [x] = x

71−foldr1 f (x::xs) = f x (foldr1 f xs)

72−

73−

74−unwords' : List (List Char) -> List Char

75−unwords' [] = []

76−unwords' ws = (foldr1 addSpace ws)

77− where

78− addSpace : List Char -> List Char -> List Char

79− addSpace w s = w ++ (' ' :: s)

80−

81−

82−unwords : List String -> String

83−unwords = pack . unwords' . map unpack

69+-- foldr1 : (a -> a -> a) -> List a -> a

70+-- foldr1 f [x] = x

71+-- foldr1 f (x::xs) = f x (foldr1 f xs)

72+

73+

74+-- unwords' : List (List Char) -> List Char

75+-- unwords' [] = []

76+-- unwords' ws = (foldr1 addSpace ws)

77+-- where

78+-- addSpace : List Char -> List Char -> List Char

79+-- addSpace w s = w ++ (' ' :: s)

80+--

81+--

82+-- unwords : List String -> String

83+-- unwords = pack . unwords' . map unpack

8484

8585-----------------------------------------------------------

8686-- | This function replaces values with question mark

contribs/lib/SQLite3/sqlite3api.c+1−1

@@ -267,7 +267,7 @@ const unsigned char* sqlite3_get_val_text(void* p,int nCol){

267267 DBinfo* dbi =(DBinfo*) p;

268268 int rc,i, val, counter;

269269 const unsigned char* text_val;

270− array =(unsigned char *) GC_malloc(1000*sizeof(char));

270+ array =(unsigned char *) malloc(1000*sizeof(char));

271271 text_val =sqlite3_column_text(dbi->ppStmt, nCol);

272272 memcpy(array, text_val, strlen(text_val));

273273 return array;

idris.cabal+1−1

@@ -1,5 +1,5 @@

11Name: idris

2−Version: 0.9.3

2+Version: 0.9.3.1

33License: BSD3

44License-file: LICENSE

55Author: Edwin Brady

lib/prelude/fin.idr+4

@@ -13,3 +13,7 @@ instance Eq (Fin n) where

1313 eq (fS k) (fS k') = eq k k'

1414 eq _ _ = False

1515

16+wkn : Fin n -> Fin (S n)

17+wkn fO = fO

18+wkn (fS k) = fS (wkn k)

19+

rts/idris_rts.h+1−1

@@ -72,7 +72,7 @@ typedef void(*func)(VM*, VAL*);

7272#define GETPTR(x) (((VAL)(x))->info.ptr)

7373#define GETFLOAT(x) (((VAL)(x))->info.f)

7474

75−#define TAG(x) (ISINT(x) ? (-1) : ( (x)->ty == CON ? (x)->info.c.tag : (-1)) )

75+#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( (x)->ty == CON ? (x)->info.c.tag : (-1)) )

7676

7777// Integers, floats and operators

7878

src/IRTS/CodegenC.hs+6−3

@@ -22,10 +22,11 @@ codegenC :: [(Name, SDecl)] ->

2222 String -> -- output file name

2323 Bool -> -- generate executable if True, only .o if False

2424 [FilePath] -> -- include files

25+ String -> -- extra object files

2526 String -> -- extra compiler flags

2627 DbgLevel ->

2728 IO ()

28−codegenC defs out exec incs libs dbg

29+codegenC defs out exec incs objs libs dbg

2930 = do -- print defs

3031 let bc = map toBC defs

3132 let h = concatMap toDecl (map fst bc)

@@ -38,7 +39,9 @@ codegenC defs out exec incs libs dbg

3839 hPutStr tmph cout

3940 hFlush tmph

4041 hClose tmph

41− let gcc = "gcc -x c " ++

42+ let useclang = False

43+ let comp = if useclang then "clang" else "gcc"

44+ let gcc = comp ++ " -I. " ++ objs ++ " -x c " ++

4245 (if exec then "" else " - c ") ++

4346 gccDbg dbg ++

4447 " " ++ tmpn ++

@@ -150,7 +153,7 @@ bcc i (ERROR str) = indent i ++ "fprintf(stderr, " ++ show str ++ "); assert(0);

150153

151154c_irts FInt l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

152155c_irts FChar l x = l ++ "MKINT((i_int)(" ++ x ++ "))"

153−c_irts FString l x = l ++ "MKSTR(" ++ x ++ ")"

156+c_irts FString l x = l ++ "MKSTR(vm, " ++ x ++ ")"

154157c_irts FUnit l x = x

155158c_irts FPtr l x = l ++ "MKPTR(vm, " ++ x ++ ")"

156159c_irts FDouble l x = l ++ "MKFLOAT(vm, " ++ x ++ ")"

src/IRTS/Compiler.hs+8−1

@@ -27,6 +27,9 @@ compileC f tm = do checkMVs

2727 used <- mapM (allNames []) tmnames

2828 defsIn <- mkDecls tm (concat used)

2929 maindef <- irMain tm

30+ objs <- getObjectFiles

31+ libs <- getLibs

32+ hdrs <- getHdrs

3033 let defs = defsIn ++ [(MN 0 "runMain", maindef)]

3134 -- iputStrLn $ showSep "\n" (map show defs)

3235 let (nexttag, tagged) = addTags 0 (liftAll defs)

@@ -36,7 +39,9 @@ compileC f tm = do checkMVs

3639 let checked = checkDefs defuns (toAlist defuns)

3740 case checked of

3841 OK c -> do -- iputStrLn $ showSep "\n" (map show c)

39− liftIO $ codegenC c f True [] "" NONE

42+ liftIO $ codegenC c f True hdrs

43+ (concatMap mkObj objs)

44+ (concatMap mkLib libs) NONE

4045 Error e -> fail $ show e

4146 where checkMVs = do i <- get

4247 case idris_metavars i \\ primDefs of

@@ -45,6 +50,8 @@ compileC f tm = do checkMVs

4550 inDir d h = do let f = d ++ "/" ++ h

4651 ex <- doesFileExist f

4752 if ex then return f else return h

53+ mkObj f = f ++ " "

54+ mkLib l = "-l" ++ l ++ " "

4855

4956irMain :: TT Name -> Idris LDecl

5057irMain tm = do i <- ir tm

src/IRTS/LParser.hs+1−1

@@ -54,7 +54,7 @@ fovm f = do defs <- parseFOVM f

5454 let checked = checkDefs defuns (toAlist defuns)

5555-- print checked

5656 case checked of

57− OK c -> codegenC c "a.out" True ["math.h"] "" TRACE

57+ OK c -> codegenC c "a.out" True ["math.h"] "" "" TRACE

5858 Error e -> fail $ show e

5959

6060parseFOVM :: FilePath -> IO [(Name, LDecl)]