epic 0.1.13 → 0.9
raw patch · 17 files changed
+114/−20 lines, 17 filesdep −haskell98dep ~base
Dependencies removed: haskell98
Dependency ranges changed: base
Files
- Epic/Bytecode.lhs +1/−1
- Epic/Epic.lhs +10/−6
- Epic/Evaluator.lhs +2/−0
- Epic/Language.lhs +9/−2
- Epic/Lexer.lhs +3/−1
- Epic/Parser.y +3/−0
- Epic/Scopecheck.lhs +11/−0
- Epic/Simplify.lhs +1/−0
- Epic/Stackcode.lhs +2/−2
- Main.lhs +1/−1
- epic.cabal +4/−4
- evm/Makefile +3/−2
- evm/closure.c +9/−0
- evm/closure.h +9/−1
- evm/libevm.a binary
- evm/sparks.c +36/−0
- evm/sparks.h +10/−0
Epic/Bytecode.lhs view
@@ -32,7 +32,7 @@ > | UNUSED TmpVar > | INT TmpVar Int > | BIGINT TmpVar Integer-> | FLOAT TmpVar Float+> | FLOAT TmpVar Double > | BIGFLOAT TmpVar Double > | STRING TmpVar StrVar > | PROJ TmpVar TmpVar Int -- project into a register
Epic/Epic.lhs view
@@ -27,7 +27,7 @@ > Type, tyInt, tyChar, tyBool, tyFloat, tyString, > tyPtr, tyUnit, tyAny, tyC, > -- * Operators-> plus_, minus_, times_, divide_, +> Op, plus_, minus_, times_, divide_, > plusF_, minusF_, timesF_, divideF_, > eq_, lt_, lte_, gt_, gte_, > eqF_, ltF_, lteF_, gtF_, gteF_, shiftl_, shiftr_,@@ -45,7 +45,7 @@ Combinators for constructing an expression > import Control.Monad.State-> import System+> import System.Process > import System.IO > import Debug.Trace @@ -60,6 +60,9 @@ > -- | A sub-term, with a name supply > type Term = State Int Expr +> instance Show Term where+> show t = show (evalState t 0)+ > -- | Build expressions, with a name supply > class EpicExpr e where > term :: e -> State Int Expr@@ -84,7 +87,7 @@ > instance EpicExpr e => EpicExpr ([Name], e) where > term (ns, e) = do e' <- term e-> foldM (\e n -> return (Lam n TyAny e)) e' ns+> foldM (\e n -> return (Lam n TyAny e)) e' (reverse ns) > -- | Build a function definition, with a name supply > class EpicFn e where@@ -182,8 +185,9 @@ > (Alt t vars e') <- mkAlt t (f (R arg)) > return $ Alt t ((arg, TyAny):vars) e' -> instance Alternative ([Name], Expr) where-> mkAlt t (vars, e) = return $ Alt t (map (\x -> (x, TyAny)) vars) e+> instance (Alternative e) => Alternative ([Name], e) where+> mkAlt t (vars, e) = do (Alt t rest e') <- mkAlt t e+> return $ Alt t ((map (\x -> (x, TyAny)) vars) ++ rest) e' > -- | Case alternative for constructor with the given tag > con :: Alternative e => Int -- ^ the tag@@ -367,7 +371,7 @@ > int x = term $ Const (MkInt x) > -- | Constant float-> float :: Float -> Term+> float :: Double -> Term > float x = term $ Const (MkFloat x) > -- | Constant character
Epic/Evaluator.lhs view
@@ -22,6 +22,7 @@ > xs' <- mapM ev xs > evFn f' xs' > ev (Lazy e) = ev e+> ev (Par e) = ev e > ev (Effect e) = ev e > ev (Con t es) = do es' <- mapM ev es > return $ Con t es'@@ -135,6 +136,7 @@ > instance Quote Expr where > quote v (App x xs) = App (quote v x) (quote v xs) > quote v (Lazy x) = Lazy (quote v x)+> quote v (Par x) = Par (quote v x) > quote v (Effect x) = Effect (quote v x) > quote v (Con t xs) = Con t (quote v xs) > quote v (Proj x i) = Proj (quote v x) i
Epic/Language.lhs view
@@ -9,6 +9,7 @@ > import System.Environment > import Debug.Trace+> import Data.Char > -- | (Debugging) options to give to compiler > data CompileOptions = KeepC -- ^ Keep intermediate C file@@ -21,6 +22,7 @@ > | Checking Int -- ^ Checking level (0 none) > | ExternalMain -- ^ main is defined externally (in C) > | MainInc FilePath -- ^ File to #include in main program+> | LinkObj FilePath -- ^ .o file to link with > deriving Eq Raw data types. Int, Char, Bool are unboxed.@@ -62,7 +64,7 @@ > data Const = MkInt Int > | MkBigInt Integer > | MkChar Char-> | MkFloat Float+> | MkFloat Double > | MkBigFloat Double > | MkString String > | MkBool Bool@@ -88,7 +90,8 @@ > quotename ('$':cs) = "_DO_"++quotename cs > quotename ('#':cs) = "_HA_"++quotename cs > quotename ('@':cs) = "_AT_"++quotename cs-> quotename (c:cs) = c:(quotename cs)+> quotename (c:cs) | isAlphaNum c = c:(quotename cs)+> | otherwise = "_" ++ show (fromEnum c) ++ "_" ++ quotename cs > showC n = quotename (show n) @@ -109,6 +112,7 @@ > | App Expr [Expr] -- Function application > | Lazy Expr -- Lazy function application > | Effect Expr -- Expression with side effects (i.e. don't update when EVALing)+> | Par Expr -- evaluate an expression in parallel > | Con Tag [Expr] -- Constructor, tags, arguments (fully applied) > | Const Const -- a constant > | Proj Expr Int -- Project argument@@ -178,6 +182,7 @@ > show (R n) = show n > show (App f as) = show f ++ show as > show (Lazy e) = "%lazy(" ++ show e ++ ")"+> show (Par e) = "%par(" ++ show e ++ ")" > show (Effect e) = "%effect(" ++ show e ++ ")" > show (Con t es) = "Con " ++ show t ++ show es > show (Const c) = show c@@ -250,6 +255,7 @@ > subst v rep (V x) | v == x = rep > subst v rep (App x xs) = App (subst v rep x) (subst v rep xs) > subst v rep (Lazy x) = Lazy (subst v rep x)+> subst v rep (Par x) = Par (subst v rep x) > subst v rep (Effect x) = Effect (subst v rep x) > subst v rep (Con t xs) = Con t (subst v rep xs) > subst v rep (Proj x i) = Proj (subst v rep x) i@@ -296,6 +302,7 @@ > instance HOAS Expr Expr where > hoas v (App f xs) = App (hoas v f) (hoas v xs) > hoas v (Lazy x) = Lazy (hoas v x)+> hoas v (Par x) = Par (hoas v x) > hoas v (Effect x) = Effect (hoas v x) > hoas v (Con t xs) = Con t (hoas v xs) > hoas v (Proj x i) = Proj (hoas v x) i
Epic/Lexer.lhs view
@@ -47,7 +47,7 @@ > = TokenName Name > | TokenString String > | TokenInt Int-> | TokenFloat Float+> | TokenFloat Double > | TokenBigInt Integer > | TokenBigFloat Double > | TokenChar Char@@ -116,6 +116,7 @@ > | TokenUnused > | TokenIn > | TokenLazy+> | TokenPar > | TokenStrict > | TokenEffect > | TokenError@@ -268,6 +269,7 @@ > ("else",rest) -> cont TokenElse rest > ("in",rest) -> cont TokenIn rest > ("lazy",rest) -> cont TokenLazy rest+> ("par",rest) -> cont TokenPar rest > ("error",rest) -> cont TokenError rest > ("impossible",rest) -> cont TokenImpossible rest > ("foreign",rest) -> cont TokenForeign rest
Epic/Parser.y view
@@ -59,6 +59,7 @@ unused { TokenUnused } in { TokenIn } lazy { TokenLazy }+ par { TokenPar } strict { TokenStrict } effect { TokenEffect } foreign { TokenForeign }@@ -109,6 +110,7 @@ %nonassoc NONE %nonassoc lazy+%nonassoc par %left LET %left IF %left eq feq@@ -183,6 +185,7 @@ | Expr '(' ExprList ')' { App $1 $3 } | '[' ExprList ']' { Con 0 $2 } | lazy '(' Expr ')' { Lazy $3 }+ | par '(' Expr ')' { Par $3 } | effect '(' Expr ')' { Effect $3 } | con int '(' ExprList ')' { Con $2 $4 } | Const { Const $1 }
Epic/Scopecheck.lhs view
@@ -91,6 +91,9 @@ > tc env (Lazy e) | appForm e = do > e' <- tc env e > return $ Lazy e'+> tc env (Par e) | appForm e = do+> e' <- tc env e+> return $ Par e' Make a new function, with current env as arguments, and add as a decl @@ -102,6 +105,14 @@ > let newd = Decl newname TyAny newfn Nothing [] > put (maxlen, nextn+1, newd:decls) > return $ Lazy (App (R newname) (map V (map snd env)))+> tc env (Par e) = +> do (maxlen, nextn, decls) <- get+> let newname = MN (getRoot nm) nextn+> let newargs = zip (map fst env) (repeat TyAny)+> let newfn = Bind newargs 0 e []+> let newd = Decl newname TyAny newfn Nothing []+> put (maxlen, nextn+1, newd:decls)+> return $ Par (App (R newname) (map V (map snd env))) > tc env (Lam n ty e) = lift e [(n,ty)] where > lift (Lam n ty e) args = lift e ((n,ty):args)
Epic/Simplify.lhs view
@@ -49,6 +49,7 @@ > _ -> R fn > s' args d (App f a) = apply d (s' args d f) (map (s' args d) a) args > s' args d (Lazy e) = Lazy $ s' args d e+> s' args d (Par e) = Par $ s' args d e > s' args d (Effect e) = Effect $ s' args d e > s' args d (While t e) = While (s' args d t) (s' args d e) > s' args d (WhileAcc t a e) = WhileAcc (s' args d t) (s' args d a) (s' args d e)
Epic/Stackcode.lhs view
@@ -1,7 +1,7 @@ > module Epic.Stackcode where > import Control.Monad.State-> import List+> import Data.List > import Epic.Language > import Debug.Trace@@ -21,7 +21,7 @@ > | PUSH Loc > | INT Int > | BIGINT Integer-> | FLOAT Float+> | FLOAT Double > | STRING Int -- reference to string pool > | CON Tag Int > | UNIT
Main.lhs view
@@ -79,7 +79,7 @@ > return (fns,opts) > else return (fns,opts) -> showUsage = do putStrLn $ "Epigram Supercombinator Compiler version " ++ versionString+> showUsage = do putStrLn $ "Epic version " ++ versionString > putStrLn "Usage:\n\tepic <input file> [options]" > exitWith (ExitFailure 1)
epic.cabal view
@@ -1,5 +1,5 @@ Name: epic-Version: 0.1.13+Version: 0.9 Author: Edwin Brady License: BSD3 License-file: LICENSE@@ -17,7 +17,7 @@ It can be invoked either as a library or an application. Data-files: evm/libevm.a evm/closure.h evm/stdfuns.h evm/stdfuns.c evm/mainprog.c evm/emalloc.h evm/gc_header.h-Extra-source-files: evm/closure.c evm/closure.h evm/stdfuns.h evm/mainprog.c evm/stdfuns.c evm/Makefile evm/emalloc.c evm/emalloc.h evm/gc_header.h+Extra-source-files: evm/closure.c evm/closure.h evm/stdfuns.h evm/mainprog.c evm/stdfuns.c evm/Makefile evm/emalloc.c evm/emalloc.h evm/gc_header.h evm/sparks.c evm/sparks.h Cabal-Version: >= 1.8.0.4 Build-type: Custom@@ -28,7 +28,7 @@ Epic.Language Epic.Lexer Epic.CodegenC Epic.CodegenStack Epic.OTTLang Epic.Simplify Epic.Stackcode Epic.Evaluator Paths_epic- Build-depends: base >=4 && <5 , haskell98, mtl, Cabal, array, directory, process+ Build-depends: base >=4 && <5 , mtl, Cabal, array, directory, process Extensions: BangPatterns Executable epic@@ -37,5 +37,5 @@ Epic.Language Epic.Lexer Epic.CodegenC Epic.CodegenStack Epic.OTTLang Epic.Simplify Epic.Stackcode Epic.Evaluator Paths_epic- Build-depends: base >=4 && <5, mtl, array, haskell98, Cabal, directory, process+ Build-depends: base >=4 && <5, mtl, array, Cabal, directory, process Extensions: BangPatterns
evm/Makefile view
@@ -1,11 +1,11 @@ CC = gcc #CFLAGS = -Wall -g CFLAGS = -Wall -O3 -DUSE_BOEHM-OBJS = closure.o stdfuns.o emalloc.o+OBJS = closure.o stdfuns.o emalloc.o sparks.o INSTALLDIR = ${PREFIX}/lib/evm TARGET = libevm.a-INSTALLHDRS = closure.h stdfuns.h mainprog.c+INSTALLHDRS = closure.h stdfuns.h mainprog.c sparks.h ${TARGET} : ${OBJS} ar r ${TARGET} ${OBJS}@@ -22,3 +22,4 @@ closure.o : closure.h emalloc.h stdfuns.o : stdfuns.h closure.h emalloc.h emalloc.o : closure.h emalloc.h+sparks.o : sparks.h closure.h
evm/closure.c view
@@ -896,6 +896,7 @@ fun* fn; thunk* th; int excess;+ spark* sp; // dumpClosure(x); @@ -908,6 +909,14 @@ case PTR: case UNIT: return x; // Already evaluated+ case RUNNING:+ sp = (spark*)(x->info);+ // Wait for it to run by trying to take the lock, then eval again,+ // at which point it should have been updated.+ // Q: Would this be better done with a condition variable?+ pthread_mutex_lock(sp->lock);+ pthread_mutex_unlock(sp->lock);+ return DO_EVAL(x, update); case FUN: // If the number of arguments is right, run it. fn = (fun*)(x->info);
evm/closure.h view
@@ -92,7 +92,9 @@ UNIT, PTR, FREEVAR,- IND+ IND,+ RUNNING,+ WAITING } ClosureType; typedef struct {@@ -139,6 +141,12 @@ int tag; void** args; } con;++typedef struct {+ pthread_mutex_t *lock;+ pthread_cond_t *cond;+ VAL thunk;+} spark; typedef struct { VAL* roots;
evm/libevm.a view
binary file changed (55864 → 57456 bytes)
+ evm/sparks.c view
@@ -0,0 +1,36 @@+#include "sparks.h"++void sparkThread(VAL thunk) {+ spark* s = (spark*)(thunk->info);++ pthread_mutex_lock(s->lock);+ SETTY(thunk, RUNNING);+ pthread_mutex_unlock(s->lock);++ VAL ans = DO_EVAL(s->thunk, 1);++ pthread_mutex_lock(s->lock);+ UPDATE(thunk, ans);+// pthread_cond_broadcast(s->cond);+ pthread_mutex_unlock(s->lock);+}++VAL addSpark(VAL thunk) {+ VAL c = EMALLOC(sizeof(Closure)+sizeof(spark));+ spark* s = (spark*)(c+1);++ pthread_mutex_t m;+ pthread_mutex_init(&m, NULL);++// pthread_cond_t cond;+// pthread_cond_init(&cond, NULL);++ s->thunk = thunk;+ s->lock = &m;+ s->cond = NULL; // &cond;++ c->info = (void*)s;+ SETTY(c, RUNNING);++ return c;+}
+ evm/sparks.h view
@@ -0,0 +1,10 @@+#ifndef _SPARKS_H+#define _SPARKS_H++#include "gc_header.h"+#include "closure.h"++VAL addSpark(VAL thunk);+//void startWorker();++#endif