packages feed

LslPlus 0.4.0 → 0.4.1

raw patch · 7 files changed

+45/−27 lines, 7 filesdep −ghc

Dependencies removed: ghc

Files

LslPlus.cabal view
@@ -1,5 +1,5 @@ Name:           LslPlus
-version:        0.4.0
+version:        0.4.1
 Synopsis:	    An execution and testing framework for the Linden Scripting Language (LSL)
 Description:	
 	Provides a framework for executing Linden Scripting Language scripts offline,
@@ -20,7 +20,7 @@ Extra-source-files: NOTICE
 
 Executable LslPlus
-  Build-Depends:  ghc >= 6.10, base >= 4.0 && < 4.1, haskell98, filepath >= 1.1.0.0 && < 1.2, parsec >= 2.1.0.0 && < 3,
+  Build-Depends:  base >= 4.0 && < 4.1, haskell98, filepath >= 1.1.0.0 && < 1.2, parsec >= 2.1.0.0 && < 3,
                   HaXml >= 1.19 && < 1.20, directory > 1 && < 1.1, mtl >= 1.1 && < 1.2, array >= 0.2 && < 0.3,
                   network >= 2.1 && < 2.3, random >= 1.0, containers >= 0.1 && < 0.3, old-time, utf8-string >= 0.3 && < 0.4,
                   pureMD5 >= 0.2 && < 3, bytestring >= 0.9 && < 0.10, template-haskell >= 2.3.0.0 && < 2.4, syb >= 0.1.0.0 && < 0.2.0.0
src/Language/Lsl/Internal/Exec.hs view
@@ -29,7 +29,7 @@ 
 import Language.Lsl.Internal.Breakpoint(Breakpoint(..),StepManager(..),pushStepManagerFrame,popStepManagerFrame,emptyStepManager,mkBreakpoint)
 import Language.Lsl.Internal.CodeHelper(renderCall)
-import Language.Lsl.Internal.FuncSigs(funcSigs)
+import Language.Lsl.Internal.FuncSigs(convertArgs)
 import Language.Lsl.Internal.Util(fromInt,lookupM,ctx,findM)
 import Language.Lsl.Syntax(Expr(..),
                   CompiledLSLScript(..),
@@ -54,7 +54,8 @@                   rmCtx)
 import Language.Lsl.Internal.Type(LSLType(..),LSLValue(..),typeOfLSLComponent,typeOfLSLValue,toFloat,toSVal,
                 lslShowVal,replaceLslValueComponent,vecMulScalar,rotMulVec,parseVector,parseRotation,
-                parseInt,parseFloat,invRot,rotMul,vcross,Component(..),lslValueComponent)
+                parseInt,parseFloat,invRot,rotMul,vcross,Component(..),lslValueComponent,
+                convertValues)
 import Language.Lsl.Internal.Key(nullKey,nextKey)
 import Language.Lsl.Internal.Evaluation(EvalResult(..),Event(..),ScriptInfo(..))
 import Language.Lsl.Internal.Constants(findConstVal,llcZeroRotation,llcZeroVector)
@@ -1088,9 +1089,7 @@ 
 evalPredef' name = 
     do (LVal args) <- popVal
-       let args' = case find (\ (fname,_,_) -> name == fname) funcSigs of
-                   Nothing -> args
-                   Just (_,_,argTypes) -> convertArgs argTypes args
+       let args' = convertArgs name args
        key <- getMyPrimKey
        sid <- getScriptName
        oid <- getObjectId
@@ -1100,12 +1099,12 @@        (evalResult,retval) <- doAction name scriptInfo args'    
        pushVal retval
        return evalResult
-    where convertArgs argTypes args = zipWith convertArg argTypes args
-          convertArg LLFloat (IVal i) = FVal $ fromInt i
-          convertArg LLInteger (FVal f) = IVal $ floor f
-          convertArg LLKey (SVal s) = KVal s
-          convertArg LLString (KVal k) = SVal k
-          convertArg _ v = v
+--     where convertArgs argTypes args = zipWith convertArg argTypes args
+--           convertArg LLFloat (IVal i) = FVal $ fromInt i
+--           convertArg LLInteger (FVal f) = IVal $ floor f
+--           convertArg LLKey (SVal s) = KVal s
+--           convertArg LLString (KVal k) = SVal k
+--           convertArg _ v = v
           
 ctxList es = map (Ctx Nothing) es
src/Language/Lsl/Internal/FuncSigs.hs view
@@ -1,9 +1,12 @@ module Language.Lsl.Internal.FuncSigs(     funcDescriptions,     funcMeta,-    funcSigs) where+    funcSigs,+    findSig,+    convertArgs) where -import Language.Lsl.Internal.Type(LSLType(..))+import Data.List(find)+import Language.Lsl.Internal.Type(LSLType(..), convertValues,LSLValue)  -- TODO: import real info into funcMeta, and derive funcSigs from that funcMeta :: [(String,LSLType,[(String,LSLType)],String)]@@ -16,6 +19,13 @@             in (name, rt,zip argNames args,description)     in map sig2Meta funcSigs         +findSig name = find (\ (fname,_,_) -> name == fname) funcSigs++convertArgs :: RealFrac a => String -> [LSLValue a] -> [LSLValue a]+convertArgs name args = case findSig name of+    Nothing -> args+    Just (_,_,argTypes) -> convertValues argTypes args+ funcSigs :: [(String,LSLType,[LSLType])] funcSigs = [     ("llAbs",LLInteger,[LLInteger]),
src/Language/Lsl/Internal/Optimize.hs view
@@ -18,7 +18,7 @@ import Language.Lsl.Parse
 import Language.Lsl.Render
 import Language.Lsl.Internal.Constants(allConstants,Constant(..),findConstVal)
-import Language.Lsl.Internal.FuncSigs(funcSigs)
+import Language.Lsl.Internal.FuncSigs(funcSigs,convertArgs)
 import Language.Lsl.Internal.InternalLLFuncs(internalLLFuncs,internalLLFuncNames)
 import Language.Lsl.Internal.OptimizerOptions(OptimizerOption(..))
 import Language.Lsl.Syntax(CompiledLSLScript(..),Expr(..),Statement(..),Var(..),
@@ -985,7 +985,7 @@         Nothing -> return e
         Just vs -> 
             case lookup nm internalLLFuncs of
-                Just f -> return (valToExpr $ snd (Id.runIdentity (f () vs)))
+                Just f -> return (valToExpr $ snd (Id.runIdentity (f () (convertArgs nm vs))))
                 Nothing -> do
                     pureFuncs <- get >>= return . siPureFuncs
                     script <- get >>= return . siScript
src/Language/Lsl/Internal/SerializationGenerator.hs view
@@ -84,7 +84,7 @@     
 instance JavaRep String where
     representative = ""
-    xmlSerialize t s = emit (maybe "string" id t) (maybe [] (const [("class","string")]) t) [showString s]
+    xmlSerialize t s = emit (maybe "string" id t) (maybe [] (const [("class","string")]) t) [(showString . xmlEscape) s]
     xmlDefaultTag _ = "string"
     subElemDescriptor tag = el tag id simpleContent
     elemDescriptor = el "string" id simpleContent
src/Language/Lsl/Internal/Type.hs view
@@ -3,6 +3,7 @@     LSLType(..),
     LSLValue(..),
     Component(..),
+    convertValues,
     typeOfLSLValue,
     typeOfLSLComponent,
     parseFloat,
@@ -260,3 +261,11 @@ 
 rot2RVal (x,y,z,s) = RVal x y z s
 rVal2Rot (RVal x y z s) = (x,y,z,s)
+
+
+convertValues argTypes args = zipWith convertArg argTypes args
+    where convertArg LLFloat (IVal i) = FVal $ fromInt i
+          convertArg LLInteger (FVal f) = IVal $ floor f
+          convertArg LLKey (SVal s) = KVal s
+          convertArg LLString (KVal k) = SVal k
+          convertArg _ v = v
src/Language/Lsl/Render.hs view
@@ -12,7 +12,7 @@ renderCompiledScript stamp (CompiledLSLScript comment globals funcs states) =
    (renderString "// LSL script generated: " . renderString stamp . renderString "\n" .
     renderString comment .
-    renderGlobals globals . renderFuncs funcs . renderStates states) ""
+    renderGlobals globals . renderFuncs funcs . renderStates states . renderString "\n") ""
 
 renderSequence r = (foldl' (.) blank) . (map r)
 
@@ -20,8 +20,8 @@ 
 renderGlobal (GDecl (Ctx sc var) val) = renderPreText sc . renderVar var . 
     case val of 
-        Nothing -> renderString ";\n"
-        Just expr -> renderString " = " . renderSimple expr . renderString ";\n"
+        Nothing -> renderString ";"
+        Just expr -> renderString " = " . renderSimple expr . renderString ";"
 
 renderCtxSimple (Ctx _ expr) = renderSimple expr
 renderSimple (Neg expr) = renderChar '-' . renderCtxExpr expr
@@ -44,10 +44,10 @@ 
 renderState (Ctx ssc (State (Ctx sc "default") handlers)) = 
     renderPreText ssc .
-    renderString "default {\n" . renderHandlers handlers . renderString "}\n"
+    renderString "default {\n" . renderHandlers handlers . renderString "}"
 renderState (Ctx ssc (State (Ctx _ name) handlers)) =
     renderPreText ssc .
-    renderString "state " . renderString name . renderString " {\n" . renderHandlers handlers . renderString "}\n"
+    renderString "state " . renderString name . renderString " {\n" . renderHandlers handlers . renderString "}"
  
 renderHandlers = renderSequence renderHandler
 
@@ -72,9 +72,9 @@ 
 renderFuncs = renderSequence renderCtxFunc
 
-renderCtxFunc (Ctx _ func) = renderFunc func
+renderCtxFunc (Ctx sc func) = renderPreText sc . renderFunc func
 renderFunc (Func dec stmts) = 
-    renderFuncDec dec . renderString "{\n" . renderStatements 0 stmts . renderString "}\n"
+    renderFuncDec dec . renderString "{\n" . renderStatements 0 stmts . renderString "}"
 
 renderIndent 0 = renderString "    "
 renderIndent n = renderString "    " . renderIndent (n - 1)
@@ -230,7 +230,7 @@ blank = id
 
 renderPreText :: (Maybe SourceContext) -> String -> String
-renderPreText = maybe blank (renderString . srcPreText)
+renderPreText = maybe (renderString "\n") (renderString . srcPreText)
 
 renderPreText1 :: (String -> String) -> (Maybe SourceContext) -> String -> String
-renderPreText1 f = maybe f (renderString . srcPreText)+renderPreText1 f = maybe (renderString "\n" . f) (renderString . srcPreText)