Merge pull request #5699 from dcjones/goto

Add labels and gotos. (Fixes #101)

base/base.jl

@@ -203,6 +203,14 @@ macro inbounds(blk)
     :(@boundscheck false $(esc(blk)))
 end
 
+macro label(name::Symbol)
+    Expr(:symboliclabel, name)
+end
+
+macro goto(name::Symbol)
+    Expr(:symbolicgoto, name)
+end
+
 # NOTE: Base shares Array with Core so we can add definitions to it
 
 Array{T,N}(::Type{T}, d::NTuple{N,Int}) =

base/exports.jl

@@ -1357,4 +1357,6 @@ export
     @deprecate,
     @boundscheck,
     @inbounds,
-    @simd
+    @simd,
+    @label,
+    @goto

base/inference.jl

@@ -1176,14 +1176,12 @@ function stchanged(new::Union(StateUpdate,VarTable), old, vars)
     return false
 end
 
-function findlabel(body, l)
-    for i=1:length(body)
-        b = body[i]
-        if isa(b,LabelNode) && b.label==l
-            return i
-        end
+function findlabel(labels, l)
+    i = l+1 > length(labels) ? 0 : labels[l+1]
+    if i == 0
+        error("label ",l," not found")
     end
-    error("label ",l," not found")
+    return i
 end
 
 function label_counter(body)
@@ -1301,6 +1299,22 @@ function typeinf(linfo::LambdaStaticData,atypes::Tuple,sparams::Tuple, def, cop)
     body = (ast.args[3].args)::Array{Any,1}
     n = length(body)
 
+    maxlabel = 0
+    for i=1:length(body)
+        b = body[i]
+        if isa(b,LabelNode)
+            maxlabel = max(maxlabel, b.label+1)
+        end
+    end
+    labels = zeros(Int, maxlabel)
+
+    for i=1:length(body)
+        b = body[i]
+        if isa(b,LabelNode)
+            labels[b.label+1] = i
+        end
+    end
+
     # our stack frame
     frame = CallStack(ast0, linfo.module, atypes, inference_stack)
     inference_stack = frame
@@ -1400,12 +1414,12 @@ function typeinf(linfo::LambdaStaticData,atypes::Tuple,sparams::Tuple, def, cop)
             end
             pc´ = pc+1
             if isa(stmt,GotoNode)
-                pc´ = findlabel(body,stmt.label)
+                pc´ = findlabel(labels,stmt.label)
             elseif isa(stmt,Expr)
                 hd = stmt.head
                 if is(hd,:gotoifnot)
                     condexpr = stmt.args[1]
-                    l = findlabel(body,stmt.args[2])
+                    l = findlabel(labels,stmt.args[2])
                     # constant conditions
                     if is(condexpr,true)
                     elseif is(condexpr,false)
@@ -1419,7 +1433,7 @@ function typeinf(linfo::LambdaStaticData,atypes::Tuple,sparams::Tuple, def, cop)
                         end
                     end
                 elseif is(hd,:type_goto)
-                    l = findlabel(body,stmt.args[1])
+                    l = findlabel(labels,stmt.args[1])
                     for i = 2:length(stmt.args)
                         var = stmt.args[i]
                         if isa(var,SymbolNode)
@@ -1474,7 +1488,7 @@ function typeinf(linfo::LambdaStaticData,atypes::Tuple,sparams::Tuple, def, cop)
                         end
                     end
                 elseif is(hd,:enter)
-                    l = findlabel(body,stmt.args[1]::Int)
+                    l = findlabel(labels,stmt.args[1]::Int)
                     cur_hand = (l,cur_hand)
                     handler_at[l] = cur_hand
                 elseif is(hd,:leave)

src/julia-syntax.scm

@@ -1109,6 +1109,8 @@
 		 (var  (caddr e))
 		 (catchb (cadddr e))
 		 (finalb (cadddr (cdr e))))
+         (if (has-unmatched-symbolic-goto? tryb)
+           (error "goto from a try/finally block is not permitted"))
 	     (let ((hasret (or (contains return? tryb)
 			       (contains return? catchb))))
 	       (let ((err (gensy))
@@ -2737,6 +2739,69 @@ So far only the second case can actually occur.
 				   (flatten-scopes x)))
 		   e))))
 
+(define (has-unmatched-symbolic-goto? e)
+  (let ((label-refs (table))
+        (label-defs (table)))
+    (find-symbolic-label-refs e label-refs)
+    (find-symbolic-label-defs e label-defs)
+    (any not (map (lambda (k) (get label-defs k #f))
+      (table.keys label-refs)))))
+
+(define (symbolic-label-handler-levels e levels handler-level)
+  (if (or (not (pair? e)) (quoted? e))
+    '()
+    (case (car e)
+      ((trycatch)
+       (symbolic-label-handler-levels (cadr e) levels (+ handler-level 1)))
+      ((symboliclabel)
+       (put! levels (cadr e) handler-level))
+      (else
+        (map (lambda (x) (symbolic-label-handler-levels x levels handler-level)) e)))))
+
+(define (find-symbolic-label-defs e tbl)
+  (if (or (not (pair? e)) (quoted? e))
+    '()
+    (if (eq? (car e) 'symboliclabel)
+      (put! tbl (cadr e) #t)
+      (map (lambda (x) (find-symbolic-label-defs x tbl)) e))))
+
+(define (find-symbolic-label-refs e tbl)
+  (if (or (not (pair? e)) (quoted? e))
+    '()
+    (if (eq? (car e) 'symbolicgoto)
+      (put! tbl (cadr e) #t)
+      (map (lambda (x) (find-symbolic-label-refs x tbl)) e))))
+
+(define (find-symbolic-labels e)
+  (let
+    ((defs (table))
+     (refs (table)))
+    (find-symbolic-label-defs e defs)
+    (find-symbolic-label-refs e refs)
+    (table.foldl
+      (lambda (label v labels)
+        (if (has? refs label)
+          (cons label labels)
+          labels))
+      '() defs)))
+
+(define (rename-symbolic-labels- e relabel)
+  (cond
+    ((or (not (pair? e)) (quoted? e)) e)
+    ((eq? (car e) 'symbolicgoto)
+     (let ((newlabel (assq (cadr e) relabel)))
+       (if newlabel `(symbolicgoto ,(cdr newlabel)) e)))
+    ((eq? (car e) 'symboliclabel)
+     (let ((newlabel (assq (cadr e) relabel)))
+       (if newlabel `(symboliclabel ,(cdr newlabel)) e)))
+    (else (map (lambda (x) (rename-symbolic-labels- x relabel)) e))))
+
+(define (rename-symbolic-labels e)
+  (let*
+    ((labels (find-symbolic-labels e))
+     (relabel (pair-with-gensyms labels)))
+    (rename-symbolic-labels- e relabel)))
+
 (define (make-var-info name) (list name 'Any 0))
 (define vinfo:name car)
 (define vinfo:type cadr)
@@ -2905,8 +2970,11 @@ So far only the second case can actually occur.
 (define (goto-form e)
   (let ((code '())
 	(label-counter 0)
-	(label-map '())
+    (label-map (table))
+    (label-decl (table))
+    (label-level (table))
 	(handler-level 0))
+    (symbolic-label-handler-levels e label-level 0)
     (define (emit c)
       (set! code (cons c code)))
     (define (make-label)
@@ -2990,18 +3058,40 @@ So far only the second case can actually occur.
 			(if (> handler-level 0)
 			    (emit `(leave ,handler-level)))
 			(emit (goto-form e))))
-	    ((label) (let ((m (assq (cadr e) label-map)))
+        ((label) (let ((m (get label-map (cadr e) #f)))
 		       (if m
-			   (emit `(label ,(cdr m)))
+			   (emit `(label ,m))
 			   (let ((l (make&mark-label)))
-			     (set! label-map
-				   (cons (cons (cadr e) l) label-map))))))
-	    ((type_goto) (let ((m (assq (cadr e) label-map)))
+                 (put! label-map (cadr e) l)))
+               (put! label-decl (cadr e) #t)))
+        ((symboliclabel) (let ((m (get label-map (cadr e) #f)))
+               (if m
+                 (if (get label-decl (cadr e) #f)
+                   (error (string "label \"" (cadr e) "\" defined multiple times"))
+                   (emit `(label ,m)))
+               (let ((l (make&mark-label)))
+                 (put! label-map (cadr e) l)))
+               (put! label-decl (cadr e) #t)))
+        ((symbolicgoto) (let
+               ((m (get label-map (cadr e) #f))
+                (target-level (get label-level (cadr e) #f)))
+               (cond
+                 ((not target-level)
+                   (error (string "label \"" (cadr e) "\" referenced but not defined")))
+                 ((> target-level handler-level)
+                   (error (string "cannot goto label \"" (cadr e) "\" inside try/catch block")))
+                 ((< target-level handler-level)
+                   (emit `(leave ,(- handler-level target-level)))))
+               (if m
+                   (emit `(goto ,m))
+                   (let ((l (make-label)))
+                     (put! label-map (cadr e) l)
+                     (emit `(goto ,l))))))
+	    ((type_goto) (let((m (get label-map (cadr e) #f)))
 			   (if m
-			       (emit `(type_goto ,(cdr m) ,@(cddr e)))
+			       (emit `(type_goto ,m ,@(cddr e)))
 			       (let ((l (make-label)))
-				 (set! label-map
-				       (cons (cons (cadr e) l) label-map))
+                 (put! label-map (cadr e) l)
 				 (emit `(type_goto ,l ,@(cddr e)))))))
 	    ;; exception handlers are lowered using
 	    ;; (enter L) - push handler with catch block at label L
@@ -3120,8 +3210,9 @@ So far only the second case can actually occur.
 	   (let ((form (car form))
 		 (m    (cdr form)))
 	     ;; m is the macro's def module, or #f if def env === use env
-	     (julia-expand-macros-
-	      (resolve-expansion-vars form m)))))
+	     (rename-symbolic-labels
+           (julia-expand-macros-
+             (resolve-expansion-vars form m))))))
 	(else
 	 (map julia-expand-macros- e))))
 
@@ -3164,11 +3255,11 @@ So far only the second case can actually occur.
 (define (resolve-expansion-vars- e env m inarg)
   (cond ((or (eq? e 'true) (eq? e 'false) (eq? e 'end))
 	 e)
-	((symbol? e)
-	 (let ((a (assq e env)))
-	   (if a (cdr a)
-	       (if m `(|.| ,m (quote ,e))
-		   e))))
+    ((symbol? e)
+     (let ((a (assq e env)))
+       (if a (cdr a)
+           (if m `(|.| ,m (quote ,e))
+           e))))
 	((or (not (pair? e)) (quoted? e))
 	 e)
 	(else
@@ -3179,6 +3270,8 @@ So far only the second case can actually occur.
 	    `(macrocall ,.(map (lambda (x)
 				 (resolve-expansion-vars- x env m inarg))
 			       (cdr e))))
+       ((symboliclabel) e)
+       ((symbolicgoto) e)
 	   ((type)
 	    `(type ,(cadr e) ,(resolve-expansion-vars- (caddr e) env m inarg)
 		   ;; type has special behavior: identifiers inside are

test/Makefile

@@ -8,7 +8,7 @@ TESTS = all core keywordargs numbers strings unicode collections hashing	\
 	git pkg resolve suitesparse complex version pollfd mpfr	broadcast       \
 	socket floatapprox priorityqueue readdlm regex float16 combinatorics    \
 	sysinfo rounding ranges mod2pi euler show lineedit      \
-	replcompletions backtrace repl test
+	replcompletions backtrace repl test goto
 
 default: all
 

test/goto.jl

@@ -0,0 +1,71 @@
+
+# Basic goto tests
+
+function goto_test1()
+    @goto a
+    return false
+    @label a
+    return true
+end
+@test goto_test1()
+
+
+@test_throws ErrorException eval(
+    quote
+        function goto_test2()
+            @goto a
+            @label a
+            @label a
+            return
+        end
+    end)
+
+
+@test_throws ErrorException eval(
+    quote
+        function goto_test3()
+            @goto a
+            return
+        end
+    end)
+
+
+@test_throws ErrorException eval(
+    quote
+        function goto_test4()
+            @goto a
+            try
+                @label a
+            catch
+            end
+        end
+    end)
+
+
+# test that labels in macros are reassigned
+macro goto_test5_macro()
+    @label a
+end
+
+@test_throws ErrorException eval(
+    quote
+        function goto_test5()
+            @goto a
+            @goto_test5_macro
+            return
+        end
+    end)
+
+
+@test_throws ErrorException eval(
+    quote
+        function goto_test6()
+            try
+                @goto a
+            finally
+            end
+            @label a
+            return
+        end
+    end)
+