From b2e4301cf398419a80dbbbf11fc0c456cb6eb9b6 Mon Sep 17 00:00:00 2001 From: Fons van der Plas Date: Fri, 27 Mar 2020 23:21:28 +0100 Subject: [PATCH 1/3] =?UTF-8?q?=F0=9F=9A=9A=20Moved=20reactivty=20from=20f?= =?UTF-8?q?unction=20def=20to=20call?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Pluto.jl | 3 +- src/react/Cell.jl | 9 +- src/react/ExploreExpression.jl | 86 ++++++--- src/react/ModuleManager.jl | 17 +- src/react/Notebook.jl | 18 +- src/react/React.jl | 317 ++++++++++++++++++++++---------- src/webserver/NotebookServer.jl | 2 + test/ExploreExpression.jl | 191 ++++++++++++------- test/React.jl | 79 +++++++- 9 files changed, 511 insertions(+), 211 deletions(-) diff --git a/src/Pluto.jl b/src/Pluto.jl index 269fdf8227..d3f29d8a59 100644 --- a/src/Pluto.jl +++ b/src/Pluto.jl @@ -13,9 +13,10 @@ const VERSION_STR = 'v' * Pkg.TOML.parsefile(joinpath(PKG_ROOT_DIR, "Project.tom https://github.com/fonsp/Pluto.jl \n""" +include("./react/ExploreExpression.jl") +using .ExploreExpression include("./react/Cell.jl") include("./react/Notebook.jl") -include("./react/ExploreExpression.jl") include("./react/ModuleManager.jl") include("./react/React.jl") diff --git a/src/react/Cell.jl b/src/react/Cell.jl index f19b856843..55aca66e99 100644 --- a/src/react/Cell.jl +++ b/src/react/Cell.jl @@ -10,17 +10,20 @@ mutable struct Cell output::Any runtime::Union{Missing,UInt64} errormessage::Any - modified_symbols::Set{Symbol} - referenced_symbols::Set{Symbol} + symstate::SymbolsState + resolved_funccalls::Set{Symbol} + resolved_symstate::SymbolsState module_usings::Set{Expr} end +Cell(uuid, code) = Cell(uuid, code, nothing, nothing, missing, nothing, SymbolsState(), Set{Symbol}(), SymbolsState(), Set{Expr}()) + "Turn a `Cell` into an object that can be serialized using `JSON.json`, to be sent to the client." function serialize(cell::Cell) Dict(:uuid => string(cell.uuid), :code => cell.code)# , :output => cell.output) end -createcell_fromcode(code::String) = Cell(uuid1(), code, nothing, nothing, missing, nothing, Set{Symbol}(), Set{Symbol}(), Set{Expr}()) +createcell_fromcode(code::String) = Cell(uuid1(), code) function relay_output!(cell::Cell, output::Any) cell.output = output diff --git a/src/react/ExploreExpression.jl b/src/react/ExploreExpression.jl index 393ee003a0..a560d1d46f 100644 --- a/src/react/ExploreExpression.jl +++ b/src/react/ExploreExpression.jl @@ -11,8 +11,14 @@ const modifiers = [:(+=), :(-=), :(*=), :(/=), :(//=), :(^=), :(÷=), :(%=), :(< mutable struct SymbolsState references::Set{Symbol} assignments::Set{Symbol} + funccalls::Set{Symbol} + funcdefs::Dict{Symbol,SymbolsState} end +SymbolsState(references, assignments, funccalls) = SymbolsState(references, assignments, funccalls, Dict{Symbol,SymbolsState}()) +SymbolsState(references, assignments) = SymbolsState(references, assignments, Set{Symbol}()) +SymbolsState() = SymbolsState(Set{Symbol}(), Set{Symbol}()) + "ScopeState moves _up_ the ASTree: it carries scope information up towards the endpoints" mutable struct ScopeState inglobalscope::Bool @@ -20,8 +26,19 @@ mutable struct ScopeState hiddenglobals::Set{Symbol} end +function union(a::Dict{Symbol,SymbolsState}, b::Dict{Symbol,SymbolsState}) + c = Dict{Symbol,SymbolsState}() + for (k, v) in a + c[k] = v + end + for (k, v) in b + c[k] = v + end + c +end + function union(a::SymbolsState, b::SymbolsState) - SymbolsState(a.references ∪ b.references, a.assignments ∪ b.assignments) + SymbolsState(a.references ∪ b.references, a.assignments ∪ b.assignments, a.funccalls ∪ b.funccalls, a.funcdefs ∪ b.funcdefs) end function union(a::ScopeState, b::ScopeState) @@ -29,14 +46,14 @@ function union(a::ScopeState, b::ScopeState) end function ==(a::SymbolsState, b::SymbolsState) - a.references == b.references && a.assignments == b.assignments + a.references == b.references && a.assignments == b.assignments&& a.funccalls == b.funccalls && a.funcdefs == b.funcdefs end function will_assign_global(assignee::Symbol, scopestate::ScopeState)::Bool (scopestate.inglobalscope || assignee in scopestate.exposedglobals) && !(assignee in scopestate.hiddenglobals) end -function get_global_assignees(assignee_exprs, scopestate::ScopeState) +function get_global_assignees(assignee_exprs, scopestate::ScopeState)::Set{Symbol} global_assignees = Set{Symbol}() for ae in assignee_exprs if isa(ae, Symbol) @@ -88,7 +105,7 @@ end # 1 is a value (Int64) function explore!(value, scopestate::ScopeState)::SymbolsState # includes: LineNumberNode, Int64, String, - return SymbolsState(Set{Symbol}(), Set{Symbol}()) + return SymbolsState(Set{Symbol}(), Set{Symbol}(), Set{Symbol}(), Dict{Symbol,SymbolsState}()) end # Possible leaf: symbol @@ -98,16 +115,16 @@ end # Therefore, this method only handles _references_, which are added to the symbolstate, depending on the scopestate. function explore!(sym::Symbol, scopestate::ScopeState)::SymbolsState return if !(sym in scopestate.hiddenglobals) - SymbolsState(Set([sym]), Set{Symbol}()) + SymbolsState(Set([sym]), Set{Symbol}(), Set{Symbol}(), Dict{Symbol,SymbolsState}()) else - SymbolsState(Set{Symbol}(), Set{Symbol}()) + SymbolsState(Set{Symbol}(), Set{Symbol}(), Set{Symbol}(), Dict{Symbol,SymbolsState}()) end end # General recursive method. Is never a leaf. # Modifies the `scopestate`. function explore!(ex::Expr, scopestate::ScopeState)::SymbolsState - symstate = SymbolsState(Set{Symbol}(), Set{Symbol}()) + symstate = SymbolsState(Set{Symbol}(), Set{Symbol}(), Set{Symbol}(), Dict{Symbol,SymbolsState}()) if ex.head == :(=) # Does not create scope @@ -117,7 +134,7 @@ function explore!(ex::Expr, scopestate::ScopeState)::SymbolsState elseif isa(ex.args[1], Expr) if ex.args[1].head == :tuple # (x, y) = (1, 23) - filter(s -> s isa Symbol, ex.args[1].args) + filter(s->s isa Symbol, ex.args[1].args) elseif ex.args[1].head == :(::) # TODO: type is referenced [ex.args[1].args[1]] @@ -223,14 +240,29 @@ function explore!(ex::Expr, scopestate::ScopeState)::SymbolsState global_assignees = get_global_assignees([funcname], scopestate) # Because we are entering a new scope, we create a copy of the current scope state, and run it through the expressions. + innerscopestate = deepcopy(scopestate) innerscopestate.hiddenglobals = union(innerscopestate.hiddenglobals, extractfunctionarguments(funcroot)) innerscopestate.inglobalscope = false - for a in ex.args[2:end] - innersymstate = explore!(a, innerscopestate) + + innersymstate = explore!(Expr(:block, ex.args[2:end]...), innerscopestate) + + if funcname in global_assignees + symstate.funcdefs[funcname] = innersymstate + else + # The function is not defined globally. However, the function can still modify the global scope or reference globals, e.g. + + # let + # function f(x) + # global z = x + a + # end + # f(2) + # end + + # so we insert the function's inner symbol state here, as if it was a `let` block. symstate = symstate ∪ innersymstate end - + scopestate.hiddenglobals = union(scopestate.hiddenglobals, global_assignees) symstate.assignments = union(symstate.assignments, global_assignees) @@ -238,19 +270,21 @@ function explore!(ex::Expr, scopestate::ScopeState)::SymbolsState elseif ex.head == :(->) # Creates local scope + tempname = Symbol("anon",rand(UInt64)) + + # We will rewrite this to a normal function definition, with a temporary name funcroot = ex.args[1] - - - # Because we are entering a new scope, we create a copy of the current scope state, and run it through the expressions. - innerscopestate = deepcopy(scopestate) - innerscopestate.hiddenglobals = union(innerscopestate.hiddenglobals, extractfunctionarguments(funcroot)) - innerscopestate.inglobalscope = false - for a in ex.args[2:end] - innersymstate = explore!(a, innerscopestate) - symstate = symstate ∪ innersymstate + args_ex = if funcroot isa Symbol || (funcroot isa Expr && funcroot.head == :(::)) + [funcroot] + elseif funcroot.head == :tuple + funcroot.args + else + @error "Unknown lambda type" end - return symstate + equiv_func = Expr(:function, Expr(:call, tempname, args_ex...), ex.args[2]) + + return explore!(equiv_func, scopestate) elseif ex.head == :global # Does not create scope @@ -350,6 +384,14 @@ function explore!(ex::Expr, scopestate::ScopeState)::SymbolsState symstate = innersymstate ∪ SymbolsState(Set{Symbol}([Symbol("@md_str")]), Set{Symbol}()) + return symstate + elseif ex.head == :call && ex.args[1] isa Symbol + # Does not create scope + + # We change the `call` to a `block` and recurse again (hitting the fallback below). + # In particular, this adds the called function as a reference, which is what we want. + symstate = explore!(Expr(:block, ex.args...), scopestate) + push!(symstate.funccalls, ex.args[1]) return symstate else # fallback, includes: @@ -368,7 +410,7 @@ function explore!(ex::Expr, scopestate::ScopeState)::SymbolsState end -function compute_symbolreferences(ex) +function compute_symbolreferences(ex)::SymbolsState explore!(ex, ScopeState(true, Set{Symbol}(), Set{Symbol}())) end diff --git a/src/react/ModuleManager.jl b/src/react/ModuleManager.jl index be28671377..974c70a1a8 100644 --- a/src/react/ModuleManager.jl +++ b/src/react/ModuleManager.jl @@ -65,12 +65,17 @@ module ModuleManager for symbol in names(old_workspace, all=true, imported=true) if !forbiddenmove(symbol) && symbol != Symbol("workspace",old_index - 1) && symbol != Symbol("workspace",old_index) - if symbol in to_delete - try - Core.eval(old_workspace, :($(symbol) = nothing)) - catch; end # sometimes impossible, eg. when $symbol was constant - else - Core.eval(new_workspace, :($(symbol) = $(old_workspace_name).$(symbol))) + # Running a function definition like + # function f(x) global w = x end + # will actually add `w` to the list of `names`, even though it is not yet defined: + if isdefined(old_workspace, symbol) + if symbol in to_delete + try + Core.eval(old_workspace, :($(symbol) = nothing)) + catch; end # sometimes impossible, eg. when $symbol was constant + else + Core.eval(new_workspace, :($(symbol) = $(old_workspace_name).$(symbol))) + end end end end diff --git a/src/react/Notebook.jl b/src/react/Notebook.jl index 4154410ba5..b03345ddd5 100644 --- a/src/react/Notebook.jl +++ b/src/react/Notebook.jl @@ -2,18 +2,20 @@ using UUIDs mutable struct Notebook path::String - + "Cells are ordered in a `Notebook`, and this order can be changed by the user. Cells will always have a constant UUID." cells::Array{Cell,1} - + uuid::UUID + combined_funcdefs::Union{Nothing,Dict{Symbol, SymbolsState}} + # buffer must contain all undisplayed outputs pendingupdates::Channel end # We can keep 128 updates pending. After this, any put! calls (i.e. calls that push an update to the notebook) will simply block, which is fine. # This does mean that the Notebook can't be used if nothing is clearing the update channel. -Notebook(path::String, cells::Array{Cell,1}, uuid) = Notebook(path, cells, uuid, Channel(128)) -Notebook(path::String, cells::Array{Cell,1}) = Notebook(path, cells, uuid4(), Channel(128)) +Notebook(path::String, cells::Array{Cell,1}, uuid) = Notebook(path, cells, uuid, nothing, Channel(128)) +Notebook(path::String, cells::Array{Cell,1}) = Notebook(path, cells, uuid4(), nothing, Channel(128)) function selectcell_byuuid(notebook::Notebook, uuid::UUID)::Union{Cell,Nothing} cellIndex = findfirst(c->c.uuid == uuid, notebook.cells) @@ -29,7 +31,7 @@ _uuid_delimiter = "# ⋐⋑ " _order_delimited = "# ○ " _cell_appendix = "\n\n" -emptynotebook(path) = Notebook(path, [createcell_fromcode("")], uuid4()) +emptynotebook(path) = Notebook(path, [createcell_fromcode("")]) emptynotebook() = emptynotebook(tempname() * ".jl") function samplenotebook() @@ -51,7 +53,7 @@ function samplenotebook() Apparently we had reached a great height in the atmosphere, for the sky was a dead black, and the stars had ceased to twinkle. By the same illusion which lifts the horizon of the sea to the level of the spectator on a hillside, the sable cloud beneath was dished out, and the car seemed to float in the middle of an immense dark sphere, whose upper half was strewn with silver. Looking down into the dark gulf below, I could see a ruddy light streaming through a rift in the clouds." """)) - Notebook(tempname() * ".jl", cells, uuid4()) + Notebook(tempname() * ".jl", cells) end function save_notebook(io, notebook) @@ -110,7 +112,7 @@ function load_notebook(io, path) # Change windows line endings to linux; remove the cell appendix. code_normalised = replace(code, "\r\n" => "\n")[1:end - ncodeunits(_cell_appendix)] - read_cell = Cell(uuid, code_normalised, nothing, nothing, missing, nothing, Set{Symbol}(), Set{Symbol}(), Set{Expr}()) + read_cell = Cell(uuid, code_normalised) collected_cells[uuid] = read_cell end @@ -129,7 +131,7 @@ function load_notebook(io, path) end end - Notebook(path, ordered_cells, uuid4()) + Notebook(path, ordered_cells) end function load_notebook(path::String) diff --git a/src/react/React.jl b/src/react/React.jl index 0e7f8b765a..ac781f122a 100644 --- a/src/react/React.jl +++ b/src/react/React.jl @@ -1,126 +1,247 @@ +function run_single!(initiator, notebook::Notebook, cell::Cell) + # if isa(cell.parsedcode, Expr) && cell.parsedcode.head == :using + # # Don't run this cell. We set its output directly and stop the method prematurely. + # relay_error!(cell, "Use `import` instead of `using`.\nSupport for `using` will be added soon.") + # return + # end + workspace = ModuleManager.get_workspace(notebook) + starttime = time_ns() + try + starttime = time_ns() + output = Core.eval(workspace, cell.parsedcode) + cell.runtime = time_ns() - starttime + + relay_output!(cell, output) + # TODO: capture stdout and display it somehwere, but let's keep using the actual terminal for now + catch err + cell.runtime = time_ns() - starttime + bt = stacktrace(catch_backtrace()) + relay_error!(cell, err, bt) + end + +end + "Run a cell and all the cells that depend on it" function run_reactive!(initiator, notebook::Notebook, cell::Cell) - cell.parsedcode = Meta.parse(cell.code, raise=false) - cell.module_usings = ExploreExpression.compute_usings(cell.parsedcode) - - old_modified = cell.modified_symbols - symstate = ExploreExpression.compute_symbolreferences(cell.parsedcode) - all_modified = old_modified ∪ symstate.assignments + cell.parsedcode = Meta.parse(cell.code, raise=false) + cell.module_usings = ExploreExpression.compute_usings(cell.parsedcode) - # During the upcoming search, we will temporarily use `all_modified` instead of `symstate.assignments` - # as this cell's set of assignments. This way, any variables that were deleted by this cell change - # will be deleted, and the cells that depend on the deleted variable will be run again. (Leading to errors.) - cell.modified_symbols = all_modified - cell.referenced_symbols = symstate.references + old_resolved_symstate = cell.resolved_symstate + old_symstate = cell.symstate + new_symstate = cell.symstate = ExploreExpression.compute_symbolreferences(cell.parsedcode) - modifiers = where_modified(notebook, all_modified) - remodified = length(modifiers) > 1 ? modifiers : [] + # Recompute function definitions list + # A function can have multiple definitions, each with its own SymbolsState + # These are combined into a single SymbolsState for each function name. + update_funcdefs!(notebook) - dependency_info = dependent_cells.([notebook], union(modifiers, [cell])) - will_update = union((d[1] for d in dependency_info)...) - cyclic = union((d[2] for d in dependency_info)...) + # Unfortunately, this means that you lose reactivity in situations like: - module_usings = union((c.module_usings for c in notebook.cells)...) - to_delete = union(old_modified, (c.modified_symbols for c in will_update)...) - - ModuleManager.delete_vars(notebook, to_delete, module_usings) + # f(x) = global z = x; z+2 + # g = f + # g(5) + # z - cell.modified_symbols = symstate.assignments + # TODO: function calls are also references! - for to_run in will_update - putnotebookupdates!(notebook, clientupdate_cell_running(initiator, notebook, to_run)) - end - # 😴 small nap to allow the pending updates to be sent by the other task - # sleep(0.005) - - for to_run in will_update - if to_run in remodified - modified_multiple = let - other_modifiers = setdiff(modifiers, [to_run]) - union((to_run.modified_symbols ∩ c.modified_symbols for c in other_modifiers)...) + oldnew_direct_callers = where_called(notebook, keys(new_symstate.funcdefs) ∪ keys(old_symstate.funcdefs)) + + # Next, we need to update the cached list of resolved symstates for this cell. + + # We also need to update any cells that call a function that is/was assigned by this cell. + for c in Set((cell, oldnew_direct_callers...)) + # "Resolved" means that recursive function calls are followed. + c.resolved_funccalls = all_recursed_calls!(notebook, c.symstate) + + # "Resolved" means that the `SymbolsState`s of all (recursively) called functions are included. + c.resolved_symstate = c.symstate + for func in c.resolved_funccalls + if haskey(notebook.combined_funcdefs, func) + c.resolved_symstate = notebook.combined_funcdefs[func] ∪ c.resolved_symstate end - relay_error!(to_run, "Multiple definitions for $(join(modified_multiple, ", ", " and "))") - elseif to_run in cyclic - modified_cyclic = let - referenced_during_cycle = union((c.referenced_symbols for c in cyclic)...) - modified_during_cycle = union((c.modified_symbols for c in cyclic)...) - - referenced_during_cycle ∩ modified_during_cycle + end + + # We also include the functions defined in this cell, to make sure that the function definition is re-evaluated when it uses a global variable that changed. e.g. + + # y = 1 + # f(x) = x + y + + # In a REPL, this is not necessary: `y` is evaluated when the function is called, not when it is defined. However, it is necessary in our case because we move to a new workspace for most evaluations, so the same `y` is no longer available to `f`. + for func in keys(c.resolved_symstate.funcdefs) + if haskey(notebook.combined_funcdefs, func) + c.resolved_symstate.references = notebook.combined_funcdefs[func].references ∪ c.resolved_symstate.references end - relay_error!(to_run, "Cyclic references: $(join(modified_cyclic, ", ", " and "))") - else - run_single!(initiator, notebook, to_run) end - putnotebookupdates!(notebook, clientupdate_cell_output(initiator, notebook, to_run)) end - return will_update -end - + new_resolved_symstate = cell.resolved_symstate + new_assigned = cell.resolved_symstate.assignments + all_assigned = old_resolved_symstate.assignments ∪ new_resolved_symstate.assignments + + + competing_modifiers = where_assigned(notebook, all_assigned) + reassigned = length(competing_modifiers) > 1 ? competing_modifiers : [] + + # During the upcoming search, we will temporarily use `all_assigned` instead of `new_resolved_symstate.assignments as this cell's set of assignments. This way, any variables that were deleted by this cell change will be deleted, and the cells that depend on the deleted variable will be run again. (Leading to errors. 👍) + cell.resolved_symstate.assignments = all_assigned + + dependency_info = dependent_cells.([notebook], union(competing_modifiers, [cell])) + will_update = union((d[1] for d in dependency_info)...) + cyclic = union((d[2] for d in dependency_info)...) + + # we reset the temporary assignment: + cell.resolved_symstate.assignments = new_assigned -function run_single!(initiator, notebook::Notebook, cell::Cell) - # if isa(cell.parsedcode, Expr) && cell.parsedcode.head == :using - # # Don't run this cell. We set its output directly and stop the method prematurely. - # relay_error!(cell, "Use `import` instead of `using`.\nSupport for `using` will be added soon.") - # return - # end - workspace = ModuleManager.get_workspace(notebook) - starttime = time_ns() - try - starttime = time_ns() - output = Core.eval(workspace, cell.parsedcode) - cell.runtime = time_ns() - starttime - - relay_output!(cell, output) - # TODO: capture stdout and display it somehwere, but let's keep using the actual terminal for now - catch err - cell.runtime = time_ns() - starttime - bt = stacktrace(catch_backtrace()) - relay_error!(cell, err, bt) + for to_run in will_update + putnotebookupdates!(notebook, clientupdate_cell_running(initiator, notebook, to_run)) end - + + module_usings = union((c.module_usings for c in notebook.cells)...) + to_delete = union( + old_resolved_symstate.assignments, + (c.resolved_symstate.assignments for c in will_update)..., + keys(old_resolved_symstate.funcdefs), + (keys(c.resolved_symstate.funcdefs) for c in will_update)..., + ) + + ModuleManager.delete_vars(notebook, to_delete, module_usings) + + + for to_run in will_update + if to_run in reassigned + assigned_multiple = let + other_modifiers = setdiff(competing_modifiers, [to_run]) + union((to_run.resolved_symstate.assignments ∩ c.resolved_symstate.assignments for c in other_modifiers)...) + end + relay_error!(to_run, "Multiple definitions for $(join(assigned_multiple, ", ", " and "))") + elseif to_run in cyclic + assigned_cyclic = let + referenced_during_cycle = union((c.resolved_symstate.references for c in cyclic)...) + assigned_during_cycle = union((c.resolved_symstate.assignments for c in cyclic)...) + + referenced_during_cycle ∩ assigned_during_cycle + end + relay_error!(to_run, "Cyclic references: $(join(assigned_cyclic, ", ", " and "))") + else + run_single!(initiator, notebook, to_run) + end + putnotebookupdates!(notebook, clientupdate_cell_output(initiator, notebook, to_run)) + end + + return will_update end "Cells to be evaluated in a single reactive cell run, in order - including the given cell" function dependent_cells(notebook::Notebook, root::Cell) - entries = Cell[] - exits = Cell[] - cyclic = Set{Cell}() - - function dfs(cell::Cell) - if cell in exits - return - elseif length(entries) > 0 && entries[end] == cell - return # a cell referencing itself is legal - elseif cell in entries - currently_entered = setdiff(entries, exits) - detected_cycle = currently_entered[findfirst(currently_entered .== [cell]):end] - cyclic = union(cyclic, detected_cycle) - return - end + entries = Cell[] + exits = Cell[] + cyclic = Set{Cell}() + + function dfs(cell::Cell) + if cell in exits + return + elseif length(entries) > 0 && entries[end] == cell + return # a cell referencing itself is legal + elseif cell in entries + currently_entered = setdiff(entries, exits) + detected_cycle = currently_entered[findfirst(currently_entered .== [cell]):end] + cyclic = union(cyclic, detected_cycle) + return + end + + push!(entries, cell) + dfs.(where_referenced(notebook, cell.resolved_symstate.assignments)) + push!(exits, cell) + end + + dfs(root) + return reverse(exits), cyclic +end - push!(entries, cell) - dfs.(where_referenced(notebook, cell.modified_symbols)) - push!(exits, cell) - end +function disjoint(a::Set, b::Set) + !any(x in a for x in b) +end - dfs(root) - return reverse(exits), cyclic +"Return cells that reference any of the given symbols. Recurses down functions calls, but not down cells." +function where_referenced(notebook::Notebook, symbols::Set{Symbol}) + return filter(notebook.cells) do cell + if !disjoint(symbols, cell.resolved_symstate.references) + return true + end + for func in cell.resolved_funccalls + if haskey(notebook.combined_funcdefs, func) + if !disjoint(symbols, notebook.combined_funcdefs[func].references) + return true + end + end + end + return false + end end -"Return cells that reference any of the given symbols - does *not* recurse" -function where_referenced(notebook::Notebook, symbols::Set{Symbol}) - return filter(notebook.cells) do cell - return any(s in symbols for s in cell.referenced_symbols) - end +"Return cells that assign to any of the given symbols. Recurses down functions calls, but not down cells." +function where_assigned(notebook::Notebook, symbols::Set{Symbol}) + return filter(notebook.cells) do cell + if !disjoint(symbols, cell.resolved_symstate.assignments) + return true + end + for func in cell.resolved_funccalls + if haskey(notebook.combined_funcdefs, func) + if !disjoint(symbols, notebook.combined_funcdefs[func].assignments) + return true + end + end + end + return false + end end +"Return cells that modify any of the given symbols. Recurses down functions calls, but not down cells." +function where_called(notebook::Notebook, symbols::Set{Symbol}) + return filter(notebook.cells) do cell + if !disjoint(symbols, cell.resolved_symstate.funccalls) + return true + end + for func in cell.resolved_funccalls + if haskey(notebook.combined_funcdefs, func) + if !disjoint(symbols, notebook.combined_funcdefs[func].funccalls) + return true + end + end + end + return false + end +end -"Return cells that modify any of the given symbols" -function where_modified(notebook::Notebook, symbols::Set{Symbol}) - return filter(notebook.cells) do cell - return any(s in symbols for s in cell.modified_symbols) - end -end \ No newline at end of file +function update_funcdefs!(notebook::Notebook) + # TODO: optimise + combined = notebook.combined_funcdefs = Dict{Symbol, SymbolsState}() + + for cell in notebook.cells + for (func, symstate) in cell.symstate.funcdefs + if haskey(combined, func) + combined[func] = symstate ∪ combined[func] + else + combined[func] = symstate + end + end + end +end + +function all_recursed_calls!(notebook::Notebook, symstate::SymbolsState, found::Set{Symbol}=Set{Symbol}()) + for func in symstate.funccalls + if func in found + # done + else + push!(found, func) + if haskey(notebook.combined_funcdefs, func) + inner_symstate = notebook.combined_funcdefs[func] + all_recursed_calls!(notebook, inner_symstate, found) + end + end + end + + return found +end diff --git a/src/webserver/NotebookServer.jl b/src/webserver/NotebookServer.jl index a060653afe..cd0acaa5e3 100644 --- a/src/webserver/NotebookServer.jl +++ b/src/webserver/NotebookServer.jl @@ -190,6 +190,8 @@ function run(port = 1234, launchbrowser = false) catch ex if ex isa InterruptException rethrow(ex) + elseif ex isa IOError + # that's fine! elseif ex isa ArgumentError && occursin("stream is closed", ex.msg) # that's fine! else diff --git a/test/ExploreExpression.jl b/test/ExploreExpression.jl index c563a62f92..b2510762f5 100644 --- a/test/ExploreExpression.jl +++ b/test/ExploreExpression.jl @@ -2,9 +2,30 @@ using Test using Pluto import Pluto.ExploreExpression: SymbolsState, compute_symbolreferences -function testee(expr, ref, def, verbose=true) - expected = SymbolsState(Set(ref), Set(def)) +function testee(expr, ref, def, funccalls, funcdefs, verbose=true) + funcdefs_dict = map(funcdefs) do (k, v) + k => if v isa SymbolsState + v + else + SymbolsState(Set(v[1]), Set(v[2]), Set(v[3])) + end + end |> Dict + expected = SymbolsState(Set(ref), Set(def), Set(funccalls), funcdefs_dict) result = compute_symbolreferences(expr) + + # Anonymous function are given a random name, which looks like anon67387237861123 + # To make testing easier, we rename all such functions to anon + new_name(sym) = startswith(string(sym), "anon") ? :anon : sym + + result.assignments = Set(new_name.(result.assignments)) + result.funcdefs = let + newfuncdefs = Dict() + for (k,v) in result.funcdefs + newfuncdefs[new_name(k)] = v + end + newfuncdefs + end + if verbose && expected != result println() println("FAILED TEST") @@ -25,101 +46,129 @@ end @testset "Explore Expressions" begin @testset "Basics" begin - @test testee(:(a), [:a], []) - @test testee(:(1 + 1), [:+], []) - @test testee(:(x = 3), [], [:x]) - @test testee(:(x = x), [:x], [:x]) - @test testee(:(x = 1 + y), [:+, :y], [:x]) - @test testee(:(x = +(a...)), [:+, :a], [:x]) + @test testee(:(a), [:a], [], [], []) + @test testee(:(1 + 1), [:+], [], [:+], []) + @test testee(:(x = 3), [], [:x], [], []) + @test testee(:(x = x), [:x], [:x], [], []) + @test testee(:(x = 1 + y), [:+, :y], [:x], [:+], []) + @test testee(:(x = +(a...)), [:+, :a], [:x], [:+], []) - @test_nowarn testee(:(x::Int64 = 3), [], [:x, :Int64], false) + @test_nowarn testee(:(x::Int64 = 3), [], [:x, :Int64], [], [], false) end @testset "Lists and structs" begin - @test testee(:(1:3), [:(:)], []) - @test testee(:(a[1:3,4]), [:a, :(:)], []) - @test testee(:(a[1:3,4] = b[5]), [:b], []) - @test testee(:(a.property), [:a], []) - @test testee(:(a.property = 1), [], []) - @test testee(:(struct a; c; d; end), [], [:a]) + @test testee(:(1:3), [:(:)], [], [:(:)], []) + @test testee(:(a[1:3,4]), [:a, :(:)], [], [:(:)], []) + @test testee(:(a[1:3,4] = b[5]), [:b], [], [], []) + @test testee(:(a.property), [:a], [], [], []) + @test testee(:(a.property = 1), [], [], [], []) + @test testee(:(struct a; c; d; end), [], [:a], [], [ + :a => ([], [], []) + ]) - @test_nowarn testee(:(struct a <: b; c; d::Int64; end), [:b, :Int64], [:a], false) + @test_nowarn testee(:(struct a <: b; c; d::Int64; end), [:b, :Int64], [:a], [], [], false) end @testset "Modifiers" begin - @test testee(:(a = a + 1), [:a, :(+)], [:a]) - @test testee(:(a += 1), [:a, :(+)], [:a]) - @test testee(:(a[1] += 1), [:a, :(+)], []) - @test testee(:(x = let a = 1; a += b end), [:(+), :b], [:x]) + @test testee(:(a = a + 1), [:a, :(+)], [:a], [:+], []) + @test testee(:(a += 1), [:a, :(+)], [:a], [:+], []) + @test testee(:(a[1] += 1), [:a, :(+)], [], [:+], []) + @test testee(:(x = let a = 1; a += b end), [:(+), :b], [:x], [:+], []) end @testset "`for` & `while`" begin - @test testee(:(for k in 1:n; k + s; end), [:n, :s, :+, :(:)], []) - @test testee(:(for k in 1:2, r in 3:4; global z = k + r; end), [:+, :(:)], [:z]) - @test testee(:(while k < 2; r = w; global z = k + r; end), [:k, :(<), :w, :+], [:z]) + @test testee(:(for k in 1:n; k + s; end), [:n, :s, :+, :(:)], [], [:+, :(:)], []) + @test testee(:(for k in 1:2, r in 3:4; global z = k + r; end), [:+, :(:)], [:z], [:+, :(:)], []) + @test testee(:(while k < 2; r = w; global z = k + r; end), [:k, :(<), :w, :+], [:z], [:+, :(<)], []) end @testset "Comprehensions" begin - @test testee(:([sqrt(s) for s in 1:n]), [:sqrt, :n, :(:)], []) - @test testee(:([s + j + r + m for s in 1:3 for j in 4:5 for (r, l) in [(1, 2)]]), [:+, :m, :(:)], []) + @test testee(:([sqrt(s) for s in 1:n]), [:sqrt, :n, :(:)], [], [:sqrt, :(:)], []) + @test testee(:([s + j + r + m for s in 1:3 for j in 4:5 for (r, l) in [(1, 2)]]), [:+, :m, :(:)], [], [:+, :(:)], []) - @test_nowarn testee(:([a for a in a]), [:a], [], false) - @test_nowarn testee(:(a = [a for a in a]), [:a], [:a], false) + @test_nowarn testee(:([a for a in a]), [:a], [], [], [], false) + @test_nowarn testee(:(a = [a for a in a]), [:a], [:a], [], [], false) end @testset "Multiple expressions" begin - @test testee(:(x = let r = 1; r + r end), [:+], [:x]) - @test testee(:(begin let r = 1; r + r end; r = 2 end), [:+], [:r]) - @test testee(:(a, b = 1, 2), [], [:a, :b]) - @test testee(:((a, b) = 1, 2), [], [:a, :b]) - @test testee(:((a[1], b.r) = (1, 2)), [], []) - @test testee(:((k = 2; 123)), [], [:k]) - @test testee(:((a = 1; b = a + 1)), [:+], [:a, :b]) - @test testee(:(let k = 2; 123 end), [], []) + @test testee(:(x = let r = 1; r + r end), [:+], [:x], [:+], []) + @test testee(:(begin let r = 1; r + r end; r = 2 end), [:+], [:r], [:+], []) + @test testee(:(a, b = 1, 2), [], [:a, :b], [], []) + @test testee(:((a, b) = 1, 2), [], [:a, :b], [], []) + @test testee(:((a[1], b.r) = (1, 2)), [], [], [], []) + @test testee(:((k = 2; 123)), [], [:k], [], []) + @test testee(:((a = 1; b = a + 1)), [:+], [:a, :b], [:+], []) + @test testee(:((a = b = 1)), [], [:a, :b], [], []) + @test testee(:(let k = 2; 123 end), [], [], [], []) - @test_nowarn testee(:(a::Int64, b::String = 1, "2"), [:Int64, :String], [:a, :b], false) + @test_nowarn testee(:(a::Int64, b::String = 1, "2"), [:Int64, :String], [:a, :b], [], [], false) end @testset "Functions" begin - @test testee(:(function g() r = 2; r end), [], [:g]) - @test testee(:(function f(x, y = 1; r, s = 3 + 3) r + s + x * y * z end), [:z, :+, :*], [:f]) - @test testee(:(function f(x) x * y * z end), [:y, :z, :*], [:f]) - @test testee(:(function f(x) x = x / 3; x end), [:/], [:f]) - @test testee(:(f = x->x * y), [:y, :*], [:f]) - @test testee(:(f = (x, y)->x * y), [:*], [:f]) - @test testee(:(f(x, y = a + 1) = x * y * z), [:*, :z], [:f]) - @test testee(:((((a, b), c), (d, e))->a * b * c * d * e * f), [:*, :f], []) - @test testee(:(f = (x, y = a + 1)->x * y), [:*], [:f]) - @test testee(:(minimum(x) do (a, b); a + b end), [:(+), :x, :minimum], []) + @test testee(:(function g() r = 2; r end), [], [:g], [], [ + :g => ([], [], []) + ]) + @test testee(:(function f(x, y = 1; r, s = 3 + 3) r + s + x * y * z end), [], [:f], [], [ + :f => ([:z, :+, :*], [], [:+, :*]) + ]) + @test testee(:(function f(x) x * y * z end), [], [:f], [], [ + :f => ([:y, :z, :*], [], [:*]) + ]) + @test testee(:(function f(x) x = x / 3; x end), [], [:f], [], [ + :f => ([:/], [], [:/]) + ]) + @test testee(:(f(x, y = a + 1) = x * y * z), [], [:f], [], [ + :f => ([:*, :z], [], [:*]) + ]) + @test testee(:(minimum(x) do (a, b); a + b end), [:x, :minimum], [:anon], [:minimum], [ + :anon => ([:(+)], [], [:+]) + ]) + @test testee(:(f = x->x * y), [], [:f, :anon], [], [ + :anon => ([:y, :*], [], [:*]) + ]) + @test testee(:(f = (x, y)->x * y), [], [:f, :anon], [], [ + :anon => ([:*], [], [:*]) + ]) + @test testee(:(f = (x, y = a + 1)->x * y), [], [:f, :anon], [], [ + :anon => ([:*], [], [:*]) + ]) + @test testee(:((((a, b), c), (d, e))->a * b * c * d * e * f), [], [:anon], [], [ + :anon => ([:*, :f], [], [:*]) + ]) + + @test testee(:(func(b)), [:func, :b], [], [:func], []) + @test testee(:(funcs[i](b)), [:funcs, :i, :b], [], [], []) - @test_nowarn testee(:(function f(y::Int64 = a)::String string(y) end), [:Int64, :String, :string], [:f], false) - @test_nowarn testee(:(function f(x::T; k = 1) where T return x + 1 end), [:+], [:f], false) + @test_nowarn testee(:(function f(y::Int64 = a)::String string(y) end), [:Int64, :String, :string], [:f], [], [], false) + @test_nowarn testee(:(function f(x::T; k = 1) where T return x + 1 end), [:+], [:f], [], [], false) end @testset "Scope modifiers" begin - @test testee(:(let global a, b = 1, 2 end), [], [:a, :b]) - @test testee(:(let global k = 3 end), [], [:k]) - @test testee(:(let global k += 3 end), [:+, :k], [:k]) - @test testee(:(let global k; k = 4 end), [], [:k]) - @test testee(:(let global k; b = 5 end), [], []) + @test testee(:(let global a, b = 1, 2 end), [], [:a, :b], [], []) + @test testee(:(let global k = 3 end), [], [:k], [], []) + @test testee(:(let global k += 3 end), [:+, :k], [:k], [:+], []) + @test testee(:(let global k; k = 4 end), [], [:k], [], []) + @test testee(:(let global k; b = 5 end), [], [], [], []) - @test testee(:(begin local a, b = 1, 2 end), [], []) - @test testee(:(begin local k = 3 end), [], []) - @test testee(:(begin local k += 3 end), [:+], []) - @test testee(:(begin local k; k = 4 end), [], []) - @test testee(:(begin local k; b = 5 end), [], [:b]) + @test testee(:(begin local a, b = 1, 2 end), [], [], [], []) + @test testee(:(begin local k = 3 end), [], [], [], []) + @test testee(:(begin local k += 3 end), [:+], [], [:+], []) + @test testee(:(begin local k; k = 4 end), [], [], [], []) + @test testee(:(begin local k; b = 5 end), [], [:b], [], []) - @test testee(:(function f(x) global k = x end), [], [:k, :f]) - @test testee(:((begin x = 1 end, y)), [:y], [:x]) - @test testee(:(x = let global a += 1 end), [:(+), :a], [:x, :a]) + @test testee(:(function f(x) global k = x end), [], [:f], [], [ + :f => ([], [:k], []) + ]) + @test testee(:((begin x = 1 end, y)), [:y], [:x], [], []) + @test testee(:(x = let global a += 1 end), [:(+), :a], [:x, :a], [:+], []) end @testset "`import` & `using`" begin - @test testee(:(using Plots), [], [:Plots]) - @test testee(:(using JSON, UUIDs), [], [:JSON, :UUIDs]) - @test testee(:(import Pluto), [], [:Pluto]) - @test testee(:(import Pluto: wow, wowie), [], [:wow, :wowie]) + @test testee(:(using Plots), [], [:Plots], [], []) + @test testee(:(using JSON, UUIDs), [], [:JSON, :UUIDs], [], []) + @test testee(:(import Pluto), [], [:Pluto], [], []) + @test testee(:(import Pluto: wow, wowie), [], [:wow, :wowie], [], []) end @testset "Macros" begin - @test testee(:(@time a = 2), [Symbol("@time")], [:a]) - @test testee(:(html"a $(b = c)"), [Symbol("@html_str")], []) - @test testee(:(md"a $(b = c)"), [Symbol("@md_str"), :c], [:b]) - @test testee(:(md"a \$(b = c)"), [Symbol("@md_str")], []) + @test testee(:(@time a = 2), [Symbol("@time")], [:a], [], []) + @test testee(:(html"a $(b = c)"), [Symbol("@html_str")], [], [], []) + @test testee(:(md"a $(b = c)"), [Symbol("@md_str"), :c], [:b], [], []) + @test testee(:(md"a \$(b = c)"), [Symbol("@md_str")], [], [], []) end @testset "String interpolation" begin - @test testee(:("a $b"), [:b], []) - @test testee(:("a $(b = c)"), [:c], [:b]) + @test testee(:("a $b"), [:b], [], [], []) + @test testee(:("a $(b = c)"), [:c], [:b], [], []) end end \ No newline at end of file diff --git a/test/React.jl b/test/React.jl index 565de6a770..9d2112be87 100644 --- a/test/React.jl +++ b/test/React.jl @@ -9,7 +9,9 @@ import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, @testset "Basic" begin notebook = Notebook(joinpath(tempdir(), "test.jl"), [ createcell_fromcode("x = 1"), - createcell_fromcode("y = x") + createcell_fromcode("y = x"), + createcell_fromcode("f(x) = x + y"), + createcell_fromcode("f(4)"), ]) fakeclient.connected_notebook = notebook @@ -19,6 +21,20 @@ import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, notebook.cells[1].code = "x = 12" run_reactive!(fakeclient, notebook, notebook.cells[1]) @test notebook.cells[1].output == notebook.cells[2].output + + run_reactive!(fakeclient, notebook, notebook.cells[3]) + @test notebook.cells[3].errormessage == nothing + + run_reactive!(fakeclient, notebook, notebook.cells[4]) + @test notebook.cells[4].output == 16 + + notebook.cells[1].code = "x = 912" + run_reactive!(fakeclient, notebook, notebook.cells[1]) + @test notebook.cells[4].output == 916 + + notebook.cells[3].code = "f(x) = x" + run_reactive!(fakeclient, notebook, notebook.cells[3]) + @test notebook.cells[4].output == 4 end @testset "Bad code" begin @@ -67,13 +83,20 @@ import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, @testset "Recursive function is not considered cyclic" begin notebook = Notebook(joinpath(tempdir(), "test.jl"), [ - createcell_fromcode("factorial(n) = n * factorial(n-1)") + createcell_fromcode("factorial(n) = n * factorial(n-1)"), + createcell_fromcode("f(n) = g(n-1)"), + createcell_fromcode("g(n) = f(n-1)"), ]) fakeclient.connected_notebook = notebook run_reactive!(fakeclient, notebook, notebook.cells[1]) @test !isempty(methods(notebook.cells[1].output)) @test notebook.cells[1].errormessage == nothing + + run_reactive!(fakeclient, notebook, notebook.cells[2]) + run_reactive!(fakeclient, notebook, notebook.cells[3]) + @test notebook.cells[2].errormessage == nothing + @test notebook.cells[3].errormessage == nothing end @testset "Variable cannot reference its previous value" begin @@ -88,4 +111,56 @@ import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, @test notebook.cells[1].output == nothing @test occursin("UndefVarError", notebook.cells[1].errormessage) end + @testset "Immutable globals" begin + # We currently have a slightly relaxed version of immutable globals: + # globals can only be mutated/assigned _in a single cell_. + notebook = Notebook(joinpath(tempdir(), "test.jl"), [ + createcell_fromcode("x = 1"), + createcell_fromcode("x = 2"), + createcell_fromcode("y = -3; y = 3"), + createcell_fromcode("z = 4"), + createcell_fromcode("let global z = 5 end"), + createcell_fromcode("w"), + createcell_fromcode("function f(x) global w = x end"), + createcell_fromcode("f(-8); f(8)"), + createcell_fromcode("f(9)"), + ]) + fakeclient.connected_notebook = notebook + + run_reactive!(fakeclient, notebook, notebook.cells[1]) + run_reactive!(fakeclient, notebook, notebook.cells[2]) + @test notebook.cells[1].output == nothing + @test notebook.cells[2].output == nothing + @test occursin("Multiple definitions for x", notebook.cells[1].errormessage) + @test occursin("Multiple definitions for x", notebook.cells[1].errormessage) + + notebook.cells[2].code = "x + 1" + + run_reactive!(fakeclient, notebook, notebook.cells[2]) + @test notebook.cells[1].output == 1 + @test notebook.cells[2].output == 2 + + run_reactive!(fakeclient, notebook, notebook.cells[3]) + @test notebook.cells[3].output == 3 + + run_reactive!(fakeclient, notebook, notebook.cells[4]) + run_reactive!(fakeclient, notebook, notebook.cells[5]) + @test occursin("Multiple definitions for z", notebook.cells[4].errormessage) + @test occursin("Multiple definitions for z", notebook.cells[5].errormessage) + + run_reactive!(fakeclient, notebook, notebook.cells[6]) + run_reactive!(fakeclient, notebook, notebook.cells[7]) + @test occursin("UndefVarError", notebook.cells[6].errormessage) + + run_reactive!(fakeclient, notebook, notebook.cells[8]) + @test_broken notebook.cells[6].errormessage == nothing + @test notebook.cells[7].errormessage == nothing + @test notebook.cells[8].errormessage == nothing + + run_reactive!(fakeclient, notebook, notebook.cells[9]) + @test occursin("UndefVarError", notebook.cells[6].errormessage) + @test notebook.cells[7].errormessage == nothing + @test occursin("Multiple definitions for w", notebook.cells[8].errormessage) + @test occursin("Multiple definitions for w", notebook.cells[9].errormessage) + end end \ No newline at end of file From 4d92701fecc5d93e048f57733e605ca14a5e14c6 Mon Sep 17 00:00:00 2001 From: Fons van der Plas Date: Sat, 28 Mar 2020 00:44:30 +0100 Subject: [PATCH 2/3] =?UTF-8?q?=F0=9F=97=83=20New=20module=20manager?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Project.toml | 2 +- src/react/ModuleManager.jl | 125 +++++++++++++------------------- src/react/React.jl | 33 +++------ src/webserver/NotebookServer.jl | 2 +- test/React.jl | 2 +- 5 files changed, 62 insertions(+), 102 deletions(-) diff --git a/Project.toml b/Project.toml index 7c2858944a..10cadb3ce5 100644 --- a/Project.toml +++ b/Project.toml @@ -2,7 +2,7 @@ name = "Pluto" uuid = "c3e4b0f8-55cb-11ea-2926-15256bba5781" license = "MIT" authors = ["Fons van der Plas ", "Mikołaj Bochenski "] -version = "0.3.6" +version = "0.4.0" [deps] HTTP = "cd3eb016-35fb-5094-929b-558a96fad6f3" diff --git a/src/react/ModuleManager.jl b/src/react/ModuleManager.jl index 974c70a1a8..c2987b9082 100644 --- a/src/react/ModuleManager.jl +++ b/src/react/ModuleManager.jl @@ -1,91 +1,64 @@ module ModuleManager - import UUIDs: UUID - import ..Pluto: Notebook +import UUIDs: UUID +import ..Pluto: Notebook - "These expressions get executed whenever a new workspace is created." - workspace_preamble = [:(using Markdown), :(ENV["GKSwstype"] = "nul")] - - workspace_counts = Dict{UUID,Int64}() - next_count() = maximum(values(workspace_counts) ∪ [0]) + 1 - function get_workspace_id(notebook::Notebook) - if haskey(workspace_counts, notebook.uuid) - workspace_counts[notebook.uuid] - else - make_workspace(notebook) - end - end +mutable struct Workspace + name::Symbol + workspace_module::Module + deleted_vars::Set{Symbol} +end - function get_workspace_at(id::Int64) - Core.eval(ModuleManager, Symbol("workspace", id)) - end +"These expressions get executed whenever a new workspace is created." +workspace_preamble = [:(using Markdown), :(ENV["GKSwstype"] = "nul")] - function get_workspace(notebook::Notebook) - get_workspace_at(get_workspace_id(notebook)) - end +workspace_count = 0 +workspaces = Dict{UUID, Workspace}() - function make_workspace(notebook::Notebook) - id = workspace_counts[notebook.uuid] = next_count() - - new_workspace_name = Symbol("workspace", id) - workspace_creation = :(module $(new_workspace_name) $(workspace_preamble...) end) - - # We suppress this warning: - # Expr(:module, true, :workspace1, Expr(:block, #= Symbol("/mnt/c/dev/julia/Pluto.jl/src/React.jl"):13 =#, #= Symbol("/mnt/c/dev/julia/Pluto.jl/src/React.jl"):13 =#, Expr(:using, Expr(:., :Markdown)))) - # ** incremental compilation may be broken for this module ** - # TODO: a more elegant way? - # TODO: check for other warnings - original_stderr = stderr - (rd, wr) = redirect_stderr(); +function make_workspace(notebook::Notebook) + global workspace_count += 1 + id = workspace_count + + new_workspace_name = Symbol("workspace", id) + workspace_creation = :(module $(new_workspace_name) $(workspace_preamble...) end) + + # We suppress this warning: + # Expr(:module, true, :workspace1, Expr(:block, #= Symbol("/mnt/c/dev/julia/Pluto.jl/src/React.jl"):13 =#, #= Symbol("/mnt/c/dev/julia/Pluto.jl/src/React.jl"):13 =#, Expr(:using, Expr(:., :Markdown)))) + # ** incremental compilation may be broken for this module ** - Core.eval(ModuleManager, workspace_creation) + # TODO: a more elegant way? + # TODO: check for other warnings + original_stderr = stderr + (rd, wr) = redirect_stderr(); - redirect_stderr(original_stderr) - close(wr) - close(rd) + m = Core.eval(ModuleManager, workspace_creation) - id - end + redirect_stderr(original_stderr) + close(wr) + close(rd) - forbiddenmove(sym::Symbol) = sym == :eval || sym == :include || string(sym)[1] == '#' + workspace = Workspace(new_workspace_name, m, Set{Symbol}()) + workspaces[notebook.uuid] = workspace + workspace +end - function move_vars(notebook::Notebook, old_index::Integer, new_index::Integer, to_delete::Set{Symbol}=Set{Symbol}(), module_usings::Set{Expr}=Set{Expr}()) - old_workspace = get_workspace_at(old_index) - old_workspace_name = Symbol("workspace", old_index) - new_workspace = get_workspace_at(new_index) - new_workspace_name = Symbol("workspace", new_index) - Core.eval(new_workspace, :(import ..($(old_workspace_name)))) - - for mu in module_usings - # modules are 'cached' - # there seems to be little overhead for this, but this should be tested - Core.eval(new_workspace, mu) - end - - for symbol in names(old_workspace, all=true, imported=true) - if !forbiddenmove(symbol) && symbol != Symbol("workspace",old_index - 1) && symbol != Symbol("workspace",old_index) - # Running a function definition like - # function f(x) global w = x end - # will actually add `w` to the list of `names`, even though it is not yet defined: - if isdefined(old_workspace, symbol) - if symbol in to_delete - try - Core.eval(old_workspace, :($(symbol) = nothing)) - catch; end # sometimes impossible, eg. when $symbol was constant - else - Core.eval(new_workspace, :($(symbol) = $(old_workspace_name).$(symbol))) - end - end - end - end +function get_workspace(notebook::Notebook)::Workspace + if haskey(workspaces, notebook.uuid) + workspaces[notebook.uuid] + else + workspaces[notebook.uuid] = make_workspace(notebook) end +end - function delete_vars(notebook::Notebook, to_delete::Set{Symbol}=Set{Symbol}(), module_usings::Set{Expr}=Set{Expr}()) - if !isempty(to_delete) - old_index = get_workspace_id(notebook) - new_index = make_workspace(notebook) - move_vars(notebook, old_index, new_index, to_delete, module_usings) - end - end +function delete_vars(notebook::Notebook, to_delete::Set{Symbol}) + # TODO: treat methods separately + ws = get_workspace(notebook) + ws.deleted_vars = ws.deleted_vars ∪ to_delete +end + +function undelete_vars(notebook::Notebook, to_undelete::Set{Symbol}) + ws = get_workspace(notebook) + ws.deleted_vars = setdiff(ws.deleted_vars, to_undelete) +end end \ No newline at end of file diff --git a/src/react/React.jl b/src/react/React.jl index ac781f122a..d4cf1cd137 100644 --- a/src/react/React.jl +++ b/src/react/React.jl @@ -1,17 +1,19 @@ function run_single!(initiator, notebook::Notebook, cell::Cell) - # if isa(cell.parsedcode, Expr) && cell.parsedcode.head == :using - # # Don't run this cell. We set its output directly and stop the method prematurely. - # relay_error!(cell, "Use `import` instead of `using`.\nSupport for `using` will be added soon.") - # return - # end workspace = ModuleManager.get_workspace(notebook) starttime = time_ns() try + # deleted_refs = setdiff(cell.resolved_symstate.references, cell.resolved_symstate.assignments) ∩ workspace.deleted_vars + deleted_refs = cell.resolved_symstate.references ∩ workspace.deleted_vars + if !isempty(deleted_refs) + deleted_refs |> first |> UndefVarError |> throw + end starttime = time_ns() - output = Core.eval(workspace, cell.parsedcode) + output = Core.eval(workspace.workspace_module, cell.parsedcode) cell.runtime = time_ns() - starttime relay_output!(cell, output) + + ModuleManager.undelete_vars(notebook, cell.resolved_symstate.assignments) # TODO: capture stdout and display it somehwere, but let's keep using the actual terminal for now catch err cell.runtime = time_ns() - starttime @@ -60,18 +62,6 @@ function run_reactive!(initiator, notebook::Notebook, cell::Cell) c.resolved_symstate = notebook.combined_funcdefs[func] ∪ c.resolved_symstate end end - - # We also include the functions defined in this cell, to make sure that the function definition is re-evaluated when it uses a global variable that changed. e.g. - - # y = 1 - # f(x) = x + y - - # In a REPL, this is not necessary: `y` is evaluated when the function is called, not when it is defined. However, it is necessary in our case because we move to a new workspace for most evaluations, so the same `y` is no longer available to `f`. - for func in keys(c.resolved_symstate.funcdefs) - if haskey(notebook.combined_funcdefs, func) - c.resolved_symstate.references = notebook.combined_funcdefs[func].references ∪ c.resolved_symstate.references - end - end end new_resolved_symstate = cell.resolved_symstate @@ -99,13 +89,10 @@ function run_reactive!(initiator, notebook::Notebook, cell::Cell) module_usings = union((c.module_usings for c in notebook.cells)...) to_delete = union( old_resolved_symstate.assignments, - (c.resolved_symstate.assignments for c in will_update)..., - keys(old_resolved_symstate.funcdefs), - (keys(c.resolved_symstate.funcdefs) for c in will_update)..., + (c.resolved_symstate.assignments for c in will_update)... ) - ModuleManager.delete_vars(notebook, to_delete, module_usings) - + ModuleManager.delete_vars(notebook, to_delete) for to_run in will_update if to_run in reassigned diff --git a/src/webserver/NotebookServer.jl b/src/webserver/NotebookServer.jl index cd0acaa5e3..f5efb9d422 100644 --- a/src/webserver/NotebookServer.jl +++ b/src/webserver/NotebookServer.jl @@ -190,7 +190,7 @@ function run(port = 1234, launchbrowser = false) catch ex if ex isa InterruptException rethrow(ex) - elseif ex isa IOError + elseif ex isa Base.IOError # that's fine! elseif ex isa ArgumentError && occursin("stream is closed", ex.msg) # that's fine! diff --git a/test/React.jl b/test/React.jl index 9d2112be87..9c64f2c353 100644 --- a/test/React.jl +++ b/test/React.jl @@ -153,7 +153,7 @@ import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, @test occursin("UndefVarError", notebook.cells[6].errormessage) run_reactive!(fakeclient, notebook, notebook.cells[8]) - @test_broken notebook.cells[6].errormessage == nothing + @test notebook.cells[6].errormessage == nothing @test notebook.cells[7].errormessage == nothing @test notebook.cells[8].errormessage == nothing From 166263d66691d1c8f463a44e9830e917ab955833 Mon Sep 17 00:00:00 2001 From: Fons van der Plas Date: Sat, 28 Mar 2020 00:49:13 +0100 Subject: [PATCH 3/3] =?UTF-8?q?=F0=9F=94=96=20Renamed=20ModuleManager=20to?= =?UTF-8?q?=20WorkspaceManager?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Pluto.jl | 2 +- src/react/React.jl | 6 +-- .../{ModuleManager.jl => WorkspaceManager.jl} | 4 +- test/React.jl | 37 ++++++++++++++++++- .../{ModuleManager.jl => WorkspaceManager.jl} | 0 test/runtests.jl | 2 +- 6 files changed, 43 insertions(+), 8 deletions(-) rename src/react/{ModuleManager.jl => WorkspaceManager.jl} (95%) rename test/{ModuleManager.jl => WorkspaceManager.jl} (100%) diff --git a/src/Pluto.jl b/src/Pluto.jl index d3f29d8a59..a631e88aa1 100644 --- a/src/Pluto.jl +++ b/src/Pluto.jl @@ -17,7 +17,7 @@ include("./react/ExploreExpression.jl") using .ExploreExpression include("./react/Cell.jl") include("./react/Notebook.jl") -include("./react/ModuleManager.jl") +include("./react/WorkspaceManager.jl") include("./react/React.jl") include("./webserver/NotebookServer.jl") diff --git a/src/react/React.jl b/src/react/React.jl index d4cf1cd137..c15d7e07c5 100644 --- a/src/react/React.jl +++ b/src/react/React.jl @@ -1,5 +1,5 @@ function run_single!(initiator, notebook::Notebook, cell::Cell) - workspace = ModuleManager.get_workspace(notebook) + workspace = WorkspaceManager.get_workspace(notebook) starttime = time_ns() try # deleted_refs = setdiff(cell.resolved_symstate.references, cell.resolved_symstate.assignments) ∩ workspace.deleted_vars @@ -13,7 +13,7 @@ function run_single!(initiator, notebook::Notebook, cell::Cell) relay_output!(cell, output) - ModuleManager.undelete_vars(notebook, cell.resolved_symstate.assignments) + WorkspaceManager.undelete_vars(notebook, cell.resolved_symstate.assignments) # TODO: capture stdout and display it somehwere, but let's keep using the actual terminal for now catch err cell.runtime = time_ns() - starttime @@ -92,7 +92,7 @@ function run_reactive!(initiator, notebook::Notebook, cell::Cell) (c.resolved_symstate.assignments for c in will_update)... ) - ModuleManager.delete_vars(notebook, to_delete) + WorkspaceManager.delete_vars(notebook, to_delete) for to_run in will_update if to_run in reassigned diff --git a/src/react/ModuleManager.jl b/src/react/WorkspaceManager.jl similarity index 95% rename from src/react/ModuleManager.jl rename to src/react/WorkspaceManager.jl index c2987b9082..92e0a6d354 100644 --- a/src/react/ModuleManager.jl +++ b/src/react/WorkspaceManager.jl @@ -1,4 +1,4 @@ -module ModuleManager +module WorkspaceManager import UUIDs: UUID import ..Pluto: Notebook @@ -32,7 +32,7 @@ function make_workspace(notebook::Notebook) original_stderr = stderr (rd, wr) = redirect_stderr(); - m = Core.eval(ModuleManager, workspace_creation) + m = Core.eval(WorkspaceManager, workspace_creation) redirect_stderr(original_stderr) close(wr) diff --git a/test/React.jl b/test/React.jl index 9c64f2c353..a147e4caf2 100644 --- a/test/React.jl +++ b/test/React.jl @@ -1,6 +1,6 @@ using Test using Pluto -import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, ModuleManager +import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, WorkspaceManager @testset "Reactivity" begin fakeclient = Client(:fake, nothing) @@ -111,6 +111,41 @@ import Pluto: Notebook, Client, run_reactive!,fakeclient, createcell_fromcode, @test notebook.cells[1].output == nothing @test occursin("UndefVarError", notebook.cells[1].errormessage) end + +# @testset "Multiple dispatch" begin +# notebook = Notebook(joinpath(tempdir(), "test.jl"), [ +# createcell_fromcode( +# """begin +# function f(x) +# x +# end +# function f(x,s) +# s +# end +# end""" +# ) +# createcell_fromcode( +# """function g(x) +# x +# end""" +# ) +# createcell_fromcode( +# """function g(x,s) +# s +# end""" +# ) +# createcell_fromcode("function f(x) x end") +# ]) +# fakeclient.connected_notebook = notebook + +# run_reactive!(fakeclient, notebook, notebook.cells[1]) +# run_reactive!(fakeclient, notebook, notebook.cells[1]) +# notebook.cells[1].code = "x = x + 1" +# run_reactive!(fakeclient, notebook, notebook.cells[1]) +# @test notebook.cells[1].output == nothing +# @test occursin("UndefVarError", notebook.cells[1].errormessage) +# end + @testset "Immutable globals" begin # We currently have a slightly relaxed version of immutable globals: # globals can only be mutated/assigned _in a single cell_. diff --git a/test/ModuleManager.jl b/test/WorkspaceManager.jl similarity index 100% rename from test/ModuleManager.jl rename to test/WorkspaceManager.jl diff --git a/test/runtests.jl b/test/runtests.jl index 9ae0c58ea6..199fe591b4 100644 --- a/test/runtests.jl +++ b/test/runtests.jl @@ -1,4 +1,4 @@ include("./ExploreExpression.jl") include("./React.jl") -include("./ModuleManager.jl") +include("./WorkspaceManager.jl") include("./Notebook.jl") \ No newline at end of file