Permalink
Browse files

Various tweaks and bug fixes, plus lazy foreign calls

Ignore-this: b1f3cd63f71dc7137dbf0083c16879a3

darcs-hash:20090720223740-6ac22-344316c3c7df326f9ad962e2d4469d2aec3a07a4.gz
  • Loading branch information...
eb
eb committed Jul 20, 2009
1 parent 2546ded commit d22f857a6020a4417326223e648e4d2aaf757a47
Showing with 51 additions and 11 deletions.
  1. +4 −0 Epic/Bytecode.lhs
  2. +5 −0 Epic/Language.lhs
  3. +4 −0 Epic/Lexer.lhs
  4. +6 −0 Epic/Parser.y
  5. +3 −0 Epic/Scopecheck.lhs
  6. +2 −2 Makefile
  7. +5 −4 epic.cabal
  8. +7 −3 evm/closure.h
  9. +8 −2 evm/stdfuns.c
  10. +1 −0 evm/stdfuns.h
  11. +6 −0 lib/Prelude.e
View
@@ -138,6 +138,10 @@ place.
> (argcode, argregs) <- ecomps args vs
> let evalcode = map EVAL argregs
> return $ argcode ++ evalcode ++ [FOREIGN ty reg fn (zip argregs types)]
+> ecomp tcall (LazyForeignCall ty fn argtypes) reg vs = do
+> let (args,types) = unzip argtypes
+> (argcode, argregs) <- ecomps args vs
+> return $ argcode ++ [FOREIGN ty reg fn (zip argregs types)]
> ecomps :: [Expr] -> Int -> State CompileState (Bytecode, [TmpVar])
> ecomps e vs = ecomps' [] [] e vs
View
@@ -88,6 +88,7 @@ Get the arity of a definition in the context
> | Error String -- Exit with error message
> | Impossible -- Claimed impossible to reach code
> | ForeignCall Type String [(Expr, Type)] -- Foreign function call
+> | LazyForeignCall Type String [(Expr, Type)] -- Foreign function call
> deriving (Show, Eq)
> data CaseAlt = Alt { alt_tag :: Tag,
@@ -123,6 +124,10 @@ Programs
> fargs :: [Type] }
> | Include String
> | Link String
+> | Export { cname :: Name,
+> fname :: Name,
+> export_args :: [(Name, Name)] }
+> | CType Name
> deriving Show
> data Result r = Success r
View
@@ -86,6 +86,8 @@
> | TokenUnit
> | TokenCon
> | TokenDefault
+> | TokenExport
+> | TokenCType
> | TokenLet
> | TokenCase
> | TokenOf
@@ -224,6 +226,8 @@
> ("impossible",rest) -> cont TokenImpossible rest
> ("foreign",rest) -> cont TokenForeign rest
> -- declarations
+> ("export",rest) -> cont TokenExport rest
+> ("ctype",rest) -> cont TokenCType rest
> ("extern",rest) -> cont TokenExtern rest
> ("include",rest) -> cont TokenInclude rest
> (var,rest) -> cont (mkname var) rest
View
@@ -75,6 +75,8 @@ import Epic.Lexer
arrow { TokenArrow }
cinclude { TokenCInclude }
extern { TokenExtern }
+ export { TokenExport }
+ ctype { TokenCType }
include { TokenInclude }
%nonassoc NONE
@@ -86,6 +88,7 @@ import Epic.Lexer
%left '<' '>' le ge
%left '+' '-'
%left '*' '/'
+%left NEG
%nonassoc '!'
%nonassoc '('
@@ -148,6 +151,8 @@ Expr : name { R $1 }
| impossible { Impossible }
| foreign Type string '(' ExprTypeList ')'
{ ForeignCall $2 $3 $5 }
+ | lazy foreign Type string '(' ExprTypeList ')'
+ { LazyForeignCall $3 $4 $6 }
CaseExpr :: { Expr }
CaseExpr : case Expr of '{' Alts '}' { Case $2 $5 }
@@ -165,6 +170,7 @@ Alt : con int '(' TypeList ')' arrow Expr
MathExpr :: { Expr }
MathExpr : Expr '+' Expr { Op Plus $1 $3 }
| Expr '-' Expr { Op Minus $1 $3 }
+ | '-' Expr %prec NEG { Op Minus (Const (MkInt 0)) $2 }
| Expr '*' Expr { Op Times $1 $3 }
| Expr '/' Expr { Op Divide $1 $3 }
| Expr '<' Expr { Op OpLT $1 $3 }
View
@@ -78,6 +78,9 @@ checking we do (for now).
> tc env (ForeignCall ty fn args) = do
> argexps' <- mapM (tc env) (map fst args)
> return $ ForeignCall ty fn (zip argexps' (map snd args))
+> tc env (LazyForeignCall ty fn args) = do
+> argexps' <- mapM (tc env) (map fst args)
+> return $ LazyForeignCall ty fn (zip argexps' (map snd args))
> tc env x = return x
> tcalts env [] = return []
View
@@ -16,8 +16,8 @@ rts:
$(MAKE) -C evm
install: .PHONY
- #$(MAKE) -C evm install PREFIX=$(PREFIX)
- #$(MAKE) -C lib install PREFIX=$(PREFIX)
+ $(MAKE) -C evm install PREFIX=$(PREFIX)
+ $(MAKE) -C lib install PREFIX=$(PREFIX)
runhaskell Setup.hs install $(DB)
unregister:
View
@@ -1,5 +1,5 @@
Name: epic
-Version: 0.1.2
+Version: 0.1.2.1
Author: Edwin Brady
License: BSD3
License-file: LICENSE
@@ -11,7 +11,8 @@ Synopsis: Compiler for a supercombinator language
Description: Epic is a simple functional language which compiles to
reasonably efficient C code, using the Boehm-Demers-Weiser
garbage collector. It is currently used as a back end for
- the Idris dependently typed programming language.
+ the Idris dependently typed programming language. It is invoked
+ as a library, as it is intended as a compiler back end.
Build-depends: base, haskell98, mtl, Cabal, array, directory
Build-type: Simple
@@ -22,5 +23,5 @@ Exposed-modules: Epic.Compiler
Other-modules: Epic.Bytecode Epic.Parser Epic.Scopecheck
Epic.Language Epic.Lexer Epic.CodegenC
Epic.OTTLang Paths_epic
-Data-files: evm/libevm.a evm/closure.h evm/stdfuns.h evm/mainprog.c
-Extra-source-files: evm/*.c evm/*.h evm/Makefile
+Data-files: evm/libevm.a evm/closure.h evm/stdfuns.h evm/stdfuns.c evm/mainprog.c
+Extra-source-files: evm/closure.c evm/closure.h evm/stdfuns.h evm/mainprog.c evm/stdfuns.c evm/Makefile
View
@@ -13,9 +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 MKCON (con*)EMALLOC(sizeof(con))
#define MKFUN (fun*)EMALLOC(sizeof(fun))
View
@@ -49,7 +49,7 @@ void fputStr(void* h, char* str) {
int strToInt(char* str)
{
- return atoi(str);
+ return strtol(str,NULL,10);
}
char* intToStr(int x)
@@ -95,7 +95,13 @@ mpz_t* mulBigInt(mpz_t x, mpz_t y) {
mpz_t* divBigInt(mpz_t x, mpz_t y) {
mpz_t* answer = EMALLOC(sizeof(mpz_t));
- mpz_cdiv_q(*answer, x, y);
+ mpz_tdiv_q(*answer, x, y);
+ return answer;
+}
+
+mpz_t* modBigInt(mpz_t x, mpz_t y) {
+ mpz_t* answer = EMALLOC(sizeof(mpz_t));
+ mpz_tdiv_r(*answer, x, y);
return answer;
}
View
@@ -63,6 +63,7 @@ mpz_t* addBigInt(mpz_t x, mpz_t y);
mpz_t* subBigInt(mpz_t x, mpz_t y);
mpz_t* mulBigInt(mpz_t x, mpz_t y);
mpz_t* divBigInt(mpz_t x, mpz_t y);
+mpz_t* modBigInt(mpz_t x, mpz_t y);
int eqBigInt(mpz_t x, mpz_t y);
int ltBigInt(mpz_t x, mpz_t y);
View
@@ -42,6 +42,12 @@ subBig (x:BigInt, y:BigInt) -> BigInt =
mulBig (x:BigInt, y:BigInt) -> BigInt =
foreign BigInt "mulBigInt" (x:BigInt, y:BigInt)
+divBig (x:BigInt, y:BigInt) -> BigInt =
+ foreign BigInt "divBigInt" (x:BigInt, y:BigInt)
+
+modBig (x:BigInt, y:BigInt) -> BigInt =
+ foreign BigInt "modBigInt" (x:BigInt, y:BigInt)
+
eqBig (x:BigInt, y:BigInt) -> Bool =
foreign Int "eqBigInt" (x:BigInt, y:BigInt)

0 comments on commit d22f857

Please sign in to comment.