packages feed

LslPlus 0.3.2 → 0.3.3

raw patch · 5 files changed

+54/−31 lines, 5 files

Files

LslPlus.cabal view
@@ -1,5 +1,5 @@ Name:           LslPlus
-version:        0.3.2
+version:        0.3.3
 Synopsis:	    An execution and testing framework for the Linden Scripting Language (LSL)
 Description:	
 	Provides a framework for executing Linden Scripting Language scripts offline,
src/Language/Lsl/Internal/Optimize.hs view
@@ -45,7 +45,7 @@          nifs' = map (runInliningOnFunc funFacts ifs' gs) nifs -- non-inlineables that have had any inlining done
          fs' = if inline then (nifs' ++ ifs') else fsIn
          fsReachable = reachableFuncs ss1 (simp fs') -- funcs that are still reachable from handlers
-         gsReachable = reachableGlobs gs fsReachable ss1 -- globals that are still reachable from handlers/funcs
+         gsReachable = reachableGlobs (simp gs) fsReachable ss1 -- globals that are still reachable from handlers/funcs
          simp = if inline then simplify script pure gcs else id
          runInliningOnState s@(State nm hs) = if noinlining nm then s
              else (State nm (map (runInliningOnHandler funFacts ifs' gs) hs))
@@ -261,6 +261,12 @@                -- simplify $ nullCtx (Compound (parmVars ++ stmts)))
     where ps = funcParms fd
     
+tr x = trace (show $ nullify x) x
+nullify :: Data a => a -> a
+nullify = everywhere (mkT doNullify)
+    where doNullify :: Maybe SourceContext -> Maybe SourceContext
+          doNullify _ = Nothing
+          
 mkParmVars :: [Ctx Statement] -> [(Ctx Var,Ctx Expr)] -> OState [Ctx Statement]
 mkParmVars ss ves = mapM (mkParmVar ss) ves >>= return . concat
 mkParmVar ss (Ctx _ v@(Var nm _),arg) = do
@@ -270,7 +276,9 @@        (staticComplexity arg < 2 || usageCount nm ss == 1) && not (nm `isModifiedIn` ss) && (simpleRef arg || nm `isUsedOnlyWholeIn` ss)
         then do
             st <- get
-            put st { optRewrites = M.insert (varName v) (ctxItem arg) (optRewrites st) }
+            case arg of
+                (Ctx _ (Get (cnm,All))) -> addRename nm (ctxItem cnm)
+                _ -> put st { optRewrites = M.insert (varName v) (ctxItem arg) (optRewrites st) }
             return []
         else do
             v' <- renameVar v
@@ -353,11 +361,15 @@                 _ -> Compound (map nullCtx ss)
         return (For (rewriteExprs es0) (fmap (rewriteCtxExpr renames rewrites) e) (rewriteExprs es1) body: stmts')
 inlineStmts endLabel (If e s0 s1:stmts) = do
-    (renames,rewrites) <- getRewriteInfo
-    stmts' <- inlineStmts endLabel stmts
-    s0s <- inlineStmts endLabel [s0]
-    s1s <- inlineStmts endLabel [s1]
-    return (If (rewriteCtxExpr renames rewrites e) (Compound (map nullCtx s0s)) (Compound (map nullCtx s1s)) : stmts')
+        (renames,rewrites) <- getRewriteInfo
+        stmts' <- inlineStmts endLabel stmts
+        s0s <- inlineStmts endLabel [s0]
+        s1s <- inlineStmts endLabel [s1]
+        return (If (rewriteCtxExpr renames rewrites e) (newS s0s) (newS s1s) : stmts')
+    where newS ss = 
+              case ss of
+                  [s] -> s
+                  _ -> Compound (map nullCtx ss)
     
 runInliningOnFunc :: M.Map String FunctionFacts -> [Ctx Func] -> [Global] -> Ctx Func -> Ctx Func
 runInliningOnFunc ff fs gs f = if noinlining f then f else
@@ -555,7 +567,7 @@          go e = 1
 
 rewriteCtxExpr :: (M.Map String String) -> (M.Map String Expr) -> Ctx Expr -> Ctx Expr
-rewriteCtxExpr renames rewrites = everywhere' (mkT rwName `extT` rwExpr)
+rewriteCtxExpr renames rewrites = everywhere (mkT rwName `extT` rwExpr)
     where 
           rwExpr e@(Get (Ctx _ nm,All)) =
               case M.lookup nm rewrites of
@@ -762,20 +774,8 @@           comp _ = True
 
 reachableGlobs gs fs ss = [ g | g@(GDecl (Var nm _) _) <- gs, nm `elem` reachableNames]
-    where reachableNames = (gnms `areUsedIn` ss) ++ (gnms `areUsedIn` fs)
+    where reachableNames = (gnms `areUsedIn` ss) ++ (gnms `areUsedIn` fs) ++ (gnms `areUsedIn` gs)
           gnms = [ nm | g@(GDecl (Var nm _) _) <- gs]
---reachableGlobs gs fs ss = [ g | g@(GDecl (Var nm _) _) <- gs, (nm `isUsedIn` fs || nm `isUsedIn` ss)]
-
-isUsedIn :: Data a => String -> a -> Bool
-isUsedIn s v = 
-    evalState
-        (everythingTwice (liftM2 (||)) (return False `mkQ` cvt (funcDecIn sfs) False `extQ`
-                                        cvt (stmtIn sfs) False `extQ` used `extQ` cvt (handlerDecIn sfs) False)
-                                       (return False `mkQ` cvt (funcDecOut sfs) False `extQ`
-                                        cvt (handlerDecOut sfs) False `extQ` cvt (stmtOut sfs) False) v) []
-    where sfs = nameStateScopeFuncs
-          used :: (Ctx String,Component) -> NamesState Bool
-          used (Ctx _ nm,_) = (sfVars sfs) >>= return . ((nm == s) &&) . (notElem nm)
           
 globalConstants :: [Global] -> [Ctx Func] -> [State] -> M.Map String Expr
 globalConstants gs fs ss =
@@ -946,6 +946,8 @@                     (All,VecExpr _ _ _) -> e
                     (All,RotExpr _ _ _ _) -> e
                     (All,ListExpr _) -> e
+                    (All,StringLit _) -> e
+                    (All,KeyLit _) -> e
                     (All,_) -> e'
                     (X,VecExpr x _ _) -> ctxItem x
                     (X,RotExpr x _ _ _) -> ctxItem x
@@ -982,6 +984,13 @@ simplifyE e@(RotExpr eX eY eZ eS) = return (RotExpr (toFloatLit eX) (toFloatLit eY) (toFloatLit eZ) (toFloatLit eS))
 simplifyE e = return e
  
+-- could simplify for other types, but this should be sufficient for the main use case
+simplifyS (If (Ctx _ (IntLit 0)) _ stmt) = return stmt
+simplifyS (If (Ctx _ (IntLit _)) stmt _) = return stmt
+simplifyS (If (Ctx _ (FloatLit 0)) _ stmt) = return stmt
+simplifyS (If (Ctx _ (FloatLit _)) stmt _) = return  stmt
+simplifyS s = return s
+
 toFloatLit (Ctx c (IntLit i))  = (Ctx c (FloatLit $ fromIntegral i))
 toFloatLit e = e
 
@@ -991,7 +1000,7 @@     where go :: Data a => a -> SimpState a
           go = downupSkipping (False `mkQ` string `extQ` srcContext)
                       (mkM (stmtIn simpInfoScopeFuncs) `extM` funcDecIn simpInfoScopeFuncs `extM` handlerDecIn simpInfoScopeFuncs)
-                      (mkM simplifyE `extM` stmtOut simpInfoScopeFuncs `extM` 
+                      (mkM simplifyE `extM` stmtOut simpInfoScopeFuncs `extM` simplifyS `extM` 
                        funcDecOut simpInfoScopeFuncs `extM` handlerDecOut simpInfoScopeFuncs)
           string :: String -> Bool
           string _ = True
src/Language/Lsl/Parse.hs view
@@ -137,13 +137,14 @@ fracPart reqDigit w = do digits <- (if reqDigit then many1 else many) digit <?> "fractional part of decimal"
                          p <- option 1.0 expon
                          return $ p * (w + (foldr (\ b d -> (b + d) / 10.0) 0 $ map (fromIntegral.digitToInt) digits))
-
+                         
+expon :: GenParser Char st Double
 expon = do oneOf "eE"
            s <- option '+' (oneOf "+-")
            let k x = if s == '+' then x else 1/x
            digits <- many1 digit <?> "exponent"
            let p = foldl (\ b d -> b * 10 + d) 0 $ map digitToInt digits
-           return ((k (10^p))::Float)
+           return ((k (10^p)))
 
 hex = do oneOf "xX"
          digits <- many1 hexDigit <?> "hex digit"
src/Language/Lsl/Render.hs view
@@ -3,7 +3,8 @@ import Data.List(foldl',intersperse)
 import Language.Lsl.Syntax(Expr(..),Func(..),FuncDec(..),Global(..),Handler(..),State(..),Statement(..),
                   Ctx(..),Var(..),LSLType(..),Component(..),ctxItems,CompiledLSLScript(..))
-
+import Debug.Trace
+tr s x = trace (s ++ show x) x
 -- | Generate a string representing an LSL script from a timestamp (string) 
 -- and a compiled (i.e. validated, with referenced modules included) LSL script.
 renderCompiledScript :: String -> CompiledLSLScript -> String
@@ -88,14 +89,26 @@ renderStatement' n (Compound stmts) = 
         renderString "{\n" . renderStatements (n+1) stmts . renderIndent n . renderString "}\n"
 renderStatement' n (While expr stmt) = 
-    renderString "while (" . renderCtxExpr expr . renderChar ')' . renderStatement True n stmt
+    renderString "while (" . renderCtxExpr expr . renderChar ')' . 
+    case stmt of
+        NullStmt -> renderString ";\n"
+        _ -> renderStatement True n stmt
 renderStatement' n (DoWhile stmt expr) = 
-    renderString "do " . renderStatement True n stmt . doHang False n . renderString "while (" . renderCtxExpr expr . renderString ");\n"
+    renderString "do " . 
+    (case stmt of
+         NullStmt -> renderString ";\n"
+         _ -> renderStatement True n stmt) . doHang False n . renderString "while (" . renderCtxExpr expr . renderString ");\n"
 renderStatement' n (For mexpr1 mexpr2 mexpr3 stmt) =
     renderString "for (" . renderCtxExprs "" mexpr1 . renderString "; " . renderOptionalExpression mexpr2 .
-    renderString "; " . renderCtxExprs "" mexpr3 . renderString ")" . renderStatement True n stmt
+    renderString "; " . renderCtxExprs "" mexpr3 . renderString ")" . 
+    case stmt of
+        NullStmt -> renderString ";n"
+        _ -> renderStatement True n stmt
 renderStatement' n (If expr stmt1 stmt2) =
-    renderString "if (" . renderCtxExpr expr . renderChar ')' . renderStatement True n stmt1 . 
+    renderString "if (" . renderCtxExpr expr . renderChar ')' . 
+        (case stmt1 of
+             NullStmt -> renderString ";\n"
+             _ -> renderStatement True n stmt1) .
         case stmt2 of 
             NullStmt -> blank
             _ -> renderIndent n . renderString "else " . (renderStatement True n stmt2)
src/LslPlus.hs view
@@ -12,7 +12,7 @@ import System
 import System.Exit
 
-version="0.3.2"
+version="0.3.3"
 usage progName = "Usage: " ++ progName ++ " [Version|MetaData|Compiler|ExpressionHandler|SimMetaData|SystemTester|UnitTester]"
 main = do
     progName <- getProgName