Skip to content

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also .

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also .
...
  • 7 commits
  • 4 files changed
  • 0 commit comments
  • 1 contributor
Showing with 152 additions and 31 deletions.
  1. +105 −28 Scilab/Interpreter.hs
  2. +2 −0 Scilab/Parser.hs
  3. +1 −1 scilab.cabal
  4. +44 −2 tests/tests.hs
View
133 Scilab/Interpreter.hs
@@ -1,4 +1,4 @@
-module Scilab.Interpreter (interpret) where
+module Scilab.Interpreter (interpret, Value (..), updateVector, getIndex) where
-- base
import Control.Applicative ((<$>), (<*))
@@ -44,25 +44,57 @@ exec (CIf expr then_ else_) = ifS expr then_ else_
exec (CAttr (RVar var) e) = eval e >>= attr var
exec (CAttr (RVI var [ix]) expr)
= do
- ix_ <- pred <$> evalScalar ix
+ ix_ <- evalScalar ix
+ rvi var 1 ix_ expr
+exec (CAttr (RVI var [ixl, ixc]) expr)
+ = do
+ ixl_ <- evalScalar ixl
+ ixc_ <- evalScalar ixc
+ rvi var ixl_ ixc_ expr
+exec (CAttr (RVI {}) _) = error "exec (CAttr (RVI {}) _)"
+exec (CExpr expr) = void $ eval expr
+exec c@(CWhile expr body) = ifS expr (body ++ [c]) []
+exec (CFor var expr body) = evalVec expr >>= V.mapM_ (forLoop var body)
+
+rvi :: T.Text -> Double -> Double -> Expr -> Scilab ()
+rvi var ixl ixc expr
+ = do
vars <- getVars
- (Number typeNew new) <- eval expr
+ expr_@(Number typeNew _ _) <- eval expr
let
- (Number typeOld old)
- = M.findWithDefault (Number typeNew V.empty) var vars
+ old
+ = M.findWithDefault (Number typeNew V.empty 1) var vars
modify
$ first
$ const
- $ M.insert
- var
- (Number (typeOld && typeNew)
- $ (old V.++ V.replicate (ix_ - V.length old + 1) 0)
- V.// [(ix_, V.head new)])
- vars
-exec (CAttr (RVI {}) _) = error "exec (CAttr (RVI {}) _)"
-exec (CExpr expr) = void $ eval expr
-exec c@(CWhile expr body) = ifS expr (body ++ [c]) []
-exec (CFor var expr body) = evalVec expr >>= V.mapM_ (forLoop var body)
+ $ M.insert var (updateVector ixl ixc expr_ old) vars
+
+updateVector :: Double -> Double -> Value -> Value -> Value
+updateVector ixl ixc (Number typeNew new 1) (Number typeOld old oldLines)
+ = Number (typeOld && typeNew) newv newLines
+ where
+ ixl_ = fromEnum ixl
+ ixc_ = fromEnum ixc
+ oldSize = V.length old
+ oldColumns = oldSize `div` oldLines
+ newLines = oldLines `max` ixl_
+ newColumns = oldColumns `max` ixc_
+ ix = pred ixc_ * newLines + pred ixl_
+ fill = V.replicate (newLines - oldLines) 0
+ withNewLines
+ = intercalateEnd
+ fill
+ (map
+ (\x -> V.slice x oldLines old)
+ [0, oldLines .. oldSize - oldLines])
+ withNewColumns
+ = withNewLines V.++ V.replicate ((newColumns - oldColumns) * newLines) 0
+ newv = withNewColumns V.// [(ix, V.head new)]
+updateVector _ _ _ _ = error "updateVector _"
+
+intercalateEnd :: V.Vector a -> [V.Vector a] -> V.Vector a
+intercalateEnd _ [] = V.empty
+intercalateEnd y (x : xs) = x V.++ y V.++ intercalateEnd y xs
ifS :: Expr -> [Command] -> [Command] -> Scilab ()
ifS cond then_ else_
@@ -81,23 +113,25 @@ eval (EVar var) = readVar var
eval (EVec exprs)
= do
values <- mapM eval exprs
+ let newv = V.concat $ map valueVec values
return
- $ Number (and $ map valueBool values)
- $ V.concat $ map valueVec values
+ $ Number (and $ map valueBool values) newv 1
+
eval (EAdd e1 e2)
= do
v1 <- eval e1
v2 <- eval e2
return
$ case v1 of
- Number _ vec1
+ Number _ vec1 _
-> case v2 of
- Number _ vec2 -> opV (+) vec1 vec2
+ Number _ vec2 _ -> opV (+) vec1 vec2
_ -> error "eval EAdd"
String vec1
-> case v2 of
String vec2 -> String $ V.zipWith (<>) vec1 vec2
_ -> error "eval EAdd"
+ _ -> error "eadd _"
eval (ESub e1 e2) = opD (-) e1 e2
eval (EMul e1 e2) = opD (*) e1 e2
eval (EDiv e1 e2) = opD (/) e1 e2
@@ -139,7 +173,7 @@ eval (ECall "sci2exp" [e])
$ String
$ V.singleton
$ case value of
- Number typ v
+ Number typ v _
| V.length v == 1 -> showType typ $ V.head v
| otherwise
-> "["
@@ -148,17 +182,30 @@ eval (ECall "sci2exp" [e])
String v
| V.length v == 1 -> V.head v
| otherwise -> T.pack $ show $ V.toList v
+ _ -> error "sci2exp _"
eval (ECall "strcat" [e])
= String <$> V.singleton <$> T.concat <$> V.toList <$> getStrVec <$> eval e
eval (ECall var [ix])
= do
- (Number typeVec v) <- readVar var
- (Number typeIx ix_) <- eval ix
+ var_ <- readVar var
+ (typeIx, ix_) <- evalIx 1 ix
return
- $ Number typeVec
$ case typeIx of
- False -> V.map ((v V.!) . pred . fromDouble) $ ix_
- True -> V.map fst $ V.filter snd $ V.zip v $ V.map fromDouble ix_
+ False -> getIndex (V.singleton 1) ix_ var_
+ True
+ -> getIndex
+ (V.singleton 1)
+ (V.map fst
+ $ V.filter snd
+ $ V.zip (V.enumFromN 1 $ V.length ix_)
+ $ V.map fromDouble ix_)
+ var_
+eval (ECall var [ixl, ixc])
+ = do
+ v@(Number _ vect lns) <- readVar var
+ (_, ixl_) <- evalIx lns ixl
+ (_, ixc_) <- evalIx (V.length vect `div` lns) ixc
+ return $ getIndex ixl_ ixc_ v
eval (ECall {}) = error "eval (ECall {})"
eval (EVecFromTo from to)
= do
@@ -171,6 +218,34 @@ eval (EVecFromToStep from step to)
nstep <- evalScalarD step
nto <- evalScalarD to
return $ vec $ V.fromList [nfrom, (nfrom + nstep) .. nto]
+eval EColon = return VColon
+
+evalIx :: Int -> Expr -> Scilab (Bool, V.Vector Double)
+evalIx size ix
+ = do
+ ixVal <- eval ix
+ return
+ $ case ixVal of
+ (Number typeIx_ ix__ _) -> (typeIx_, ix__)
+ VColon -> (False, V.enumFromN 1 size)
+ _ -> error "evalIx case _"
+
+getIndex :: V.Vector Double -> V.Vector Double -> Value -> Value
+getIndex ixl ixc (Number typeVec v linesVec)
+ = Number typeVec newv (V.length ixl)
+ where
+ newv
+ = V.concat
+ $ V.toList
+ $ V.map
+ (\ixc_
+ -> V.map
+ (\ixl_
+ -> v
+ V.! (pred (fromEnum ixc_) * linesVec
+ + pred (fromEnum ixl_))) ixl)
+ ixc
+getIndex _ _ _ = error "getIndex _"
showType :: Bool -> Double -> T.Text
showType True 1 = "%t"
@@ -227,17 +302,19 @@ getVars :: Scilab (M.Map T.Text Value)
getVars = gets fst
data Value
- = Number {valueBool :: Bool, valueVec :: V.Vector Double}
+ = Number {valueBool :: Bool, valueVec :: V.Vector Double, _valueLines :: Int}
| String {_valueStrVec :: V.Vector T.Text}
+ | VColon
deriving (Show, Eq)
instance NFData Value where
- rnf (Number b v) = b `seq` v `seq` ()
+ rnf (Number b v s) = b `seq` v `seq` s `seq` ()
rnf (String v) = v `seq` ()
+ rnf VColon = ()
class Enum a => Valuable a where
vec :: V.Vector a -> Value
- vec v = Number (not $ isDouble $ V.head v) $ V.map toDouble v
+ vec v = Number (not $ isDouble $ V.head v) (V.map toDouble v) 1
getVec :: Value -> V.Vector a
getVec = V.map fromDouble . valueVec
View
2 Scilab/Parser.hs
@@ -122,6 +122,7 @@ data Expr
| ENegate Expr
| ENumber Double
| EStr T.Text
+ | EColon
deriving (Show, Eq)
expr :: Parser Expr
@@ -168,6 +169,7 @@ noop_expr
<|> literal_expr
<|> vec_expr
<|> call_expr EVar ECall
+ <|> (token TColon >> return EColon)
literal_expr :: Parser Expr
literal_expr
View
2 scilab.cabal
@@ -28,7 +28,7 @@ test-suite tests
hs-source-dirs: tests
build-depends:
base == 4.5.*,
- deepseq == 1.3.*,
+ deepseq == 1.3.*,
vector == 0.9.*,
HUnit == 1.2.*,
scilab
View
46 tests/tests.hs
@@ -7,6 +7,9 @@ import System.Timeout (timeout)
-- deepseq
import Control.DeepSeq (force)
+-- vector
+import qualified Data.Vector as V
+
-- HUnit
import
Test.HUnit
@@ -25,7 +28,7 @@ main
else exitSuccess
tests :: Test
-tests = TestList [parse, execution, loop]
+tests = TestList [parse, execution, loop, others]
parse :: Test
parse
@@ -128,7 +131,46 @@ execution
~=? interpret [] "for x = 1 do\n disp(x)\nend",
([], [1])
~=? interpret [1] "a = input(\"\")\r\ndisp(a)",
- ([], [1, 2]) ~=? interpret [] "printf(\"\", 1, 2)"]
+ ([], [1, 2]) ~=? interpret [] "printf(\"\", 1, 2)",
+ ([], [3]) ~=? interpret [] "a_b = 3; disp(a_b)",
+ ([], [25.0,24.0,63.0,34.0,72.0,79.0,87.0,51.0,94.0,11.0])
+ ~=? interpret
+ [25.0,76.0,43.0,29.0,5.0,30.0,63.0,34.0,52.0,98.0,89.0,24.0,82.0,10.0,76.0,90.0,95.0,94.0,30.0,7.0,59.0,66.0,63.0,76.0,1.0,13.0,62.0,79.0,97.0,93.0,23.0,80.0,65.0,34.0,46.0,74.0,7.0,3.0,97.0,87.0,36.0,37.0,51.0,75.0,72.0,43.0,52.0,32.0,69.0,47.0,16.0,22.0,78.0,68.0,70.0,79.0,78.0,78.0,52.0,51.0,97.0,21.0,34.0,2.0,66.0,3.0,87.0,16.0,97.0,99.0,49.0,17.0,6.0,96.0,43.0,79.0,44.0,51.0,13.0,47.0,32.0,14.0,85.0,65.0,38.0,46.0,53.0,34.0,94.0,60.0,12.0,60.0,13.0,96.0,16.0,13.0,34.0,58.0,71.0,11.0]
+ ("for i = 1 : 10; for j = 1 : 10; M(i, j) = input(); end; end;"
+ <> "for i = 1 : 10; disp(M(i, i)); end")]
+
+others :: Test
+others
+ = TestList
+ [Number
+ False
+ (V.replicate 11 0
+ V.++ V.singleton 8
+ V.++ V.replicate 14 0
+ V.++ V.singleton 8
+ V.++ V.replicate 3 0)
+ 6
+ ~=? updateVector
+ 6
+ 2
+ (Number False (V.singleton 8) 1)
+ (Number False (V.replicate 14 0 V.++ V.singleton 8) 3),
+ Number False (V.enumFromN 5 4) 4
+ ~=? getIndex
+ (V.enumFromN 1 4)
+ (V.singleton 2)
+ (Number False (V.enumFromN 1 8) 4),
+ Number False (V.singleton 5) 1
+ ~=? getIndex
+ (V.singleton 1)
+ (V.singleton 1)
+ (Number False (V.singleton 5) 1),
+ Number False (V.singleton 3) 1
+ ~=? updateVector
+ 1
+ 1
+ (Number False (V.singleton 3) 1)
+ (Number False V.empty 1)]
loop :: Test
loop

No commit comments for this range

Something went wrong with that request. Please try again.