BASIC 0.1.1.0 → 0.1.2.0

raw patch · 7 files changed

+74/−10 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• BASIC.cabal +1/−1
• Language/BASIC.hs +2/−1
• Language/BASIC/Interp.hs +13/−3
• Language/BASIC/Parser.hs +29/−0
• Language/BASIC/Translate.hs +23/−3
• Language/BASIC/Types.hs +5/−1
• examples/Makefile +1/−1

@@ -1,5 +1,5 @@ Name:		BASIC-Version:	0.1.1.0+Version:	0.1.2.0 License:	BSD3 Author:		Lennart Augustsson Maintainer:	Lennart Augustsson

@@ -6,7 +6,8 @@ import System.TimeIt  import Language.BASIC.Parser hiding (Expr)-import Language.BASIC.Types(Expr(I, S, X, Y, Z, RND, INT, SGN))+import Language.BASIC.Types(Expr(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,+                                 SIN, COS, TAN, ATN, EXP, LOG, SQR, ABS, RND, INT, SGN)) import Language.BASIC.Interp import Language.BASIC.Translate 

@@ -62,12 +62,22 @@              (Dbl d1, "<=", Dbl d2) -> return $ Dbl (if d1 <= d2 then 1 else 0)              (Dbl d1, ">=", Dbl d2) -> return $ Dbl (if d1 >= d2 then 1 else 0) 	     x -> error $ "Expected numbers " ++ show x-	eval env (SGN e) = fmap (\ (Dbl x) -> Dbl $ signum x) $ eval env e-	eval env (INT e) = fmap (\ (Dbl x) -> Dbl $ fromIntegral $ truncate x) $ eval env e+	eval env (SIN e) = unop env sin e+	eval env (COS e) = unop env cos e+	eval env (TAN e) = unop env tan e+	eval env (ATN e) = unop env atan e+	eval env (EXP e) = unop env exp e+	eval env (LOG e) = unop env log e+	eval env (ABS e) = unop env abs e+	eval env (SQR e) = unop env sqrt e+	eval env (SGN e) = unop env signum e+	eval env (INT e) = unop env (fromIntegral . truncate) e 	eval _   (RND _) = do d <- randomIO; return (Dbl d)-	eval env x | x > Var = return $ maybe (Dbl 0) id $ M.lookup x env+	eval env x | x > Var && x < None = return $ maybe (Dbl 0) id $ M.lookup x env 	eval _ x = error $ "eval: " ++ show x 	prExpr (Dbl i) = putStr $ chopDec $ printf "%g" i 	prExpr (Str s) = putStr s 	prExpr e = error $ "prExpr: " ++ show e 	chopDec s = let r = reverse s in if take 2 r == "0." then reverse (drop 2 r) else s++        unop env op e = fmap (\ (Dbl x) -> Dbl $ op x) $ eval env e

@@ -81,12 +81,41 @@ flex (Label l) = Label l flex (Binop e1 op e2) = Binop (flex e1) op (flex e2) flex (e1 := e2) = flex e1 := flex e2+flex (SIN x) = SIN (flex x)+flex (COS x) = COS (flex x)+flex (TAN x) = TAN (flex x)+flex (ATN x) = ATN (flex x)+flex (EXP x) = EXP (flex x)+flex (LOG x) = LOG (flex x)+flex (ABS x) = ABS (flex x)+flex (SQR x) = SQR (flex x) flex (RND x) = RND (flex x) flex (INT x) = INT (flex x) flex (SGN x) = SGN (flex x) flex Var = Var+flex A = A+flex B = B+flex C = C+flex D = D+flex E = E+flex F = F+flex G = G+flex H = H flex I = I+flex J = J+flex K = K+flex L = L+flex M = M+flex N = N+flex O = O+flex P = P+flex Q = Q+flex R = R flex S = S+flex T = T+flex U = U+flex V = V+flex W = W flex X = X flex Y = Y flex Z = Z

@@ -47,12 +47,20 @@  trans :: [Expr ()] -> CodeGenModule (Function (IO ())) trans acmds = do+    atan     <- newNamedFunction ExternalLinkage "atan"     :: TFunction (Double -> IO Double)     atof     <- newNamedFunction ExternalLinkage "atof"     :: TFunction (Ptr Word8 -> IO Double)+    cos      <- newNamedFunction ExternalLinkage "cos"      :: TFunction (Double -> IO Double)+    exp      <- newNamedFunction ExternalLinkage "exp"      :: TFunction (Double -> IO Double)+    fabs     <- newNamedFunction ExternalLinkage "fabs"     :: TFunction (Double -> IO Double)     gets     <- newNamedFunction ExternalLinkage "gets"     :: TFunction (Ptr Word8 -> IO (Ptr Word8))+    log      <- newNamedFunction ExternalLinkage "log"      :: TFunction (Double -> IO Double)     power    <- newNamedFunction ExternalLinkage "power"    :: TFunction (Double -> Double -> IO Double)     printfv  <- newNamedFunction ExternalLinkage "printf"   :: TFunction (Ptr Word8 -> VarArgs Word32)     rand     <- newNamedFunction ExternalLinkage "rand"     :: TFunction (IO Word32)+    sin      <- newNamedFunction ExternalLinkage "sin"      :: TFunction (Double -> IO Double)+    sqrt     <- newNamedFunction ExternalLinkage "sqrt"     :: TFunction (Double -> IO Double)     sranddev <- newNamedFunction ExternalLinkage "sranddev" :: TFunction (IO ())+    tan      <- newNamedFunction ExternalLinkage "tan"      :: TFunction (Double -> IO Double)     let printfd :: Function (Ptr Word8 -> Double -> IO Word32)         printfd = castVarArgs printfv         printfs :: Function (Ptr Word8 -> Ptr Word8 -> IO Word32)@@ -60,7 +68,7 @@         printfn :: Function (Ptr Word8 -> IO Word32)         printfn = castVarArgs printfv -    fmtg <- createStringNul "%g"+    fmtg <- createStringNul "%.15g"     fmts <- createStringNul "%s"     fmtn <- createStringNul "\n" @@ -77,7 +85,7 @@     let mkGlobal x = do             v <- createNamedGlobal False InternalLinkage (show x) (constOf (0 :: Double)) 	    return (x, v)-    globmap <- liftM fromList $ mapM mkGlobal [I,S,X,Y,Z]+    globmap <- liftM fromList $ mapM mkGlobal [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z]      createFunction ExternalLinkage $ do         let mkBlk c = do b <- newBasicBlock; return (cmdLabel c, b)@@ -128,6 +136,14 @@ 	    genExpr (Binop e1 "*" e2) = binop mul e1 e2 	    genExpr (Binop e1 "/" e2) = binop fdiv e1 e2 	    genExpr (Binop e1 "^" e2) = binop (call power) e1 e2+	    genExpr (SIN e) = unop (call sin) e+	    genExpr (COS e) = unop (call cos) e+	    genExpr (TAN e) = unop (call tan) e+	    genExpr (ATN e) = unop (call atan) e+	    genExpr (EXP e) = unop (call exp) e+	    genExpr (LOG e) = unop (call log) e+	    genExpr (SQR e) = unop (call sqrt) e+	    genExpr (ABS e) = unop (call fabs) e 	    genExpr (INT e) = do 	        v <- genExpr e --		r <- frem v (1 :: Double)@@ -145,7 +161,7 @@ 		nd <- uitofp n 		pd <- uitofp p 		sub (pd :: Value Double) (nd :: Value Double)-	    genExpr e | e > Var = load (globmap ! e)+	    genExpr e | e > Var && e < None= load (globmap ! e) 	    genExpr e = error $ "genExpr: " ++ show e              genBool (Binop e1 "<>" e2) = binop (fcmp FPONE) e1 e2@@ -162,6 +178,10 @@                 d1 <- genExpr e1                 d2 <- genExpr e2                 op d1 d2++            unop op e = do+                d <- genExpr e+                op d          call sranddev 	br (block $ cmdLabel $ head cmds)

@@ -10,9 +10,13 @@     | Label Integer     | Binop (Expr a) String (Expr a)     | Expr a := Expr a+    | SIN (Expr a) | COS (Expr a) | TAN (Expr a)+    | ATN (Expr a) | EXP (Expr a) | LOG (Expr a)     | RND (Expr a) | INT (Expr a) | SGN (Expr a)+    | ABS (Expr a) | SQR (Expr a)     | Var-    | I | S | X | Y | Z+    | A | B | C | D | E | F | G | H | I | J | K | L | M+    | N | O | P | Q | R | S | T | U | V | W | X | Y | Z     | None     deriving (Eq, Ord, Show, Typeable) 

@@ -1,6 +1,6 @@ ghc := ghc ghcflags := -Wall -optl -w-examples := Hello HiLo Infinity+examples := Hello HiLo Infinity Func  all: $(examples)