Commit 16417312 authored by Steffen Michels's avatar Steffen Michels Committed by Camil Staps

Load ABC environment once at startup and give access via VSt, instead of...

Load ABC environment once at startup and give access via VSt, instead of giving access to entire IWorld in VSt
parent 85967283
......@@ -45,7 +45,9 @@ doTasksWithOptions initFun startable world
# mbOptions = initFun cli options
| mbOptions =:(Error _) = show (fromError mbOptions) world
# options = fromOk mbOptions
# iworld = createIWorld options world
# mbIWorld = createIWorld options world
| mbIWorld =: Left _ = let (Left (err, world)) = mbIWorld in show [err] world
# iworld = let (Right iworld`) = mbIWorld in iworld`
# (symbolsResult, iworld) = initSymbolsShare options.distributed options.appName iworld
| symbolsResult =: (Error _) = show ["Error reading symbols while required: " +++ fromError symbolsResult] (destroyIWorld iworld)
# iworld = serve (startupTasks options) (tcpTasks options.serverPort options.keepaliveTime) (timeout options.timeout) iworld
......@@ -197,7 +199,7 @@ defaultEngineOptions world
# (appPath,world) = determineAppPath world
# (appVersion,world) = determineAppVersion appPath world
# appDir = takeDirectory appPath
# appName = (dropExtension o dropDirectory) appPath
# appName = (if (takeExtension appPath == "exe") dropExtension id o dropDirectory) appPath
# options =
{ appName = appName
, appPath = appPath
......
......@@ -106,7 +106,7 @@ where
genUI attr dp mode vst = case editModeValue mode of
Nothing = (Error "SVG editors cannot be used in enter mode.", vst)
Just val
# (s,vst) = serializeInVSt val vst
# (s,vst) = serializeForClient val vst
# attr = 'DM'.unions [sizeAttr FlexSize FlexSize, valueAttr (JSONString s), attr]
= (Ok (uia UIComponent attr, val), vst)
......@@ -115,7 +115,7 @@ where
onRefresh :: !DataPath !s !s !*VSt -> (!MaybeErrorString (!UIChange, !s), !*VSt) | gEq{|*|} s
onRefresh _ new old vst
# (s,vst) = serializeInVSt new vst
# (s,vst) = serializeForClient new vst
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "stateChange" (JSONString s)] []), new), vst)
valueFromState :: !s -> *Maybe s
......
......@@ -6,6 +6,7 @@ from Data.Maybe import :: Maybe
from Data.Error import :: MaybeError(..), :: MaybeErrorString(..)
from Data.Set import :: Set
from Data.Queue import :: Queue
from Data.Either import :: Either
from StdFile import class FileSystem, class FileEnv
from System.Time import :: Timestamp, :: Timespec
from Text.GenJSON import :: JSONNode
......@@ -40,7 +41,7 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
, memoryShares :: !Map String Dynamic // Run-time memory shares
, readCache :: !Map (String,String) Dynamic // Cached share reads
, writeCache :: !Map (String,String) (Dynamic,DeferredWrite) // Cached deferred writes
, abcInterpreterEnv :: !Maybe PrelinkedInterpretationEnvironment // Used to serialize expressions for the client
, abcInterpreterEnv :: !PrelinkedInterpretationEnvironment // Used to serialize expressions for the client
, ioTasks :: !*IOTasks // The low-level input/output tasks
, ioStates :: !IOStates // Results of low-level io tasks, indexed by the high-level taskid that it is linked to
......@@ -105,9 +106,9 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
* @param The engine options
* @param The world
*
* @return An initialized iworld
* @result An initialized iworld or world together with an error string on failure
*/
createIWorld :: !EngineOptions !*World -> *IWorld
createIWorld :: !EngineOptions !*World -> Either (!String, !*World) *IWorld
/**
* Destroys the iworld state
......
......@@ -21,6 +21,7 @@ from StdFunc import const, o, seqList, :: St
from StdMisc import abort
from StdOrdList import sortBy
from ABC.Interpreter import prepare_prelinked_interpretation
from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_, :: TCP_DuplexChannel, :: DuplexChannel, :: IPAddress, :: ByteSeq
import System.Time, StdList, Text.Encodings.Base64, _SystemArray, StdBool, StdTuple, Text.GenJSON, Data.Error, Math.Random
......@@ -41,36 +42,41 @@ from iTasks.SDS.Combinators.Common import toReadOnly
from ABC.Interpreter import :: PrelinkedInterpretationEnvironment
createIWorld :: !EngineOptions !*World -> *IWorld
createIWorld :: !EngineOptions !*World -> Either (!String, !*World) *IWorld
createIWorld options world
# (ts=:{tv_nsec=seed}, world) = nsTime world
= {IWorld
|options = options
,clock = ts
,current =
{TaskEvalState
|taskTime = 0
,taskInstance = 0
,sessionInstance = Nothing
,attachmentChain = []
,nextTaskNo = 0
}
,sdsNotifyRequests = 'DM'.newMap
,sdsNotifyReqsByTask = 'DM'.newMap
,memoryShares = 'DM'.newMap
,readCache = 'DM'.newMap
,writeCache = 'DM'.newMap
,abcInterpreterEnv = Nothing
,shutdown = Nothing
,ioTasks = {done = [], todo = []}
,ioStates = 'DM'.newMap
,sdsEvalStates = 'DM'.newMap
,world = world
,signalHandlers = []
,resources = []
,random = genRandInt seed
,onClient = False
}
# (ts=:{tv_nsec=seed}, world) = nsTime world
# (mbAbcEnv, world) = prepare_prelinked_interpretation options.byteCodePath world
= case mbAbcEnv of
Just abcEnv = Right
{IWorld
|options = options
,clock = ts
,current =
{TaskEvalState
|taskTime = 0
,taskInstance = 0
,sessionInstance = Nothing
,attachmentChain = []
,nextTaskNo = 0
}
,sdsNotifyRequests = 'DM'.newMap
,sdsNotifyReqsByTask = 'DM'.newMap
,memoryShares = 'DM'.newMap
,readCache = 'DM'.newMap
,writeCache = 'DM'.newMap
,abcInterpreterEnv = abcEnv
,shutdown = Nothing
,ioTasks = {done = [], todo = []}
,ioStates = 'DM'.newMap
,sdsEvalStates = 'DM'.newMap
,world = world
,signalHandlers = []
,resources = []
,random = genRandInt seed
,onClient = False
}
Nothing =
Left ("Failed to parse bytecode, is ByteCode set in the project file?", world)
// Determines the server executables path
determineAppPath :: !*World -> (!FilePath, !*World)
......
......@@ -26,12 +26,6 @@ dynamicJSONDecode :: !JSONNode -> Maybe a
* WebAssembly interpreter. The values are serialized using GraphCopy after
* which the descriptors are replaced by the descriptors of the client.
* @param The expression to serialize.
* @result `Error` if the bytecode could not be loaded (which may happen due to
* incorrect project settings); otherwise a serialized string.
* @result The serialized string.
*/
serializeForClient :: f !*IWorld -> *(!MaybeErrorString String, !*IWorld)
/**
* Like `serializeForClient`, but in a `VSt`.
*/
serializeInVSt :: f !*VSt -> *(!String, !*VSt)
serializeForClient :: f !*VSt -> *(!String, !*VSt)
......@@ -51,19 +51,5 @@ dynamicJSONDecode :: !JSONNode -> Maybe a
dynamicJSONDecode (JSONArray [JSONString "_DYNAMICENCODE_",JSONString str]) = Just (fst (copy_from_string (base64URLDecode str)))
dynamicJSONDecode _ = Nothing
serializeForClient :: f !*IWorld -> *(!MaybeErrorString String, !*IWorld)
serializeForClient f iworld=:{abcInterpreterEnv=Just e}
= (Ok (serialize_for_prelinked_interpretation f e), iworld)
serializeForClient f iworld=:{abcInterpreterEnv=Nothing,world,options}
# (env,world) = prepare_prelinked_interpretation options.byteCodePath world
# iworld & world = world
= case env of
Nothing -> (Error "Failed to parse bytecode, is ByteCode set in the project file?", iworld)
Just e -> serializeForClient f {iworld & abcInterpreterEnv=Just e}
serializeInVSt :: f !*VSt -> *(!String, !*VSt)
serializeInVSt f vst=:{iworld}
# (s,iworld) = serializeForClient f iworld
= case s of
Error e -> abort (e+++"\n")
Ok s -> (s, {vst & iworld=iworld})
serializeForClient :: f !*VSt -> *(!String, !*VSt)
serializeForClient f vst=:{VSt| abcInterpreterEnv} = (serialize_for_prelinked_interpretation f abcInterpreterEnv, vst)
......@@ -4,6 +4,7 @@ definition module iTasks.UI.Editor
* the interact core task uses these editors to generate and update the user interface
*/
from ABC.Interpreter import :: PrelinkedInterpretationEnvironment
from iTasks.UI.Definition import :: UI, :: UIAttributes, :: UIChange, :: UIAttributeChange, :: TaskId
from iTasks.UI.JavaScript import :: JSWorld, :: JSVal
......@@ -129,9 +130,9 @@ derive bimap EditMode
:: *VSt =
{ taskId :: !String //* The id of the task the visualisation belongs to
, optional :: !Bool //* Create optional form fields
, iworld :: !*IWorld //* The iworld, used for example if external tools are needed to create editors
, selectedConsIndex :: !Int //* Index of the selected constructor in an OBJECT
, pathInEditMode :: [Bool] //* Path of LEFT/RIGHT choices used when UI is generated in edit mode
, abcInterpreterEnv :: !PrelinkedInterpretationEnvironment //* Used to serialize expressions for the client
}
withVSt :: !TaskId !.(*VSt -> (!a, !*VSt)) !*IWorld -> (!a, !*IWorld)
......
......@@ -116,15 +116,15 @@ mapEditMode f (View x) = View $ f x
derive bimap EditMode
withVSt :: !TaskId !.(*VSt -> (!a, !*VSt)) !*IWorld -> (!a, !*IWorld)
withVSt taskId f iworld
withVSt taskId f iworld=:{IWorld| abcInterpreterEnv}
# (x, vst) = f { VSt
| taskId = toString taskId
, optional = False
, selectedConsIndex = -1
, pathInEditMode = abort "VSt.dataPathInEditMode should be set by OBJECT instance of gEditor"
, iworld = iworld
, abcInterpreterEnv = abcInterpreterEnv
}
= (x, vst.iworld)
= (x, iworld)
newLeafState :: EditState
newLeafState = LeafState {LeafState|touched=False,state=JSONNull}
......@@ -151,15 +151,13 @@ withClientSideInit ::
!(JSVal *JSWorld -> *JSWorld)
!(UIAttributes DataPath a *VSt -> *(!MaybeErrorString (!UI, !st), !*VSt))
!UIAttributes !DataPath !a !*VSt -> *(!MaybeErrorString (!UI, !st), !*VSt)
withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case genUI attr dp val vst of
(Ok (UI type attr items,mask),vst=:{VSt|iworld}) -> case serializeForClient (wrapInitUIFunction initUI) iworld of
(Ok initUI,iworld)
# extraAttr = 'DM'.fromList
[("taskId", JSONString taskId)
,("editorId",JSONString (editorId dp))
,("initUI", JSONString initUI)
]
-> (Ok (UI type ('DM'.union extraAttr attr) items,mask), {VSt|vst & iworld = iworld})
(Error e,iworld)
-> (Error e, {VSt|vst & iworld = iworld})
e -> e
withClientSideInit initUI genUI attr dp val vst=:{VSt| taskId} = case genUI attr dp val vst of
(Ok (UI type attr items,mask),vst)
# (initUI, vst) = serializeForClient (wrapInitUIFunction initUI) vst
# extraAttr = 'DM'.fromList
[("taskId", JSONString taskId)
,("editorId",JSONString (editorId dp))
,("initUI", JSONString initUI)
]
= (Ok (UI type ('DM'.union extraAttr attr) items,mask), vst)
e = e
......@@ -113,7 +113,9 @@ testTaskOutput name task events exp comparison = {UnitTest|name=name,test=test}
where
test world
# (options,world) = defaultEngineOptions world
# iworld = createIWorld {options & autoLayout = False} world
# mbIworld = createIWorld {options & autoLayout = False} world
| mbIworld =: Left _ = let (Left (_, world)) = mbIworld in (Failed (Just Crashed), world)
# iworld = let (Right iworld) = mbIworld in iworld
//Empty the store to make sure that we get a reliable task instance no 1
# iworld = emptyStore iworld
//Create an instance with autolayouting disabled at the top level
......
Version: 1.4
Global
ProjectRoot: .
Target: StdEnv
Target: iTasks
Exec: {Project}*iTasks.Extensions.Process.UnitTests
ByteCode: {Project}*iTasks.Extensions.Process.UnitTests.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 2097152
HeapSize: 16777216
StackSize: 512000
ExtraMemory: 8192
IntialHeapSize: 204800
......@@ -40,6 +43,9 @@ Global
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: True
Paths
Path: {Project}
Path: {Project}*..*..*Libraries
......
Version: 1.4
Global
ProjectRoot: .
Target: StdEnv
Target: iTasks
Exec: {Project}*iTasks.Internal.IWorld.UnitTests
ByteCode: {Project}*iTasks.Internal.IWorld.UnitTests.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 20971520
StackSize: 512000
......@@ -40,6 +43,9 @@ Global
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: True
Paths
Path: {Project}
Path: {Project}*..*..*Libraries
......
Version: 1.4
Global
ProjectRoot: .
Target: StdEnv
Target: iTasks
Exec: {Project}*iTasks.Internal.TaskStore.UnitTests
ByteCode: {Project}*iTasks.Internal.TaskStore.UnitTests.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 20971520
StackSize: 512000
......@@ -40,6 +43,9 @@ Global
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: True
Paths
Path: {Project}
Path: {Project}*..*..*Libraries
......
Version: 1.4
Global
ProjectRoot: .
Target: StdEnv
Target: iTasks
Exec: {Project}*iTasks.UI.Editor.Generic.UnitTests
ByteCode: {Project}*iTasks.UI.Editor.Generic.UnitTests.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 20971520
StackSize: 512000
......@@ -40,6 +43,9 @@ Global
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: True
Paths
Path: {Project}
Path: {Project}*..*..*Libraries
......
Version: 1.4
Global
ProjectRoot: .
Target: StdEnv
Target: iTasks
Exec: {Project}*iTasks.UI.Layout.UnitTests
ByteCode: {Project}*iTasks.UI.Layout.UnitTests.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 20971520
StackSize: 512000
......@@ -40,6 +43,9 @@ Global
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: True
Paths
Path: {Project}
Path: {Project}*..*..*Libraries
......
Version: 1.4
Global
ProjectRoot: .
Target: StdEnv
Target: iTasks
Exec: {Project}*iTasks.WF.Tasks.Core.UnitTests
ByteCode: {Project}*iTasks.WF.Tasks.Core.UnitTests.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 20971520
StackSize: 512000
......@@ -40,6 +43,9 @@ Global
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: True
KeepByteCodeSymbols: True
PrelinkByteCode: True
Paths
Path: {Project}
Path: {Project}*..*..*Libraries
......
module iTasks.Internal.IWorld.UnitTests
import Data.Either
import iTasks.Util.Testing
import iTasks.Internal.IWorld
......@@ -6,7 +8,9 @@ testInitIWorld = assertWorld "Init IWorld" id sut
where
sut world
# (options,world) = defaultEngineOptions world
# iworld = createIWorld options world
# mbIworld = createIWorld options world
| mbIworld =: Left _ = let (Left (_, world)) = mbIworld in (False, world)
# iworld = let (Right iworld) = mbIworld in iworld
//Check some properties
//# res = server.paths.dataDirectory == appDir </> "TEST-data"//Is the data directory path correctly initialized
# world = destroyIWorld iworld
......
......@@ -3,13 +3,15 @@ import iTasks.Util.Testing
import iTasks.Internal.IWorld
import iTasks.Internal.TaskStore
import Data.Error
import Data.Error, Data.Func
testCreateTaskInstance = assertWorld "Create task instance" isOk sut
where
sut world
# (options,world) = defaultEngineOptions world
# iworld = createIWorld options world
# mbIworld = createIWorld options world
| mbIworld =: Left _ = let (Left (err, world)) = mbIworld in (Error $ exception err, world)
# iworld = let (Right iworld) = mbIworld in iworld
//Create a task instance
# (res,iworld) = createSessionTaskInstance minimalTask defaultValue iworld
# world = destroyIWorld iworld
......
module iTasks.UI.Editor.Generic.UnitTests
import Data.Either
import iTasks.UI.Editor.Generic
import iTasks.Util.Testing
import qualified Data.Map as DM
......@@ -189,18 +190,22 @@ where
tupleEditorTests = []
genUIWrapper datapath mode editor world
genUIWrapper datapath mode editor world
# (options,world) = defaultEngineOptions world
# iworld = createIWorld options world
# vst = {taskId = "4-2", optional = False,selectedConsIndex=0,pathInEditMode=[],iworld=iworld}
# (res,{VSt|iworld={IWorld|world}}) = editor.Editor.genUI emptyAttr datapath (mapEditMode id mode) vst
= (res,world)
# mbIworld = createIWorld options world
| mbIworld =: Left _ = let (Left (err, world)) = mbIworld in (Error err, world)
# iworld = let (Right iworld) = mbIworld in iworld
# vst = {taskId = "4-2", optional = False,selectedConsIndex=0,pathInEditMode=[],abcInterpreterEnv=iworld.IWorld.abcInterpreterEnv}
# (res, _) = editor.Editor.genUI emptyAttr datapath (mapEditMode id mode) vst
= (res,iworld.world)
onEditWrapper datapath edit state editor world
# (options,world) = defaultEngineOptions world
# iworld = createIWorld options world
# vst = {taskId = "4-2", optional = False,selectedConsIndex=0,pathInEditMode=[],iworld=iworld}
# (res,{VSt|iworld={IWorld|world}}) = editor.Editor.onEdit datapath edit state vst
= (res,world)
# mbIworld = createIWorld options world
| mbIworld =: Left _ = let (Left (err, world)) = mbIworld in (Error err, world)
# iworld = let (Right iworld) = mbIworld in iworld
# vst = {taskId = "4-2", optional = False,selectedConsIndex=0,pathInEditMode=[],abcInterpreterEnv=iworld.IWorld.abcInterpreterEnv}
# (res, _) = editor.Editor.onEdit datapath edit state vst
= (res,iworld.world)
Start w = runUnitTests tests w
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment