BASIC 0.1.3.0 → 0.1.4.0

raw patch · 5 files changed

+42/−25 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• BASIC.cabal +1/−1
• Language/BASIC/Interp.hs +4/−3
• Language/BASIC/Parser.hs +32/−15
• Language/BASIC/Translate.hs +2/−2
• examples/Func.hs +3/−4

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

@@ -19,13 +19,14 @@             if d /= Dbl 0 then goto env stk fors l else run env stk fors cs 	run _ [] fors (Cmd _ Return _ : _) = error "RETURN without GOSUB" 	run env (cs:stk) fors (Cmd _ Return _:_) = run env stk fors cs-	run env stk fors cs@(Cmd _ For [v,l,_] : cs') = do+	run env stk fors cs@(Cmd _ For [v,l,_,_] : cs') = do             d <- eval env l 	    run (M.insert v d env) stk (cs:fors) cs'-	run env stk fors@((Cmd _ For [v,_,h] : bs) : fors') (Cmd _ Next [v'] : cs) | v == v' = do+	run env stk fors@((Cmd _ For [v,_,h,s] : bs) : fors') (Cmd _ Next [v'] : cs) | v == v' = do 	    let Dbl i = env M.! v 	    Dbl hv <- eval env h-	    let i' = i + 1+	    Dbl sv <- eval env s+	    let i' = i + sv 	    if i' <= hv then run (M.insert v (Dbl i') env) stk fors bs 	               else run env stk fors' cs 	run env stk fors (Cmd _ Next _ : _) = error $ "Unmatched FOR/NEXT"

@@ -2,7 +2,7 @@ {-# LANGUAGE FlexibleInstances, IncoherentInstances, ExtendedDefaultRules, OverloadedStrings, DeriveDataTypeable #-} module Language.BASIC.Parser(     getBASIC, BASIC,-    PRINT(..), END(..), LET(..), GOTO(..), IF(..), THEN(..), INPUT(..), FOR(..), TO(..), NEXT(..),+    PRINT(..), END(..), LET(..), GOTO(..), IF(..), THEN(..), INPUT(..), FOR(..), TO(..), NEXT(..), STEP(..),     Expr((:=)), (<>), (==), (<), (>), (<=), (>=), (^)     ) where import Prelude hiding ((==),(<),(>),(<=),(>=),(^))@@ -38,7 +38,8 @@  joinAssign :: Expr a -> Expr a --joinAssign c | trace (show c) False = undefined-joinAssign (Cmd l For [v] := Binop e1 ";" e2) = Cmd l For [v, e1, e2]+joinAssign (Cmd l For [v] := Binop e1 ";" (Binop e2 ";" e3)) = Cmd l For [v, e1, e2, e3]+joinAssign (Cmd l For [v] := Binop e1 ";" e2) = Cmd l For [v, e1, e2, Dbl 1] joinAssign (Cmd l Let [v] := e) = Cmd l Let [v, e] joinAssign c = c @@ -131,6 +132,7 @@ data FOR = FOR data TO = TO data NEXT = NEXT+data STEP = STEP  -- Yuck!  But this is the only way I could figure out -- how to make a Monad like Expr actually be able to save@@ -170,6 +172,11 @@ instance Num (PRINT -> Expr a -> Expr b) where     fromInteger i _ v = Cmd i Print [flex v] +instance Eq (PRINT -> (Expr c -> Expr c) -> Expr a -> Expr b)+instance Show (PRINT -> (Expr c -> Expr c) -> Expr a -> Expr b)+instance Num (PRINT -> (Expr c -> Expr c) -> Expr a -> Expr b) where+    fromInteger i _ f v = Cmd i Print [flex $ f $ flex v]+ instance Eq (PRINT -> t -> Expr a) instance Show (PRINT -> t -> Expr a) instance (Show t, Typeable t) => Num (PRINT -> t -> Expr a) where@@ -177,7 +184,7 @@         let f con = fmap (\ v -> Cmd i Print [con v]) (cast x)         in  case catMaybes [f Str, f (Dbl . fromInteger), f Dbl] of             c : _ -> c-	    [] -> error $ "Bad type " ++ show x+	    [] -> error $ "Bad type(1) " ++ show x ++ " :: " ++ show (typeOf x)  instance Eq (END -> Expr a) instance Show (END -> Expr a)@@ -214,22 +221,32 @@ instance Num (FOR -> Expr a -> Expr b) where     fromInteger i _ v = Cmd i For [flex v] +instance Num (TO -> Expr b -> Expr a) where+    fromInteger c _ x = Binop (Dbl (fromInteger c)) ";" (flex x)++castExpr x =+    let f con = fmap con (cast x)+        id' :: Expr () -> Expr a+        id' = flex+    in  case catMaybes [f (Dbl . fromInteger), f Dbl, f id'] of+        e : _ -> e+        [] -> error $ "Bad type(3) " ++ show x ++ " :: " ++ show (typeOf x)+ instance Eq (TO -> t -> Expr a) instance Show (TO -> t -> Expr a) instance (Show t, Typeable t) => Num (TO -> t -> Expr a) where-    fromInteger c _ x = -- Binop (Dbl (fromInteger c)) ";" (Dbl $ fromIntegral x)-      Binop (Dbl (fromInteger c)) ";" $-        let f con = fmap con (cast x)-        in  case catMaybes [f (Dbl . fromInteger), f Dbl] of-            e : _ -> e-	    [] -> error $ "Bad type " ++ show x+    fromInteger c _ x = Binop (Dbl (fromInteger c)) ";" (castExpr x) instance (Show t, Typeable t) => Fractional (TO -> t -> Expr a) where-    fromRational c _ x = -- Binop (Dbl (fromRational c)) ";" (Dbl $ fromIntegral x)-      Binop (Dbl (fromRational c)) ";" $-        let f con = fmap con (cast x)-        in  case catMaybes [f (Dbl . fromInteger), f Dbl] of-            e : _ -> e-	    [] -> error $ "Bad type " ++ show x+    fromRational c _ x = Binop (Dbl (fromRational c)) ";" (castExpr x)++instance Eq (TO -> t -> STEP -> s -> Expr a)+instance Show (TO -> t -> STEP -> s -> Expr a)+instance (Show t, Typeable t, Show s, Typeable s) => Num (TO -> t -> STEP -> s -> Expr a) where+    fromInteger c _ x _ y =+      Binop (Dbl (fromInteger c)) ";" (Binop (castExpr x) ";" (castExpr y))+instance (Show t, Typeable t, Show s, Typeable s) => Fractional (TO -> t -> STEP -> s -> Expr a) where+    fromRational c _ x _ y =+      Binop (Dbl (fromRational c)) ";" (Binop (castExpr x) ";" (castExpr y))  instance Eq (NEXT -> Expr a -> Expr b) instance Show (NEXT -> Expr a -> Expr b)

@@ -23,12 +23,12 @@ -- This assumes some sanity in loop nesting. removeFor :: [Expr a] -> [Expr a] removeFor [] = []-removeFor (Cmd l For [v, lo, hi] : cs) =+removeFor (Cmd l For [v, lo, hi, inc] : cs) =     let cs' = removeFor cs         (n, cs'') = removeNext cs' 	removeNext [] = error $ "No NEXT for line " ++ show (l, v) 	removeNext (Cmd ln Next [v'] : bs) | v == v' = (ln+2,-	    [Cmd ln Let [v, Binop v "+" (Dbl 1)], Cmd (ln+1) Goto [Label (l+1)], Cmd (ln+2) Rem []] ++ bs)+	    [Cmd ln Let [v, Binop v "+" inc], Cmd (ln+1) Goto [Label (l+1)], Cmd (ln+2) Rem []] ++ bs) 	removeNext (c:bs) = (ln, c:bs') where (ln, bs') = removeNext bs 	loopStart = [Cmd l Let [v, lo], Cmd (l+1) If [Binop v ">" hi, Label n]]     in  loopStart ++ cs''

@@ -6,8 +6,7 @@ main :: IO () main = runBASIC' $ do -    10 FOR I := 0 TO 20-    20   LET X := I/10-    30   PRINT X;" ";SIN(X);" ";COS(X);" ";TAN(X);" ";ATN(X);" ";EXP(X);" ";LOG(X);" ";SQR(X);" ";ABS(X);" ";SGN(X);" ";INT(X);" ";RND(X)-    40 NEXT I+    10 FOR X := 0 TO 2.01 STEP 0.1+    30   PRINT SIN(X);" ";COS(X);" ";TAN(X);" ";ATN(X);" ";EXP(X);" ";LOG(X);" ";SQR(X);" ";ABS(X);" ";SGN(X);" ";INT(X);" ";RND(X);" ";X+    40 NEXT X     100 END