Commit 101f92ea authored by Steffen Michels's avatar Steffen Michels

Merge branch 'master' into typed-task-editor

parents 4c2ad310 b6bcc61e
test:
image: "camilstaps/clean:nightly"
before_script:
- install_clean.sh "bundle-complete abc-interpreter"
- install_clean_nightly.sh test
- install_clean.sh bundle-complete
- apt-get update -qq
- apt-get install -y -qq build-essential libsqlite3-dev libmariadbclient-dev-compat
script:
......
# Stopping the server #
## Manual ##
To cleanly stop the iTasks server you can can either
- Start the `shutdown` task from the `iTasks.WF.Tasks.System` module, the server will stop with the specified exit code.
- Send a SIGINT or SIGTERM signal to the application (i.e. by pressing CTRL+C), the server will stop with exit code 1
This will gracefully close all connections and stop the server.
Other ways of stopping the server (e.g. sending a SIGKILL signal) may result
in corrupted data for shares and tasks.
## Automatic ##
In some cases, the iTasks server will automatically terminate.
- If there are only startup tasks defined which are all stable the server will stop with exit code 0
- If there is an uncaught exception in a startup task the server will stop with exit code 1
definition module iTasks.Extensions.Editors.Ace
/**
* Integration of Cloud9 Ace code editor
*/
* Integration of Cloud9 Ace code editor
*/
import iTasks
import iTasks.UI.Editor
import Data.Maybe
// A drop-in replacement for textArea using ace
/**
* A drop-in replacement for textArea using Ace.
*/
aceTextArea :: Editor String
// An Ace editor with more fine-grained control
/**
* An Ace editor with more fine-grained control
*/
:: AceState =
{ lines :: ![String] //The lines of text in the editor
, cursor :: !(!Int,!Int) //The location of the cursor (<row>,<column>)
, selection :: !Maybe AceRange //A text selection is delimited by this position and the cursor position
, disabled :: !Bool //Disallow editing
{ value :: !String //* The string in the editor
, cursor :: !(!Int,!Int) //* The location of the cursor (<row>,<column>)
, selection :: !Maybe AceRange //* A text selection is delimited by this position and the cursor position
, disabled :: !Bool //* Disallow editing
}
:: AceRange =
{ start :: !(!Int,!Int)
, end :: !(!Int,!Int)
{ start :: !(!Int,!Int)
, end :: !(!Int,!Int)
}
:: AceOptions =
{ theme :: !String //The Ace theme to use
, mode :: !String //The Ace highlight mode to use
}
{ theme :: !String //* The Ace theme to use
, mode :: !String //* The Ace highlight mode to use
}
derive class iTask AceState, AceRange
......@@ -34,5 +40,4 @@ derive gDefault AceOptions
derive JSONEncode AceOptions
derive JSONDecode AceOptions
aceEditor :: Editor (!AceOptions,!AceState)
......@@ -4,7 +4,7 @@ import iTasks
import iTasks.UI.Editor, iTasks.UI.Editor.Modifiers, iTasks.UI.Definition
import iTasks.UI.JavaScript
import qualified Data.Map as DM
import Text, Data.Func, StdArray
import Data.Func, StdArray
ACE_JS_URL :== "/ace/src-noconflict/ace.js"
ACE_DEFAULT_THEME :== "ace/theme/chrome"
......@@ -20,12 +20,21 @@ gDefault{|AceOptions|} = {AceOptions|theme = ACE_DEFAULT_THEME, mode = ACE_DEFAU
derive JSONEncode AceOptions
derive JSONDecode AceOptions
:: EditEvent
= EditValue !String
| EditCursor !Int !Int
| EditSelection !(Maybe ((Int,Int), (Int,Int)))
derive JSONEncode EditEvent
derive JSONDecode EditEvent
aceTextArea :: Editor String
aceTextArea = bijectEditorValue toAce fromAce aceEditor
aceTextArea = surjectEditorValue toAce fromAce aceEditor
where
aceState = {AceState|lines = [],cursor = (0,0), selection = Nothing, disabled=False}
toAce s = (defaultValue, {AceState|aceState & lines = split "\n" s})
fromAce (_,{AceState|lines}) = join "\n" lines
aceState = {AceState|value="",cursor=(0,0),selection=Nothing,disabled=False}
toAce s Nothing = (defaultValue, {AceState|aceState & value=s})
toAce s (Just (opts,state)) = (opts, {AceState|state & value=s})
fromAce (_,{AceState|value}) _ = value
aceEditor :: Editor (!AceOptions,!AceState)
aceEditor = leafEditorToEditor
......@@ -40,7 +49,7 @@ where
# (options,state) = fromMaybe gDefault{|*|} $ editModeValue mode
//Set both state and options as attributes
# aceAttr = 'DM'.fromList
[("lines",JSONArray (map JSONString state.AceState.lines))
[("value",JSONString state.AceState.value)
,("cursor", toJSON state.AceState.cursor)
,("selection", maybe JSONNull encodeRange state.AceState.selection)
,("disabled",JSONBool state.AceState.disabled)
......@@ -61,136 +70,144 @@ where
= world
initUI` me world
# world = (me .# "noEvents" .= False) world // Flag that no events should be sent because we just received the latest value
//Create Ace editor linked to domEl
# (domEl,world) = me .# "domEl" .? world
# domEl = me .# "domEl"
# world = (domEl .# "style.width" .= "100%") world
# world = (domEl .# "style.height" .= "100%") world
# world = (domEl .# "style.margin" .= 0) world
# (editor,world) = (jsGlobal "ace.edit" .$ domEl) world
# world = (editor .# "setAutoScrollEditorIntoView" .$! True) world // fit window after resize
# (session,world) = (editor .# "getSession" .$ ()) world
# (selection,world) = (session.# "getSelection" .$ ()) world
# world = (me .# "editor" .= editor) world
//Set options
# (_,world) = (editor .# "setReadOnly" .$ me .# "attributes.disabled") world
# (_,world) = (editor .# "setTheme" .$ me .# "attributes.theme") world
# (_,world) = (session .# "setMode" .$ me .# "attributes.mode") world
# world = (editor .# "setReadOnly" .$! me .# "attributes.disabled") world
# world = (editor .# "setTheme" .$! me .# "attributes.theme") world
# world = (session .# "setMode" .$! me .# "attributes.mode") world
//Initialize state based on attributes
# (lines,world) = jsValToList` (me .# "attributes.lines") (jsValToString` "") world
# value = join "\n" lines
# (_,world) = (editor .# "setValue" .$ value) world
# world = (editor .# "setValue" .$! me .# "attributes.value") world
//Set initial cursor position
# (_,world) = (editor .# "navigateTo" .$ (me .# "attributes.cursor[0]", me .# "attributes.cursor[1]")) world
# world = (editor .# "navigateTo" .$! (me .# "attributes.cursor[0]", me .# "attributes.cursor[1]")) world
//Potentially set initial selection
# (selattr,world) = me .# "attributes.selection" .? world
# world = if (jsIsNull selattr) world ((selection .# "setSelectionRange" .$! value) world)
# world = if (jsIsNull selattr) world ((selection .# "setSelectionRange" .$! me .# "attributes.value") world)
//Add event listeners
# (cb,world) = jsWrapFun (\_ -> onChange editor me) me world
# (_,world) = (editor .# "on" .$ ("change",cb)) world
# world = (editor .# "on" .$! ("change",cb)) world
# (cb,world) = jsWrapFun (\_ -> onCursorChange selection me) me world
# (_,world) = (selection .# "on" .$ ("changeCursor",cb)) world
# world = (selection .# "on" .$! ("changeCursor",cb)) world
# (cb,world) = jsWrapFun (\_ -> onSelectionChange selection me) me world
# (_,world) = (selection .# "on" .$ ("changeSelection",cb)) world
# world = (selection .# "on" .$! ("changeSelection",cb)) world
= world
onAttributeChange me {[0]=name,[1]=value} world
# (editor,world) = me .# "editor" .? world
# editor = me .# "editor"
= case jsValToString name of
Just "lines"
# world = ((me .# "noEvents") .= True) world //Flag that no events should be sent because we just received the latest value
# (value,world) = (value .# "join" .$ "\n") world
# (_,world) = (editor .# "setValue" .$ (value,1)) world
Just "value"
# world = (me .# "noEvents" .= True) world
# world = (editor .# "setValue" .$! (value,1)) world
# world = (me .# "noEvents" .= False) world
= world
Just "cursor"
# (row,world) = value .# 0 .? world
# (col,world) = value .# 1 .? world
# (_,world) = ((editor .# "navigateTo") .$ (row,col)) world
# world = (me .# "noEvents" .= True) world
# world = (editor .# "navigateTo" .$! (value .# 0, value .# 1)) world
# world = (me .# "noEvents" .= False) world
= world
Just "selection"
# (editor,world) = me .# "editor" .? world
# (session,world) = ((editor .# "getSession") .$ ()) world
# (selection,world) = ((session .# "getSelection") .$ ()) world
| jsIsNull value
# (_,world) = ((selection .# "clearSelection") .$ ()) world
= world
| otherwise
# (_,world) = ((selection .# "setSelectionRange") .$ value) world
= world
Just "disabled"
# (_,world) = ((editor .# "setReadOnly") .$ value) world
# world = (me .# "noEvents" .= True) world
# (session,world) = (editor .# "getSession" .$ ()) world
# (selection,world) = (session .# "getSelection" .$ ()) world
# world = if (jsIsNull value)
(selection .# "clearSelection" .$! ())
(selection .# "setSelectionRange" .$! value)
world
# world = (me .# "noEvents" .= False) world
= world
Just "disabled"
= (editor .# "setReadOnly" .$! value) world
= world
onChange editor me world
# (noEvents,world) = me .# "noEvents" .? world
| (not (jsIsUndefined noEvents)) && jsValToBool` True noEvents
| jsValToBool` True noEvents
= world
# (value,world) = (editor .# "getValue" .$ ()) world
# (Just value) = jsValToString value
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
# (_,world) = ((me .# "doEditEvent") .$ (taskId,editorId,toJSON ("lines",value))) world
# world = (me .# "doEditEvent" .$!
( me .# "attributes.taskId"
, me .# "attributes.editorId"
, toJSON (EditValue value)
)) world
= world
onCursorChange selection me world
# (cursor,world) = ((selection.# "getCursor") .$ ()) world
# (noEvents,world) = me .# "noEvents" .? world
| jsValToBool` True noEvents
= world
# (cursor,world) = (selection .# "getCursor" .$ ()) world
# (row,world) = cursor .# "row" .? world
# (column,world) = cursor .# "column" .? world
# (Just row) = jsValToInt row
# (Just column) = jsValToInt column
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
# (_,world) = ((me .# "doEditEvent") .$ (taskId,editorId,toJSON ("cursor",row,column))) world
# (_,world) = (me .# "doEditEvent" .$
( me .# "attributes.taskId"
, me .# "attributes.editorId"
, toJSON (EditCursor row column)
)) world
= world
onSelectionChange selection me world
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
# (noEvents,world) = me .# "noEvents" .? world
| jsValToBool` True noEvents
= world
# (empty,world) = (selection .# "isEmpty" .$ ()) world
| jsValToBool` True empty
# (_,world) = ((me .# "doEditEvent") .$ (taskId,editorId,toJSON ("selection",JSONNull))) world
= world
| otherwise
# (range,world) = ((selection.# "getRange") .$ ()) world
# (start,world) = range.# "start" .? world
# (end,world) = range.# "end" .? world
# (srow,world) = start .# "row" .? world
# (scol,world) = start .# "column" .? world
# (erow,world) = end .# "row" .? world
# (ecol,world) = end .# "column" .? world
# (Just srow) = jsValToInt srow
# (Just scol) = jsValToInt scol
# (Just erow) = jsValToInt erow
# (Just ecol) = jsValToInt ecol
# (_,world) = ((me .# "doEditEvent") .$ (taskId,editorId,toJSON ("selection",(srow,scol),(erow,ecol)))) world
= world
onEdit dp ([], [JSONString "lines", JSONString text]) (o, s) vst
= (Ok (NoChange, (o,{AceState|s & lines = split "\n" text})), vst)
onEdit dp ([], [JSONString "cursor",JSONInt row,JSONInt col]) (o, s) vst
= (me .# "doEditEvent" .$!
( me .# "attributes.taskId"
, me .# "attributes.editorId"
, toJSON (EditSelection Nothing)
)) world
# (range,world) = (selection.# "getRange" .$ ()) world
# (srow,world) = range .# "start.row" .? world
# (scol,world) = range .# "start.column" .? world
# (erow,world) = range .# "end.row" .? world
# (ecol,world) = range .# "end.column" .? world
# (Just srow) = jsValToInt srow
# (Just scol) = jsValToInt scol
# (Just erow) = jsValToInt erow
# (Just ecol) = jsValToInt ecol
= (me .# "doEditEvent" .$!
( me .# "attributes.taskId"
, me .# "attributes.editorId"
, toJSON (EditSelection (Just ((srow,scol), (erow,ecol))))
)) world
onEdit dp ([], EditValue text) (o, s) vst
= (Ok (NoChange, (o,{AceState|s & value = text})), vst)
onEdit dp ([], EditCursor row col) (o, s) vst
= (Ok (NoChange, (o,{AceState|s & cursor = (row,col)})),vst)
onEdit dp ([], [JSONString "selection",JSONNull]) (o, s) vst
onEdit dp ([], EditSelection Nothing) (o, s) vst
= (Ok (NoChange, (o,{AceState|s & selection = Nothing})), vst)
onEdit dp ([],[JSONString "selection",JSONArray [JSONInt srow,JSONInt scol],JSONArray [JSONInt erow,JSONInt ecol]]) (o,s) vst
onEdit dp ([], EditSelection (Just ((srow,scol),(erow,ecol)))) (o,s) vst
# selection = {AceRange|start=(srow,scol),end=(erow,ecol)}
= (Ok (NoChange, (o,{AceState|s & selection = Just selection})), vst)
onEdit _ (_, e) _ vst = (Error $ "Invalid event for Ace editor: " +++ toString (toJSON e), vst)
onRefresh dp r=:(_,rs) v=:(_,vs) vst
//Check if nothing changed
| r === v = (Ok (NoChange, r),vst)
//Determine which parts changed
# lineChange = if (rs.AceState.lines === vs.AceState.lines)
[] [SetAttribute "lines" (JSONArray (map JSONString rs.AceState.lines))]
//Cursor change
onEdit _ (_, _) _ vst = (Error $ "Invalid event for Ace editor", vst)
onRefresh dp r=:(_,rs) (_,vs) vst
// Determine which parts changed
# lineChange = if (rs.AceState.value === vs.AceState.value)
[] [SetAttribute "value" (JSONString rs.AceState.value)]
# cursorChange = if (rs.AceState.cursor === vs.AceState.cursor)
[] [SetAttribute "cursor" (toJSON rs.AceState.cursor)]
//Selection change
# selectionChange = if (rs.AceState.selection === vs.AceState.selection)
[] [SetAttribute "selection" (maybe JSONNull encodeRange rs.AceState.selection)]
//Disabled change
# disabledChange = if (rs.AceState.disabled == vs.AceState.disabled)
[] [SetAttribute "disabled" (JSONBool rs.AceState.disabled)]
= (Ok (ChangeUI (flatten [lineChange,cursorChange,selectionChange,disabledChange]) [], r),vst)
// Build change event
# changes = flatten [lineChange,cursorChange,selectionChange,disabledChange]
# change = if (isEmpty changes) NoChange (ChangeUI changes [])
= (Ok (change, r),vst)
encodeRange {AceRange|start=(srow,scol),end=(erow,ecol)}
= JSONObject [("start",JSONObject [("row",JSONInt srow),("column",JSONInt scol)])
......
......@@ -256,16 +256,21 @@ where
onBeforeChildRemove me args world
# (layer,world) = args.[1] .# "layer" .? world
// for windows, based on control class
# (removeMethod, world) = layer .# "remove" .? world
| not (jsIsUndefined removeMethod) = (layer .# "remove" .$! ()) world
// for all other objects
//If there is an attached popup remove it first
# world = removePopup layer world
// for windows, based on control class
# (removeMethod, world) = layer .# "remove" .? world
| not (jsIsUndefined removeMethod) = (layer .# "remove" .$! ()) world
// for all other objects
# (mapObj,world) = me .# "map" .? world
# world = (mapObj.# "removeLayer" .$! layer) world
# (popup, world) = layer .# "myPopup" .? world
| jsIsUndefined popup = world
# world = (mapObj.# "removeLayer" .$! popup) world
= world
# world = (mapObj.# "removeLayer" .$! layer) world
= world
where
removePopup layer world
# (popup, world) = layer .# "myPopup" .? world
| jsIsUndefined popup = world
# (mapObj,world) = me .# "map" .? world
= (mapObj.# "removeLayer" .$! popup) world
onWindowRemove me windowId _ world
// remove children from iTasks component
......
......@@ -3,9 +3,14 @@ definition module iTasks.Internal.EngineTasks
* This module defines the separate system tasks that the iTasks engine performs
*/
from iTasks.WF.Definition import :: Task
from iTasks.Internal.Generic.Visualization import generic gText, :: TextFormat
from iTasks.Internal.IWorld import :: IWorld
from Data.Maybe import :: Maybe
removeOutdatedSessions :: Task ()
flushWritesWhenIdle:: Task ()
stopOnStable :: Task ()
printStdErr :: v !*IWorld -> *IWorld | gText{|*|} v
......@@ -81,15 +81,10 @@ flushWritesWhenIdle = everyTick \iworld->case read taskEvents EmptyContext iworl
(Ok _,iworld) = (Ok (),iworld)
//When we don't run the built-in HTTP server we don't want to loop forever so we stop the loop
//once all tasks are stable
//once all non-system tasks are stable
stopOnStable :: Task ()
stopOnStable = everyTick \iworld->case read (sdsFocus {InstanceFilter|defaultValue & includeProgress=True, includeStartup=True, includeAttributes=True} filteredInstanceIndex) EmptyContext iworld of
(Ok (ReadingDone index), iworld)
# iworld = case exceptions index of
[] = iworld
excs
# (_, world) = fclose (stderr <<< join "\n" excs <<< "\n") iworld.world
= {IWorld | iworld & world=world, shutdown=Just 1}
# iworld = if (isNothing iworld.shutdown && all isStable (filter (not o isSystem) index))
{IWorld | iworld & shutdown=Just 0}
iworld
......@@ -103,5 +98,7 @@ where
isSystem (_, _, Just {InstanceProgress|value}, attributes) = member "system" (fromMaybe newMap attributes)
isSystem _ = False
exceptions instances = [e\\(_, _, Just {InstanceProgress|value=Exception e}, _)<-instances]
printStdErr :: v !*IWorld -> *IWorld | gText{|*|} v
printStdErr v iw=:{world}
= {iw & world=snd (fclose (stderr <<< toSingleLineText v <<< "\n") world)}
......@@ -7,6 +7,7 @@ import iTasks.Internal.Store, iTasks.Internal.TaskStore, iTasks.Internal.Util
import iTasks.UI.Layout
import iTasks.Internal.SDSService
import iTasks.Internal.Util
import iTasks.Internal.EngineTasks
from iTasks.WF.Combinators.Core import :: SharedTaskList
from iTasks.WF.Combinators.Core import :: ParallelTaskType(..), :: ParallelTask(..)
......@@ -65,6 +66,7 @@ processEvents max iworld
(Error msg,iworld=:{IWorld|world})
= (Ok (),{IWorld|iworld & world = world})
derive gText InstanceType
evalTaskInstance :: !InstanceNo !Event !*IWorld -> (!MaybeErrorString (TaskValue DeferredJSON),!*IWorld)
evalTaskInstance instanceNo event iworld
# iworld = mbResetUIState instanceNo event iworld
......@@ -141,6 +143,9 @@ where
NoChange = (Ok value,iworld)
change = (Ok value, queueUIChange instanceNo change iworld)
ExceptionResult (e,description)
# iworld = if (type =: StartupInstance)
(printStdErr description {iworld & shutdown=Just 1})
iworld
= exitWithException instanceNo description iworld
DestroyedResult
= (Ok NoValue, iworld)
......
......@@ -435,7 +435,7 @@ where
*(!.ioChannels, !*IWorld)
-> *IWorld
taskStateException mbTaskState instanceNo ioStates closeIO (ioChannels, iworld)
# iworld = iShow ["Exception in TaskServer: taskStateException: " +++ fromError mbTaskState] iworld
# iworld = iShow ["Exception in TaskServer: taskStateException: " <+++ fromError mbTaskState <+++ " " <+++ instanceNo] iworld
# iworld = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
# ioStates = put taskId (IOException (fromError mbTaskState)) ioStates
= closeIO (ioChannels, {iworld & ioStates = ioStates})
......@@ -447,7 +447,7 @@ where
*(!.ioChannels, !*IWorld)
-> *IWorld
sdsException mbSdsErr instanceNo ioStates closeIO (ioChannels, iworld)
# iworld = iShow ["Exception in TaskServer: sdsException: " +++ snd (fromError mbSdsErr)] iworld
# iworld = iShow ["Exception in TaskServer: sdsException: " <+++ snd (fromError mbSdsErr) <+++ " " <+++ instanceNo] iworld
# iworld = if (instanceNo > 0) (queueRefresh [(taskId, "Exception for " <+++ instanceNo)] iworld) iworld
# ioStates = put taskId (IOException (snd (fromError mbSdsErr))) ioStates
= closeIO (ioChannels, {iworld & ioStates = ioStates})
......
......@@ -62,7 +62,7 @@ injectEditorValue :: !(a -> b) !(b -> MaybeErrorString a) !(Editor b) -> Editor
/**
* Map the value of an editor to another domain which is 'smaller' than the original domain
*/
surjectEditorValue :: !(a -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
surjectEditorValue :: !(a (Maybe b) -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
/**
* Map the value of an editor to another domain, without mapping changes in the editor back
......
......@@ -161,11 +161,12 @@ where
= (Ok (mergeUIChanges change attrChange, st), vst)
_ = (Ok (change, st), vst)
surjectEditorValue :: !(a -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
surjectEditorValue tof fromf {Editor|genUI=editorGenUI,onEdit=editorOnEdit,onRefresh=editorOnRefresh,valueFromState=editorValueFromState} = editorModifierWithStateToEditor
{EditorModifierWithState|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh,valueFromState=valueFromState}
surjectEditorValue :: !(a (Maybe b) -> b) !(b (Maybe a) -> a) !(Editor b) -> Editor a | JSONEncode{|*|}, JSONDecode{|*|} a
surjectEditorValue tof fromf {Editor|genUI=editorGenUI,onEdit=editorOnEdit,onRefresh=editorOnRefresh,valueFromState=editorValueFromState}
= editorModifierWithStateToEditor
{EditorModifierWithState|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh,valueFromState=valueFromState}
where
genUI attr dp mode vst = case editorGenUI attr dp (mapEditMode tof mode) vst of
genUI attr dp mode vst = case editorGenUI attr dp (mapEditMode (\a -> tof a Nothing) mode) vst of
(Error e,vst) = (Error e,vst)
//Track value of the 'outer' editor
(Ok (ui, st),vst) = (Ok (ui, editModeValue mode, st), vst)
......@@ -174,7 +175,7 @@ where
(Error e, vst) = (Error e, vst)
(Ok (change, st),vst) = (Ok (change, updatedState mbOldA st, st), vst)
onRefresh dp newA _ st vst = case editorOnRefresh dp (tof newA) st vst of
onRefresh dp newA _ st vst = case editorOnRefresh dp (tof newA (editorValueFromState st)) st vst of
(Error e, vst) = (Error e, vst)
(Ok (change, st), vst) = (Ok (change, updatedState (Just newA) st, st), vst)
......
......@@ -315,6 +315,19 @@ const ABC={
},
addresses: {},
get_trace: function() {
var trace=[' {0}',ABC.interpreter.instance.exports.get_pc()/8-ABC.code_offset,'\n'];
var csp=ABC.interpreter.instance.exports.get_csp();
for (var i=1; i<=ABC_TRACE_LENGTH; i++) {
var addr=ABC.memory_array[csp/4];
if (addr==0)
break;
trace.push(' {'+i+'}',addr/8-ABC.code_offset,'\n');
csp-=8;
}
return trace;
},
};
ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
......@@ -342,9 +355,8 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
}
})(ABC.prog);
return WebAssembly.instantiateStreaming(
fetch('js/abc-interpreter-util.wasm'),
{ clean: {
const util_imports={
clean: {
memory: ABC.memory,
has_host_reference: function (index) {
......@@ -394,8 +406,12 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
case 3: console.log('thunk, arities',a,b,c); break;
}
}
}}
);
}
};
return fetch('js/abc-interpreter-util.wasm')
.then(response => response.arrayBuffer())
.then(buffer => WebAssembly.instantiate(buffer, util_imports));
}).then(function(util){
ABC.util=util;
......@@ -594,9 +610,9 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
}
};
return WebAssembly.instantiateStreaming(
fetch('js/abc-interpreter.wasm'),
interpreter_imports);
return fetch('js/abc-interpreter.wasm')
.then(response => response.arrayBuffer())
.then(bytes => WebAssembly.instantiate(bytes, interpreter_imports));
}).then(function(intp){
ABC.interpreter=intp;
......@@ -648,16 +664,7 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
(e.fileName!='abc-interpreter.js' || e.lineNumber>700))
throw e;
var trace=[e.message, '\n'];
trace.push(' {0}', ABC.interpreter.instance.exports.get_pc()/8-ABC.code_offset,'\n');
var csp=ABC.interpreter.instance.exports.get_csp();
for (var i=1; i<=ABC_TRACE_LENGTH; i++) {
var addr=ABC.memory_array[csp/4];
if (addr==0)
break;
trace.push(' {'+i+'}',addr/8-ABC.code_offset,'\n');
csp-=8;
}
var trace=[e.message, '\n'].concat(ABC.get_trace());
console.error.apply(null,trace);
throw e.toString();
......
......@@ -15,4 +15,3 @@ traceValue :: a -> Task a | iTask a
* @param The exit code of the server process
*/
shutDown :: Int -> Task ()