Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Generating a .h, to allow calling from C

Ignore-this: 99212c7606b54faf200084496d8b2570
$ epic -c foo.e -o foo.o         # compile epic code
$ gcc -c testfoo.c -o testfoo.o  # compile C program which calls epic
$ epic -extmain foo.o testfoo.o  # link everything

-extmain means the main program is in a .o not built by epic.

Functions to export should be prefaced by 'export "cname"', where cname is
the name you want for the exported function.

darcs-hash:20090826105743-6ac22-deeebc21063ab2c00bb6550fa4d258e5411a463f.gz
  • Loading branch information...
commit 6e78b711ffcb11e65432592fb54e23d4035ac256 1 parent 01ebbaa
eb authored
View
89 Epic/CodegenC.lhs
@@ -14,9 +14,13 @@
> workers ctxt decs
> -- ++ mainDriver
+> codegenH :: String -> [Decl] -> String
+> codegenH guard ds = "#ifndef _" ++ guard ++ "_H\n#define _" ++ guard ++ "_H\n\n" ++
+> concat (map exportH ds) ++ "\n\n#endif"
+
> writeIFace :: [Decl] -> String
> writeIFace [] = ""
-> writeIFace ((Decl name ret (Bind args _ _)):xs) =
+> writeIFace ((Decl name ret (Bind args _ _) _):xs) =
> "extern " ++ showC name ++ " ("++ showextargs (args) ++ ")" ++
> " -> " ++ show ret ++ "\n" ++ writeIFace xs
> writeIFace (_:xs) = writeIFace xs
@@ -38,8 +42,12 @@
> showargs [x] i = showarg x i
> showargs (x:xs) i = showarg x i ++ ", " ++ showargs xs (i+1)
+> showlist [] = ""
+> showlist [x] = x
+> showlist (x:xs) = x ++ ", " ++ showlist xs
+
> headers [] = ""
-> headers ((Decl fname ret (Bind args _ _)):xs) =
+> headers ((Decl fname ret (Bind args _ _) _):xs) =
> "void* " ++ thunk fname ++ "(void** block);\n" ++
> "void* " ++ quickcall fname ++ "(" ++ showargs args 0 ++ ");\n" ++
> headers xs
@@ -52,7 +60,7 @@
> headers (_:xs) = headers xs
> wrappers [] = ""
-> wrappers ((Decl fname ret (Bind args _ _)):xs) =
+> wrappers ((Decl fname ret (Bind args _ _) _):xs) =
> "void* " ++ thunk fname ++ "(void** block) {\n return " ++
> quickcall fname ++ "(" ++
> wrapperArgs (length args) ++ ");\n}\n\n" ++
@@ -64,10 +72,10 @@
> wrapperArgs x = wrapperArgs (x-1) ++ ", block[" ++ show (x-1) ++ "]"
> workers _ [] = ""
-> workers ctxt ((Decl fname ret func@(Bind args locals defn)):xs) =
+> workers ctxt (decl@(Decl fname ret func@(Bind args locals defn) _):xs) =
> -- trace (show fname ++ ": " ++ show defn) $
> "void* " ++ quickcall fname ++ "(" ++ showargs args 0 ++ ") {\n" ++
-> compileBody (compile ctxt fname func) ++ "\n}\n\n" ++
+> compileBody (compile ctxt fname func) ++ "\n}\n\n" ++ exportC decl ++
> workers ctxt xs
> workers ctxt (_:xs) = workers ctxt xs
@@ -211,18 +219,36 @@
> foreignArgs [x] = foreignArg x
> foreignArgs (x:xs) = foreignArg x ++ ", " ++ foreignArgs xs
+> cToEpic var TyString = "MKSTR((char*)(" ++ var ++ "))"
+> cToEpic var TyInt = "MKINT((int)(" ++ var ++ "))"
+> cToEpic var TyPtr = "MKPTR(" ++ var ++ ")"
+> cToEpic var TyBigInt = "MKBIGINT((mpz_t*)(" ++ var ++ "))"
+> cToEpic var TyUnit = "NULL"
+> cToEpic var _ = "(void*)(" ++ var ++")"
+
> castFrom t TyUnit x = tmp t ++ " = NULL; " ++ x
-> castFrom t TyString rest = tmp t ++ " = MKSTR((char*)(" ++ rest ++ "))"
-> castFrom t TyPtr rest = tmp t ++ " = MKPTR(" ++ rest ++ ")"
-> castFrom t TyInt rest = tmp t ++ " = MKINT((int)(" ++ rest ++ "))"
-> castFrom t TyBigInt rest = tmp t ++ " = MKBIGINT((mpz_t*)(" ++ rest ++ "))"
-> castFrom t _ rest = tmp t ++ " = (void*)(" ++ rest ++ ")"
-
-> foreignArg (t, TyInt) = "GETINT("++ tmp t ++")"
-> foreignArg (t, TyBigInt) = "*(GETBIGINT("++ tmp t ++"))"
-> foreignArg (t, TyString) = "GETSTR("++ tmp t ++")"
-> foreignArg (t, TyPtr) = "GETPTR("++ tmp t ++")"
-> foreignArg (t, _) = tmp t
+> castFrom t ty rest = tmp t ++ " = " ++ cToEpic rest ty
+
+
+ castFrom t TyString rest = tmp t ++ " = MKSTR((char*)(" ++ rest ++ "))"
+ castFrom t TyPtr rest = tmp t ++ " = MKPTR(" ++ rest ++ ")"
+ castFrom t TyInt rest = tmp t ++ " = MKINT((int)(" ++ rest ++ "))"
+ castFrom t TyBigInt rest = tmp t ++ " = MKBIGINT((mpz_t*)(" ++ rest ++ "))"
+ castFrom t _ rest = tmp t ++ " = (void*)(" ++ rest ++ ")"
+
+> epicToC t TyInt = "GETINT("++ t ++")"
+> epicToC t TyBigInt = "*(GETBIGINT("++ t ++"))"
+> epicToC t TyString = "GETSTR("++ t ++")"
+> epicToC t TyPtr = "GETPTR("++ t ++")"
+> epicToC t _ = t
+
+> foreignArg (t, ty) = epicToC (tmp t) ty
+
+ foreignArg (t, TyInt) = "GETINT("++ tmp t ++")"
+ foreignArg (t, TyBigInt) = "*(GETBIGINT("++ tmp t ++"))"
+ foreignArg (t, TyString) = "GETSTR("++ tmp t ++")"
+ foreignArg (t, TyPtr) = "GETPTR("++ tmp t ++")"
+ foreignArg (t, _) = tmp t
> doOp t Plus l r = tmp t ++ " = INTOP(+,"++tmp l ++ ", "++tmp r++");"
> doOp t Minus l r = tmp t ++ " = INTOP(-,"++tmp l ++ ", "++tmp r++");"
@@ -234,3 +260,34 @@
> doOp t OpGE l r = tmp t ++ " = INTOP(>=,"++tmp l ++ ", "++tmp r++");"
> doOp t OpLE l r = tmp t ++ " = INTOP(<=,"++tmp l ++ ", "++tmp r++");"
+Write out code for an export
+
+> cty TyInt = "int"
+> cty TyChar = "char"
+> cty TyBool = "int"
+> cty TyString = "char*"
+> cty TyUnit = "void"
+> cty _ = "void*"
+
+> ctys [] = ""
+> ctys [x] = ctyarg x
+> ctys (x:xs) = ctyarg x ++ ", " ++ ctys xs
+
+> ctyarg (n,ty) = cty ty ++ " " ++ showuser n
+
+> exportC :: Decl -> String
+> exportC (Decl nm rt (Bind args _ _) (Just cname)) =
+> cty rt ++ " " ++ cname ++ "(" ++ ctys args ++ ") {\n\t" ++
+> if (rt==TyUnit) then "" else "return " ++
+> epicToC (quickcall nm ++ "(" ++ showlist (map conv args) ++ ")") rt ++
+> ";\n\n" ++
+> "}"
+> where conv (nm, ty) = cToEpic (showuser nm) ty
+> exportC _ = ""
+
+... and in the header file
+
+> exportH :: Decl -> String
+> exportH (Decl nm rt (Bind args _ _) (Just cname)) =
+> cty rt ++ " " ++ cname ++ "(" ++ ctys args ++ ");\n"
+> exportH _ = ""
View
24 Epic/Compiler.lhs
@@ -20,6 +20,7 @@ Brings everything together; parsing, checking, code generation
> import System.IO
> import System.Directory
> import System.Environment
+> import Char
> import Epic.Language
> import Epic.Parser
@@ -33,6 +34,7 @@ Brings everything together; parsing, checking, code generation
> | Trace -- ^ Generate trace at run-time (debug)
> | ShowBytecode -- ^ Show generated code
> | ShowParseTree -- ^ Show parse tree
+> | MakeHeader FilePath -- ^ Output a .h file too
> | GCCOpt String -- ^ Extra GCC option
> deriving Eq
@@ -41,6 +43,11 @@ Brings everything together; parsing, checking, code generation
> addGCC ((GCCOpt s):xs) = s ++ " " ++ addGCC xs
> addGCC (_:xs) = addGCC xs
+> outputHeader :: [CompileOptions] -> Maybe FilePath
+> outputHeader [] = Nothing
+> outputHeader ((MakeHeader f):_) = Just f
+> outputHeader (_:xs) = outputHeader xs
+
> doTrace opts | elem Trace opts = " -DTRACEON"
> | otherwise = ""
@@ -70,7 +77,8 @@ Chop off everything after the last / - get the directory a file is in
> Failure err _ _ -> fail err
> Success ds -> do
> (tmpn,tmph) <- tempfile
-> checked <- compileDecls (checkAll ds) tmph
+> let hdr = outputHeader opts
+> checked <- compileDecls (checkAll ds) tmph hdr
> fp <- getDataFileName "evm/closure.h"
> let libdir = trimLast fp
> let cmd = "gcc -c -O2 -foptimize-sibling-calls -x c " ++ tmpn ++ " -I" ++ libdir ++ " -o " ++ outf ++ " " ++ addGCC opts ++ doTrace opts
@@ -94,20 +102,26 @@ Chop off everything after the last / - get the directory a file is in
> (stem,_) -> stem
-> compileDecls (Success (ctxt, decls)) outh
+> compileDecls (Success (ctxt, decls)) outh hdr
> = do hPutStr outh $ codegenC ctxt decls
+> case hdr of
+> Just fpath ->
+> do let hout = codegenH (filter isAlpha (map toUpper (getRoot fpath))) decls
+> writeFile fpath hout
+> Nothing -> return ()
> hFlush outh
> hClose outh
> return decls
-> compileDecls (Failure err _ _) _ = fail err
+> compileDecls (Failure err _ _) _ _ = fail err
> -- |Link a collection of .o files into an executable
> link :: [FilePath] -- ^ Object files
> -> [FilePath] -- ^ Extra include files for main program
> -> FilePath -- ^ Executable filename
+> -> Bool -- ^ Generate a 'main' (False if externally defined)
> -> IO ()
-> link infs extraIncs outf = do
-> mainprog <- mkMain extraIncs
+> link infs extraIncs outf genmain = do
+> mainprog <- if genmain then mkMain extraIncs else return ""
> fp <- getDataFileName "evm/closure.h"
> let libdir = trimLast fp
> let cmd = "gcc -x c -O2 -foptimize-sibling-calls " ++ mainprog ++ " -x none -L" ++
View
7 Epic/Language.lhs
@@ -120,15 +120,14 @@ Programs
> data Decl = Decl { fname :: Name,
> frettype :: Type,
-> fdef :: Func }
+> fdef :: Func,
+> fexport :: Maybe String -- C name
+> }
> | Extern { fname :: Name,
> frettype :: Type,
> fargs :: [Type] }
> | Include String
> | Link String
-> | Export { cname :: Name,
-> fname :: Name,
-> export_args :: [(Name, Name)] }
> | CType Name
> deriving Show
View
11 Epic/Parser.y
@@ -123,12 +123,15 @@ Type : inttype { TyInt }
| funtype { TyFun }
Declaration :: { Decl }
-Declaration: name '(' TypeList ')' arrow Type '=' Expr
- { mkBind $1 (map snd $3) $6 (map fst $3) $8 }
+Declaration: Export name '(' TypeList ')' arrow Type '=' Expr
+ { mkBind $2 (map snd $4) $7 (map fst $4) $9 $1 }
| extern name '(' TypeList ')' arrow Type
{ mkExtern $2 (map snd $4) $7 (map fst $4) }
| cinclude string { Include $2 }
+Export :: { Maybe String }
+Export : { Nothing }
+ | export string { Just $2 }
TypeList :: { [(Name,Type)] }
TypeList : { [] }
@@ -211,8 +214,8 @@ File :: { String }
{
-mkBind :: Name -> [Type] -> Type -> [Name] -> Expr -> Decl
-mkBind n tys ret ns expr = Decl n ret (Bind (zip ns tys) 0 expr)
+mkBind :: Name -> [Type] -> Type -> [Name] -> Expr -> Maybe String -> Decl
+mkBind n tys ret ns expr export = Decl n ret (Bind (zip ns tys) 0 expr) export
mkExtern :: Name -> [Type] -> Type -> [Name] -> Decl
mkExtern n tys ret ns = Extern n ret tys
View
6 Epic/Scopecheck.lhs
@@ -13,16 +13,16 @@ checking we do (for now).
> ds <- ca (mkContext xs) xs
> return (ctxt,ds)
> where ca ctxt [] = return []
-> ca ctxt ((Decl nm rt fn):xs) =
+> ca ctxt ((Decl nm rt fn exp):xs) =
> do fn' <- scopecheck ctxt fn
> xs' <- ca ctxt xs
-> return $ (Decl nm rt fn'):xs'
+> return $ (Decl nm rt fn' exp):xs'
> ca ctxt (x:xs) =
> do xs' <- ca ctxt xs
> return (x:xs')
> mkContext [] = []
-> mkContext ((Decl nm rt (Bind args _ _)):xs) =
+> mkContext ((Decl nm rt (Bind args _ _) _):xs) =
> (nm,(map snd args, rt)):(mkContext xs)
> mkContext ((Extern nm rt args):xs) =
> (nm,(args, rt)):(mkContext xs)
View
11 compiler/Main.lhs
@@ -15,10 +15,11 @@
> copts <- getCOpts opts
> extras <- getExtra opts
> if ((length ofiles) > 0 && (not (elem Obj opts)))
-> then link (ofiles ++ copts) extras outfile
+> then link (ofiles ++ copts) extras outfile (not (elem ExtMain opts))
> else return ()
> where mkOpts (KeepInt:xs) = KeepC:(mkOpts xs)
> mkOpts (TraceOn:xs) = Trace:(mkOpts xs)
+> mkOpts (Header f:xs) = MakeHeader f:(mkOpts xs)
> mkOpts (_:xs) = mkOpts xs
> mkOpts [] = []
@@ -42,6 +43,10 @@
> isDotE (_:xs) = isDotE xs
> isDotE [] = False
+> isDotC ('.':'c':[]) = True
+> isDotC (_:xs) = isDotC xs
+> isDotC [] = False
+
> isDotO ('.':'o':[]) = True
> isDotO (_:xs) = isDotO xs
> isDotO [] = False
@@ -70,8 +75,10 @@
> | Obj -- Just make the .o, don't link
> | File String -- File to send the compiler
> | Output String -- Output filename
+> | Header String -- Header output filename
> | ExtraInc String -- extra files to inlude
> | COpt String -- option to send straight to gcc
+> | ExtMain -- external main (i.e. in a .o)
> deriving Eq
> parseArgs :: [String] -> [Option]
@@ -79,7 +86,9 @@
> parseArgs ("-keepc":args) = KeepInt:(parseArgs args)
> parseArgs ("-trace":args) = TraceOn:(parseArgs args)
> parseArgs ("-c":args) = Obj:(parseArgs args)
+> parseArgs ("-extmain":args) = ExtMain:(parseArgs args)
> parseArgs ("-o":name:args) = (Output name):(parseArgs args)
+> parseArgs ("-h":name:args) = (Header name):(parseArgs args)
> parseArgs ("-i":inc:args) = (ExtraInc inc):(parseArgs args)
> parseArgs (('$':x):args) = (COpt (x ++ concat (map (" "++) args))):[]
> parseArgs (('-':x):args) = (COpt x):(parseArgs args)
View
12 evm/closure.h
@@ -13,13 +13,13 @@
#include <stdio.h>
#include <stdlib.h>
-//#define EMALLOC GC_MALLOC
-//#define EREALLOC GC_REALLOC
-//#define EFREE GC_FREE
+#define EMALLOC GC_MALLOC
+#define EREALLOC GC_REALLOC
+#define EFREE GC_FREE
-#define EMALLOC malloc
-#define EREALLOC realloc
-#define EFREE free
+//#define EMALLOC malloc
+//#define EREALLOC realloc
+//#define EFREE free
#define MKCON (con*)EMALLOC(sizeof(con))
#define MKFUN (fun*)EMALLOC(sizeof(fun))
View
6 examples/intthing.e
@@ -1,7 +1,7 @@
include "Prelude.e"
-main () -> Unit =
- printInt(foo(10))
+-- main () -> Unit =
+-- printInt(foo(10))
-foo (x:Int) -> Int =
+export "foo" foo (x:Int) -> Int =
if x<=0 then 1 else x*foo(x-1)
Please sign in to comment.
Something went wrong with that request. Please try again.