Verified Commit c7c36e69 authored by Camil Staps's avatar Camil Staps 🚀

Nuke sapl; start with using the Wasm ABC interpreter

parent 6f3dc402
Pipeline #20657 failed with stage
in 1 minute and 15 seconds
**/Clean System Files
*-data
*-sapl
*-www
*.prj
*.prp
*.exe
*.bc
.sass-cache
BasicAPIExamples.icl
.ctest-results.json
......@@ -3,9 +3,12 @@ Global
ProjectRoot: .
Target: iTasks
Exec: {Project}/BasicAPIExamples.exe
ByteCode: {Project}/BasicAPIExamples.bc
CodeGen
CheckStacks: False
CheckIndexes: True
OptimiseABC: True
GenerateByteCode: True
Application
HeapSize: 167772160
StackSize: 1048576
......@@ -39,6 +42,7 @@ Global
ResourceSource:
GenerateDLL: False
ExportedNames:
StripByteCode: False
Paths
Path: {Project}
Path: {Project}/Ligretto
......
......@@ -46,8 +46,6 @@ doTasksWithOptions initFun startable world
| mbOptions =:(Error _) = show (fromError mbOptions) world
# options = fromOk mbOptions
# iworld = createIWorld options world
# (res,iworld) = initJSCompilerState iworld
| res =:(Error _) = show ["Fatal error: " +++ fromError res] (destroyIWorld 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
......
definition module iTasks.Internal.Client.LinkerSupport
import StdString
import Data.Maybe
import iTasks.Internal.IWorld
import iTasks.UI.Editor
/**
* Links all necessary Sapl functions for an editlet and compiles them to Javascript
*
* @param initUI function
* @param IWorld state
*
* @return JS code of the support code for all the expressions
* @return JS code of the initUI function
* @return IWorld state
*/
editorLinker :: !f !*IWorld -> *(!MaybeErrorString (!String,!String),!*IWorld)
implementation module iTasks.Internal.Client.LinkerSupport
from StdFunc import id
import StdString, StdList, StdFile, StdTuple
import Data.Maybe, System.File
import graph_to_sapl_string
from StdOverloaded import class <
from StdClass import class Ord, class Eq
from Data.Map import :: Map, newMap, get, put, toList, toAscList, foldrWithKey
from Data.Set import :: Set, newSet
from iTasks.UI.JS.Interface import :: JSWorld, :: JSEvent, :: JSObj, :: JSObject, :: JSVal
from iTasks.Internal.Client.RunOnClient import createClientIWorld, getUIUpdates
import iTasks.Internal.IWorld
import Sapl.Target.JS.CodeGeneratorJS, Sapl.Linker.LazyLinker, Sapl.SaplParser
editorLinker :: !f !*IWorld -> *(!MaybeErrorString (!String,!String),!*IWorld)
editorLinker initUIFunc iworld=:{world,current={sessionInstance=Nothing}} = (Error "Could not link editlet javascript: no session instance",iworld)
editorLinker initUIFunc iworld=:{world,current={sessionInstance=Just currentInstance}
,jsCompilerState=Just jsCompilerState=:{loaderState,functionMap,flavour,parserState,skipMap}}
// Create per sesssion "linker state"
# linkerstate = (loaderState, functionMap, maybe newSet id Nothing /*(get currentInstance skipMap)*/)
/* 1. First, we collect all the necessary function definitions to generate ParserState */
# (linkerstate, lib, sapl_IU, world) = linkByExpr linkerstate newAppender (graph_to_sapl_string initUIFunc) world
// unwrap linker state
# (loaderState, functionMap, skipset) = linkerstate
/* 2. Generate function definitions and ParserState */
# sapl_lib = toString lib
# mbInitPs = case sapl_lib of
"" = Ok (newAppender, parserState)
= case generateJS flavour False sapl_lib parserState of
Ok (script, pst) = Ok (script,Just pst)
Error e = Error e
| mbInitPs =:(Error _)
= (liftError mbInitPs, {iworld & world=world})
# (js_lib, parserState) = fromOk mbInitPs
/* 3. Generate expressions by ParserState */
# mbExprPs = exprGenerateJS flavour False sapl_IU parserState js_lib
| mbExprPs =:(Error _)
= (liftError mbExprPs, {iworld & world=world})
# (js_IU, js_lib, parserstate) = fromOk mbExprPs
/* Update global compiler state */
# jsCompilerState
= {jsCompilerState & loaderState = loaderState, parserState = parserState
, functionMap = functionMap, flavour = flavour, skipMap = put currentInstance skipset skipMap}
= (Ok (toString js_lib, js_IU),{iworld & world=world, jsCompilerState = Just jsCompilerState})
editletLinker initUIFunc iworld = (Error "Could not link editlet javascript: js compiler not initialized",iworld)
definition module iTasks.Internal.Client.RunOnClient
import iTasks
runOnClient :: !(Task m) -> Task m | iTask m
createClientIWorld :: !String !InstanceNo -> *IWorld
getUIUpdates :: !*IWorld -> (!Maybe [(InstanceNo, [String])], *IWorld)
implementation module iTasks.Internal.Client.RunOnClient
import StdMisc, Data.Func
import iTasks
import iTasks.Internal.TaskStore
import iTasks.Internal.TaskEval
import iTasks.Internal.IWorld
import iTasks.UI.Definition
import qualified iTasks.Internal.SDS as SDS
from Data.Map import qualified newMap, toList, fromList, get
from Data.List import find
from Data.Queue as DQ import qualified newQueue, dequeue
import iTasks.Extensions.DateTime
import System.Time, Math.Random
import Text.GenJSON
:: TaskState a =
{ instanceNo :: !InstanceNo
, sessionId :: !String
, taskId :: !Maybe TaskId
, task :: !Task a
, value :: !Maybe (TaskValue DeferredJSON)
}
runOnClient :: !(Task m) -> Task m | iTask m
runOnClient task = task
/*
# roc_tasklet =
{ Tasklet
| genUI = roc_generator task
, resultFunc = gen_res
, tweakUI = id
}
= mkTask roc_tasklet
*/
gen_res {TaskState|value=Nothing} = NoValue
gen_res {TaskState|value=Just NoValue} = NoValue
gen_res {TaskState|value=Just (Value json stability)} = Value (fromJust (fromDeferredJSON json)) stability
/*
roc_generator :: !(Task m) !TaskId (Maybe (TaskState m)) !*IWorld -> *(!TaskletGUI (TaskState m), !TaskState m, !*IWorld) | iTask m
roc_generator task (TaskId instanceNo _) _ iworld=:{current={sessionInstance=Just currentInstance}}
# currentSession = "SESSIONID-" +++ toString currentInstance
# gui = TaskletTUI {TaskletTUI|instanceNo = instanceNo, controllerFunc = controllerFunc}
# state = { TaskState
| instanceNo = instanceNo
, sessionId = currentSession
, taskId = Nothing
, task = task
, value = Nothing}
= (gui, state, iworld)
*/
// Init
controllerFunc _ st=:{TaskState | sessionId, instanceNo, task, taskId = Nothing} Nothing Nothing Nothing iworld
# (mbTaskId, iworld) = createClientTaskInstance task sessionId instanceNo iworld
= case mbTaskId of
Ok taskId
# (mbResult,iworld) = evalTaskInstance instanceNo ResetEvent iworld
= case mbResult of
Ok _
= (Nothing, {TaskState | st & taskId = Just taskId}, iworld)
_ = (Nothing, {TaskState | st & taskId = Just taskId}, iworld)
_ = (Nothing, st, iworld)
/* FIXME
// Refresh
controllerFunc _ st=:{TaskState | sessionId, instanceNo, task, taskId = Just t} Nothing Nothing Nothing iworld
# (mbResult,iworld) = evalTaskInstance instanceNo (RefreshEvent "Client refresh") iworld
= case mbResult of
Ok (_,value)
= (Nothing, {TaskState | st & value = Just value}, iworld)
Error msg = abort ("controllerFunc: " +++ msg)
// Focus
controllerFunc _ st=:{TaskState | sessionId, instanceNo, task, taskId = Just t} Nothing Nothing Nothing iworld
# iworld = trace_n "c_focus" iworld
# (mbResult,iworld) = evalTaskInstance instanceNo (FocusEvent t) iworld
= case mbResult of
Ok (_,value)
= (Nothing, {TaskState | st & value = Just value}, iworld)
Error msg = abort ("controllerFunc: " +++ msg)
*/
// Edit
controllerFunc taskId st=:{TaskState | sessionId, instanceNo} Nothing (Just name) (Just jsonval) iworld
# (mbResult,iworld) = evalTaskInstance instanceNo (EditEvent taskId name (fromString jsonval)) iworld
= case mbResult of
Ok value
= (Nothing, {TaskState | st & value = Just value}, iworld)
Error msg = abort ("controllerFunc: " +++ msg)
// Action
controllerFunc taskId st=:{TaskState | sessionId, instanceNo} Nothing (Just name) Nothing iworld
# (mbResult,iworld) = evalTaskInstance instanceNo (ActionEvent taskId name) iworld
= case mbResult of
Ok value
= (Nothing, {TaskState | st & value = Just value}, iworld)
Error msg = abort ("controllerFunc: " +++ msg)
newWorld :: *World
newWorld = abort "newWorld"
getUIUpdates :: !*IWorld -> (!Maybe [(InstanceNo, [String])], *IWorld)
getUIUpdates iworld
= case 'SDS'.read taskOutput EmptyContext iworld of
(Ok (ReadingDone output),iworld)
= case 'Data.Map'.toList output of
[] = (Nothing,iworld)
output
# (_,iworld) = 'SDS'.write 'Data.Map'.newMap taskOutput 'SDS'.EmptyContext iworld
= (Just (map getUpdates output), iworld)
(_,iworld)
= (Nothing, iworld)
where
getUpdates (instanceNo,upds) = (instanceNo, [toString (encodeUIChanges [c \\ TOUIChange c <- toList upds])])
toList q = case 'DQ'.dequeue q of //TODO SHOULD BE IN Data.Queue
(Nothing,q) = []
(Just x,q) = [x:toList q]
createClientIWorld :: !String !InstanceNo -> *IWorld
createClientIWorld serverURL currentInstance
# world = newWorld
# (timestamp=:{tv_sec=seed},world) = nsTime world
= {IWorld
|options = { appName = "application"
, appPath = locundef "appDirectory"
, appVersion = locundef "appVersion"
, serverPort = 80
, serverUrl = locundef "serverUrl"
, keepaliveTime = locundef "keepaliveTime"
, sessionTime = locundef "sessionTime"
, persistTasks = False
, autoLayout = True
, timeout = Just 100
, distributed = False
, maxEvents = 5
, sdsPort = 9090
, webDirPath = locundef "webDirectory"
, storeDirPath = locundef "dataDirectory"
, tempDirPath = locundef "tempDirectory"
, saplDirPath = locundef "saplDirectory"}
,clock = timestamp
,current =
{taskTime = 0
,taskInstance = currentInstance
,sessionInstance = Just currentInstance
,attachmentChain = []
,nextTaskNo = 6666
}
,sdsNotifyRequests = 'Data.Map'.newMap
,sdsNotifyReqsByTask = 'Data.Map'.newMap
,memoryShares = 'Data.Map'.newMap
,readCache = 'Data.Map'.newMap
,writeCache = 'Data.Map'.newMap
,sdsEvalStates = 'Data.Map'.newMap
,jsCompilerState = locundef "jsCompilerState"
,shutdown = Nothing
,random = genRandInt seed
,ioTasks = {done=[],todo=[]}
,ioStates = 'Data.Map'.newMap
,world = world
,resources = []
,onClient = True
}
where
locundef var = abort ("IWorld structure is not avalaible at client side. Reference: "+++var)
definition module iTasks.Internal.Client.Serialization
from Data.Error import :: MaybeError, :: MaybeErrorString
from iTasks.Internal.IWorld import :: IWorld
serialize_for_client :: f !*IWorld -> *(!MaybeErrorString String, !*IWorld)
implementation module iTasks.Internal.Client.Serialization
import StdEnv
import StdMaybe
import Data.Error
import System.FilePath
import ABC.Interpreter
import iTasks.Engine
import iTasks.Internal.IWorld
serialize_for_client :: f !*IWorld -> *(!MaybeErrorString String, !*IWorld)
serialize_for_client f iworld=:{world,options}
# (graph,world) = serialize_for_prelinked_interpretation f (options.appName+++".bc") options.appPath world
// TODO: store bytecodePath in EngineOptions
# iworld & world = world
# graph = case graph of
Nothing -> Error "Failed to serialize graph"
Just g -> Ok g
= (graph, iworld)
......@@ -21,10 +21,6 @@ from iTasks.Internal.SDS import :: SDSNotifyRequest, :: DeferredWrite, :: SDSIde
from iTasks.SDS.Definition import :: SDSSource, :: SDSLens, :: SDSParallel, class RWShared, class Registrable, class Modifiable, class Identifiable, class Readable, class Writeable
from iTasks.Extensions.DateTime import :: Time, :: Date, :: DateTime
from Sapl.Linker.LazyLinker import :: LoaderState
from Sapl.Linker.SaplLinkerShared import :: LineType, :: FuncTypeMap
from Sapl.Target.Flavour import :: Flavour
from Sapl.SaplParser import :: ParserState
from TCPIP import :: TCP_Listener, :: TCP_Listener_, :: TCP_RChannel_, :: TCP_SChannel_, :: TCP_DuplexChannel, :: DuplexChannel, :: IPAddress, :: ByteSeq
CLEAN_HOME_VAR :== "CLEAN_HOME"
......@@ -40,7 +36,6 @@ 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
, jsCompilerState :: !Maybe JSCompilerState // Sapl to Javascript compiler state
, 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
......@@ -54,14 +49,6 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
, shutdown :: !Maybe Int // Signals the server function to shut down, the int will be set as exit code
}
:: JSCompilerState =
{ loaderState :: !LoaderState // State of the lazy loader
, functionMap :: !FuncTypeMap // Function name -> source code mapping
, flavour :: !Flavour // Clean flavour for JS compilation
, parserState :: !Maybe ParserState // Some information collected by the parser for the code generator
, skipMap :: !Map InstanceNo (Set String) // Per client information of the names of the already generated functions
}
:: TaskEvalState =
{ taskTime :: !TaskTime // The 'virtual' time for the task. Increments at every event
, taskInstance :: !InstanceNo // The current evaluated task instance
......@@ -116,12 +103,6 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
*/
createIWorld :: !EngineOptions !*World -> *IWorld
/**
* Initialize the SAPL->JS compiler state
*
*/
initJSCompilerState :: *IWorld -> *(!MaybeErrorString (), !*IWorld)
/**
* Destroys the iworld state
*/
......
......@@ -34,30 +34,9 @@ import Data.Func, Data.Tuple, Data.List, iTasks.SDS.Definition
import System.Time, System.CommandLine, System.Environment, System.OSError, System.File, System.FilePath, System.Directory
from Data.Set import :: Set, newSet
from Sapl.Linker.LazyLinker import generateLoaderState, :: LoaderStateExt, :: LoaderState, :: FuncTypeMap, :: LineType
from Sapl.Linker.SaplLinkerShared import :: SkipSet
from Sapl.Target.Flavour import :: Flavour, toFlavour
from Sapl.Target.CleanFlavour import cleanFlavour
from Sapl.SaplParser import :: ParserState
from iTasks.SDS.Definition import :: SDSParallel
from iTasks.SDS.Combinators.Common import toReadOnly
//The following modules are excluded by the SAPL -> Javascript compiler
//because they contain functions implemented in ABC code that cannot
//be compiled to javascript anyway. Handwritten Javascript overrides need
//to be provided for them.
JS_COMPILER_EXCLUDES :==
["iTasks.Internal.Client.Override"
,"dynamic_string"
,"graph_to_string_with_descriptors"
,"graph_to_sapl_string"
,"Text.Encodings.Base64"
,"Sapl.LazyLinker"
,"Sapl.Target.JS.CodeGeneratorJS"
,"System.Pointer"
,"System.File"
,"System.Directory"
]
createIWorld :: !EngineOptions !*World -> *IWorld
createIWorld options world
......@@ -78,7 +57,6 @@ createIWorld options world
,memoryShares = 'DM'.newMap
,readCache = 'DM'.newMap
,writeCache = 'DM'.newMap
,jsCompilerState = Nothing
,shutdown = Nothing
,ioTasks = {done = [], todo = []}
,ioStates = 'DM'.newMap
......@@ -89,12 +67,6 @@ createIWorld options world
,onClient = False
}
initJSCompilerState :: *IWorld -> *(!MaybeErrorString (), !*IWorld)
initJSCompilerState iworld=:{IWorld|world,options={EngineOptions|saplDirPath}}
# ((lst, ftmap, _), world) = generateLoaderState [saplDirPath] [] JS_COMPILER_EXCLUDES world
# jsCompilerState = { loaderState = lst, functionMap = ftmap, flavour = cleanFlavour, parserState = Nothing, skipMap = 'DM'.newMap}
= (Ok (), {iworld & jsCompilerState = Just jsCompilerState, world = world})
// Determines the server executables path
determineAppPath :: !*World -> (!FilePath, !*World)
determineAppPath world
......
......@@ -176,10 +176,6 @@ where
mbResetUIState instanceNo ResetEvent iworld
# (_,iworld) = write 'DQ'.newQueue (sdsFocus instanceNo taskInstanceOutput) EmptyContext iworld
//Remove all js compiler state for this instance
# iworld=:{jsCompilerState=jsCompilerState} = iworld
# jsCompilerState = fmap (\state -> {state & skipMap = 'DM'.del instanceNo state.skipMap}) jsCompilerState
# iworld = {iworld & jsCompilerState = jsCompilerState}
= iworld
mbResetUIState _ _ iworld = iworld
......
implementation module iTasks.UI.Editor
import StdBool, StdMisc, StdList, StdTuple
import iTasks.Internal.Client.LinkerSupport, Data.Maybe, Data.Functor, Data.Tuple, Data.Func, Data.Error
import Data.Maybe, Data.Functor, Data.Tuple, Data.Func, Data.Error
import iTasks.Internal.IWorld
import iTasks.Internal.Client.Serialization
import iTasks.UI.Definition, iTasks.WF.Definition, iTasks.UI.JS.Encoding
import qualified Data.Map as DM
import Text, Text.GenJSON
......@@ -151,14 +152,14 @@ withClientSideInit ::
!(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 editorLinker initUI iworld of
(Ok (saplDeps, saplInit),iworld)
# extraAttr = 'DM'.fromList [("taskId", JSONString taskId)
,("editorId",JSONString (editorId dp))
,("saplDeps",JSONString saplDeps)
,("saplInit",JSONString saplInit)
]
= (Ok (UI type ('DM'.union extraAttr attr) items,mask), {VSt|vst & iworld = iworld})
(Error e,iworld)
= (Error e, {VSt|vst & iworld = iworld})
(Error e,vst) = (Error e,vst)
(Ok (UI type attr items,mask),vst=:{VSt|iworld}) -> case serialize_for_client 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
......@@ -9,14 +9,9 @@
<link rel="stylesheet" href="/css/itasks-theme-gray.css" type="text/css" >
<!-- Sapl dependencies -->
<script type="text/javascript" src="/js/sapl-utils.js"></script>
<script type="text/javascript" src="/js/sapl-builtin.js"></script>
<script type="text/javascript" src="/js/sapl-dynamic.js"></script>
<script type="text/javascript" src="/js/sapl-itasks.js"></script>
<script type="text/javascript" src="/js/sapl-rt.js"></script>
<script type="text/javascript" src="/js/sapl-support.js"></script>
<script type="text/javascript" src="/js/sapl-debug.js"></script>
<!-- ABC interpreter -->
<script type="text/javascript" src="/js/abc-instructions.js"></script>
<script type="text/javascript" src="/js/abc-interpreter.js"></script>
<!-- iTasks framework -->
<script type="text/javascript" src="/js/itasks-core.js"></script>
......
const abc_interpreter={
prog: undefined,
memory: undefined,
memory_buffer: undefined,
start: undefined,
code_offset: undefined,
stack_size: (512<<10)*2,
heap_size: 2<<20,
asp: undefined,
bsp: undefined,
csp: undefined,
hp: undefined,
util: undefined,
interpreter: undefined,
apply_to_elem_and_JSWorld: function (f, elem) {
this.queue.push([f,elem]);
},
queue: [],
log_buffer: '',
log: function (s) {
s=String(s);
abc_interpreter.log_buffer+=s;
if (s.indexOf('\n')>=0) {
var lines=abc_interpreter.log_buffer.split('\n');
for (var i=0; i<lines.length-1; i++)
console.log(lines[i]);
abc_interpreter.log_buffer=lines[lines.length-1];
}
},
empty_log_buffer: function(){
if (abc_interpreter.log_buffer.length>0)
console.log(abc_interpreter.log_buffer);
},
};
fetch('js/app.ubc').then(function(resp){
if (!resp.ok)
throw 'failed to fetch bytecode';
return resp.arrayBuffer();
}).then(function(bytecode){
abc_interpreter.prog=new Uint32Array(bytecode);
abc_interpreter.asp=4*abc_interpreter.prog.length;
abc_interpreter.bsp=abc_interpreter.asp+abc_interpreter.stack_size;
abc_interpreter.csp=abc_interpreter.asp+abc_interpreter.stack_size/2;
abc_interpreter.hp=abc_interpreter.bsp+8;
const blocks_needed=Math.floor((abc_interpreter.prog.length*4 + abc_interpreter.stack_size + abc_interpreter.heap_size*2 + 65535) / 65536);
abc_interpreter.memory=new WebAssembly.Memory({initial: blocks_needed});
abc_interpreter.memory_buffer=new Uint32Array(abc_interpreter.memory.buffer);
for (var i in abc_interpreter.prog)
abc_interpreter.memory_buffer[i]=abc_interpreter.prog[i];
(function(prog){
var i=0;
while (prog.length > 0) {
if (prog[0]==1) /* ST_Code section; see ABCInterpreter's bcprelink.c */
abc_interpreter.code_offset=i+1;
if (prog[0]==3) /* ST_Start */
abc_interpreter.start=prog[2];
i+=1+prog[1];
prog=prog.slice(2+2*prog[1]);
}
})(abc_interpreter.prog);
if (abc_interpreter.start==undefined)
throw 'program has no start address'; // TODO start address actually not required here
return WebAssembly.instantiateStreaming(
fetch('js/abc-interpreter-util.wasm'),
{ clean: {
memory: abc_interpreter.memory,
debug: function(what,a,b,c) {
switch (what) {
case 0:
console.log('loop',a,'/',b,'; hp at',c);
break;
case 1:
console.log('desc',a);
break;
case 2:
console.log('hnf, arity',a);
break;
case 3:
console.log('thunk, arity',a);
break;
}
}