Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add support for optional parameters to the universal backend

  • Loading branch information...
commit a3dd342b07db3d55228821611275344cbdbb3aba 1 parent 182604e
Marc Feeley authored
97 gsc/_t-univ.scm
View
@@ -1586,20 +1586,7 @@
(^ (case (label-type gvm-instr)
((entry)
- (^if (if (label-entry-rest? gvm-instr)
- (^not (^call-prim
- (^global-prim-function
- (^prefix (univ-use-rtlib ctx 'build_rest)))
- (- (label-entry-nb-parms gvm-instr) 1)))
- (^!= (gvm-state-nargs-use ctx 'rd)
- (label-entry-nb-parms gvm-instr)))
- (univ-emit-return-call-prim
- ctx
- (^global-prim-function
- (^prefix (univ-use-rtlib ctx 'wrong_nargs)))
- (if (label-entry-closed? gvm-instr)
- (^getreg (+ univ-nb-arg-regs 1))
- id))))
+ (univ-label-entry ctx gvm-instr id))
(else
(^)))
@@ -1913,6 +1900,88 @@
(loop (cons (dump-proc (queue-get! proc-left))
rev-res))))))
+(define (univ-label-entry ctx gvm-instr id)
+ (let* ((nb-parms (label-entry-nb-parms gvm-instr))
+ (opts (label-entry-opts gvm-instr))
+ (keys (label-entry-keys gvm-instr))
+ (rest? (label-entry-rest? gvm-instr))
+ (closed? (label-entry-closed? gvm-instr))
+ (nb-parms-except-rest
+ (- nb-parms (if rest? 1 0)))
+ (nb-keys
+ (if keys (length keys) 0))
+ (nb-req-and-opt
+ (- nb-parms-except-rest nb-keys))
+ (nb-opts
+ (length opts))
+ (nb-req
+ (- nb-req-and-opt nb-opts))
+ (defaults
+ (append opts (map cdr (or keys '())))))
+
+ (define (dispatch-on-nb-args nb-args)
+ (if (> nb-args (- nb-req-and-opt (if rest? 0 1)))
+
+ (if keys
+ (compiler-internal-error
+ "univ-label-entry, keyword parameters not supported")
+ (^if (if rest?
+ (^not (^call-prim
+ (^global-prim-function
+ (^prefix (univ-use-rtlib ctx 'build_rest)))
+ nb-parms-except-rest))
+ (^!= (gvm-state-nargs-use ctx 'rd)
+ nb-parms-except-rest))
+ (univ-emit-return-call-prim
+ ctx
+ (^global-prim-function
+ (^prefix (univ-use-rtlib ctx 'wrong_nargs)))
+ (if closed?
+ (^getreg (+ univ-nb-arg-regs 1))
+ id))))
+
+ (let ((nb-stacked (max 0 (- nb-args univ-nb-arg-regs)))
+ (nb-stacked* (max 0 (- nb-parms univ-nb-arg-regs))))
+
+ (define (setup-parameter i)
+ (if (<= i nb-parms)
+ (let* ((rest (setup-parameter (+ i 1)))
+ (src-reg (- i nb-stacked))
+ (src (cond ((<= i nb-args)
+ (^getreg src-reg))
+ ((and rest? (= i nb-parms))
+ (^obj '()))
+ (else
+ (^obj
+ (obj-val (list-ref defaults (- i nb-req 1))))))))
+ (if (<= i nb-stacked*)
+ (^inc-by (begin
+ (gvm-state-sp-use ctx 'rd)
+ (gvm-state-sp-use ctx 'wr))
+ 1
+ (lambda (x)
+ (^ (^expr-statement
+ (^assign
+ (^array-index
+ (gvm-state-stack-use ctx 'rd)
+ x)
+ src))
+ rest)))
+ (if (and (<= i nb-args) (= nb-stacked nb-stacked*))
+ rest
+ (let ((dst-reg (- i nb-stacked*)))
+ (^ (^setreg dst-reg src)
+ rest)))))
+ (^)))
+
+ (let ((x (setup-parameter (+ nb-stacked 1))))
+ (^if (^= (gvm-state-nargs-use ctx 'rd)
+ nb-args)
+ x
+ (dispatch-on-nb-args (+ nb-args 1)))))))
+
+ (dispatch-on-nb-args nb-req)))
+
(define closure-count 0)
#;
282 gsc/tests/12-closure/opt1.scm
View
@@ -0,0 +1,282 @@
+(declare (extended-bindings) (not constant-fold) (not safe))
+
+(define (f00)
+ #f)
+
+(define (f10 w)
+ (println w))
+
+(define (f20 w x)
+ (println w)
+ (println x))
+
+(define (f30 w x y)
+ (println w)
+ (println x)
+ (println y))
+
+(define (f40 w x y z)
+ (println w)
+ (println x)
+ (println y)
+ (println z))
+
+(define (f01 #!optional (a 11))
+ (println a))
+
+(define (f11 w #!optional (a 11))
+ (println w)
+ (println a))
+
+(define (f21 w x #!optional (a 11))
+ (println w)
+ (println x)
+ (println a))
+
+(define (f31 w x y #!optional (a 11))
+ (println w)
+ (println x)
+ (println y)
+ (println a))
+
+(define (f41 w x y z #!optional (a 11))
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a))
+
+(define (f02 #!optional (a 11) (b 22))
+ (println a)
+ (println b))
+
+(define (f12 w #!optional (a 11) (b 22))
+ (println w)
+ (println a)
+ (println b))
+
+(define (f22 w x #!optional (a 11) (b 22))
+ (println w)
+ (println x)
+ (println a)
+ (println b))
+
+(define (f32 w x y #!optional (a 11) (b 22))
+ (println w)
+ (println x)
+ (println y)
+ (println a)
+ (println b))
+
+(define (f42 w x y z #!optional (a 11) (b 22))
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a)
+ (println b))
+
+(define (f03 #!optional (a 11) (b 22) (c 33))
+ (println a)
+ (println b)
+ (println c))
+
+(define (f13 w #!optional (a 11) (b 22) (c 33))
+ (println w)
+ (println a)
+ (println b)
+ (println c))
+
+(define (f23 w x #!optional (a 11) (b 22) (c 33))
+ (println w)
+ (println x)
+ (println a)
+ (println b)
+ (println c))
+
+(define (f33 w x y #!optional (a 11) (b 22) (c 33))
+ (println w)
+ (println x)
+ (println y)
+ (println a)
+ (println b)
+ (println c))
+
+(define (f43 w x y z #!optional (a 11) (b 22) (c 33))
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a)
+ (println b)
+ (println c))
+
+(define (f04 #!optional (a 11) (b 22) (c 33) (d 44))
+ (println a)
+ (println b)
+ (println c)
+ (println d))
+
+(define (f14 w #!optional (a 11) (b 22) (c 33) (d 44))
+ (println w)
+ (println a)
+ (println b)
+ (println c)
+ (println d))
+
+(define (f24 w x #!optional (a 11) (b 22) (c 33) (d 44))
+ (println w)
+ (println x)
+ (println a)
+ (println b)
+ (println c)
+ (println d))
+
+(define (f34 w x y #!optional (a 11) (b 22) (c 33) (d 44))
+ (println w)
+ (println x)
+ (println y)
+ (println a)
+ (println b)
+ (println c)
+ (println d))
+
+(define (f44 w x y z #!optional (a 11) (b 22) (c 33) (d 44))
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a)
+ (println b)
+ (println c)
+ (println d))
+
+
+(println "f00")
+(f00)
+
+(println "f10")
+(f10 1)
+
+(println "f20")
+(f20 1 2)
+
+(println "f30")
+(f30 1 2 3)
+
+(println "f40")
+(f40 1 2 3 4)
+
+
+(println "f01")
+(f01)
+(f01 1)
+
+(println "f11")
+(f11 1)
+(f11 1 2)
+
+(println "f21")
+(f21 1 2)
+(f21 1 2 3)
+
+(println "f31")
+(f31 1 2 3)
+(f31 1 2 3 4)
+
+(println "f41")
+(f41 1 2 3 4)
+(f41 1 2 3 4 5)
+
+
+(println "f02")
+(f02)
+(f02 1)
+(f02 1 2)
+
+(println "f12")
+(f12 1)
+(f12 1 2)
+(f12 1 2 3)
+
+(println "f22")
+(f22 1 2)
+(f22 1 2 3)
+(f22 1 2 3 4)
+
+(println "f32")
+(f32 1 2 3)
+(f32 1 2 3 4)
+(f32 1 2 3 4 5)
+
+(println "f42")
+(f42 1 2 3 4)
+(f42 1 2 3 4 5)
+(f42 1 2 3 4 5 6)
+
+
+(println "f03")
+(f03)
+(f03 1)
+(f03 1 2)
+(f03 1 2 3)
+
+(println "f13")
+(f13 1)
+(f13 1 2)
+(f13 1 2 3)
+(f13 1 2 3 4)
+
+(println "f23")
+(f23 1 2)
+(f23 1 2 3)
+(f23 1 2 3 4)
+(f23 1 2 3 4 5)
+
+(println "f33")
+(f33 1 2 3)
+(f33 1 2 3 4)
+(f33 1 2 3 4 5)
+(f33 1 2 3 4 5 6)
+
+(println "f43")
+(f43 1 2 3 4)
+(f43 1 2 3 4 5)
+(f43 1 2 3 4 5 6)
+(f43 1 2 3 4 5 6 7)
+
+
+(println "f04")
+(f04)
+(f04 1)
+(f04 1 2)
+(f04 1 2 3)
+(f04 1 2 3 4)
+
+(println "f14")
+(f14 1)
+(f14 1 2)
+(f14 1 2 3)
+(f14 1 2 3 4)
+(f14 1 2 3 4 5)
+
+(println "f24")
+(f24 1 2)
+(f24 1 2 3)
+(f24 1 2 3 4)
+(f24 1 2 3 4 5)
+(f24 1 2 3 4 5 6)
+
+(println "f34")
+(f34 1 2 3)
+(f34 1 2 3 4)
+(f34 1 2 3 4 5)
+(f34 1 2 3 4 5 6)
+(f34 1 2 3 4 5 6 7)
+
+(println "f44")
+(f44 1 2 3 4)
+(f44 1 2 3 4 5)
+(f44 1 2 3 4 5 6)
+(f44 1 2 3 4 5 6 7)
+(f44 1 2 3 4 5 6 7 8)
416 gsc/tests/12-closure/opt2.scm
View
@@ -0,0 +1,416 @@
+(declare (extended-bindings) (not constant-fold) (not safe))
+
+(define (print-list lst)
+ (println "vvvvvvvvvvvvvv")
+ (let loop ((lst lst))
+ (if (##pair? lst)
+ (begin
+ (println (##car lst))
+ (loop (##cdr lst)))))
+ (println "^^^^^^^^^^^^^^")
+ (println ""))
+
+(define (f00 . lst)
+ (print-list lst))
+
+(define (f10 w . lst)
+ (println w)
+ (print-list lst))
+
+(define (f20 w x . lst)
+ (println w)
+ (println x)
+ (print-list lst))
+
+(define (f30 w x y . lst)
+ (println w)
+ (println x)
+ (println y)
+ (print-list lst))
+
+(define (f40 w x y z . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (print-list lst))
+
+(define (f01 #!optional (a 11) . lst)
+ (println a)
+ (print-list lst))
+
+(define (f11 w #!optional (a 11) . lst)
+ (println w)
+ (println a)
+ (print-list lst))
+
+(define (f21 w x #!optional (a 11) . lst)
+ (println w)
+ (println x)
+ (println a)
+ (print-list lst))
+
+(define (f31 w x y #!optional (a 11) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println a)
+ (print-list lst))
+
+(define (f41 w x y z #!optional (a 11) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a)
+ (print-list lst))
+
+(define (f02 #!optional (a 11) (b 22) . lst)
+ (println a)
+ (println b)
+ (print-list lst))
+
+(define (f12 w #!optional (a 11) (b 22) . lst)
+ (println w)
+ (println a)
+ (println b)
+ (print-list lst))
+
+(define (f22 w x #!optional (a 11) (b 22) . lst)
+ (println w)
+ (println x)
+ (println a)
+ (println b)
+ (print-list lst))
+
+(define (f32 w x y #!optional (a 11) (b 22) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println a)
+ (println b)
+ (print-list lst))
+
+(define (f42 w x y z #!optional (a 11) (b 22) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a)
+ (println b)
+ (print-list lst))
+
+(define (f03 #!optional (a 11) (b 22) (c 33) . lst)
+ (println a)
+ (println b)
+ (println c)
+ (print-list lst))
+
+(define (f13 w #!optional (a 11) (b 22) (c 33) . lst)
+ (println w)
+ (println a)
+ (println b)
+ (println c)
+ (print-list lst))
+
+(define (f23 w x #!optional (a 11) (b 22) (c 33) . lst)
+ (println w)
+ (println x)
+ (println a)
+ (println b)
+ (println c)
+ (print-list lst))
+
+(define (f33 w x y #!optional (a 11) (b 22) (c 33) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println a)
+ (println b)
+ (println c)
+ (print-list lst))
+
+(define (f43 w x y z #!optional (a 11) (b 22) (c 33) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a)
+ (println b)
+ (println c)
+ (print-list lst))
+
+(define (f04 #!optional (a 11) (b 22) (c 33) (d 44) . lst)
+ (println a)
+ (println b)
+ (println c)
+ (println d)
+ (print-list lst))
+
+(define (f14 w #!optional (a 11) (b 22) (c 33) (d 44) . lst)
+ (println w)
+ (println a)
+ (println b)
+ (println c)
+ (println d)
+ (print-list lst))
+
+(define (f24 w x #!optional (a 11) (b 22) (c 33) (d 44) . lst)
+ (println w)
+ (println x)
+ (println a)
+ (println b)
+ (println c)
+ (println d)
+ (print-list lst))
+
+(define (f34 w x y #!optional (a 11) (b 22) (c 33) (d 44) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println a)
+ (println b)
+ (println c)
+ (println d)
+ (print-list lst))
+
+(define (f44 w x y z #!optional (a 11) (b 22) (c 33) (d 44) . lst)
+ (println w)
+ (println x)
+ (println y)
+ (println z)
+ (println a)
+ (println b)
+ (println c)
+ (println d)
+ (print-list lst))
+
+
+(println "f00")
+(f00)
+(f00 -1)
+(f00 -1 -2)
+(f00 -1 -2 -3)
+(f00 -1 -2 -3 -4)
+
+(println "f10")
+(f10 1)
+(f10 1 -1)
+(f10 1 -1 -2)
+(f10 1 -1 -2 -3)
+(f10 1 -1 -2 -3 -4)
+
+(println "f20")
+(f20 1 2)
+(f20 1 2 -1)
+(f20 1 2 -1 -2)
+(f20 1 2 -1 -2 -3)
+(f20 1 2 -1 -2 -3 -4)
+
+(println "f30")
+(f30 1 2 3)
+(f30 1 2 3 -1)
+(f30 1 2 3 -1 -2)
+(f30 1 2 3 -1 -2 -3)
+(f30 1 2 3 -1 -2 -3 -4)
+
+(println "f40")
+(f40 1 2 3 4)
+(f40 1 2 3 4 -1)
+(f40 1 2 3 4 -1 -2)
+(f40 1 2 3 4 -1 -2 -3)
+(f40 1 2 3 4 -1 -2 -3 -4)
+
+
+(println "f01")
+(f01)
+(f01 1)
+(f01 1 -1)
+(f01 1 -1 -2)
+(f01 1 -1 -2 -3)
+(f01 1 -1 -2 -3 -4)
+
+(println "f11")
+(f11 1)
+(f11 1 2)
+(f11 1 2 -1)
+(f11 1 2 -1 -2)
+(f11 1 2 -1 -2 -3)
+(f11 1 2 -1 -2 -3 -4)
+
+(println "f21")
+(f21 1 2)
+(f21 1 2 3)
+(f21 1 2 3 -1)
+(f21 1 2 3 -1 -2)
+(f21 1 2 3 -1 -2 -3)
+(f21 1 2 3 -1 -2 -3 -4)
+
+(println "f31")
+(f31 1 2 3)
+(f31 1 2 3 4)
+(f31 1 2 3 4 -1)
+(f31 1 2 3 4 -1 -2)
+(f31 1 2 3 4 -1 -2 -3)
+(f31 1 2 3 4 -1 -2 -3 -4)
+
+(println "f41")
+(f41 1 2 3 4)
+(f41 1 2 3 4 5)
+(f41 1 2 3 4 5 -1)
+(f41 1 2 3 4 5 -1 -2)
+(f41 1 2 3 4 5 -1 -2 -3)
+(f41 1 2 3 4 5 -1 -2 -3 -4)
+
+
+(println "f02")
+(f02)
+(f02 1)
+(f02 1 2)
+(f02 1 2 -1)
+(f02 1 2 -1 -2)
+(f02 1 2 -1 -2 -3)
+(f02 1 2 -1 -2 -3 -4)
+
+(println "f12")
+(f12 1)
+(f12 1 2)
+(f12 1 2 3)
+(f12 1 2 3 -1)
+(f12 1 2 3 -1 -2)
+(f12 1 2 3 -1 -2 -3)
+(f12 1 2 3 -1 -2 -3 -4)
+
+(println "f22")
+(f22 1 2)
+(f22 1 2 3)
+(f22 1 2 3 4)
+(f22 1 2 3 4 -1)
+(f22 1 2 3 4 -1 -2)
+(f22 1 2 3 4 -1 -2 -3)
+(f22 1 2 3 4 -1 -2 -3 -4)
+
+(println "f32")
+(f32 1 2 3)
+(f32 1 2 3 4)
+(f32 1 2 3 4 5)
+(f32 1 2 3 4 5 -1)
+(f32 1 2 3 4 5 -1 -2)
+(f32 1 2 3 4 5 -1 -2 -3)
+(f32 1 2 3 4 5 -1 -2 -3 -4)
+
+(println "f42")
+(f42 1 2 3 4)
+(f42 1 2 3 4 5)
+(f42 1 2 3 4 5 6)
+(f42 1 2 3 4 5 6 -1)
+(f42 1 2 3 4 5 6 -1 -2)
+(f42 1 2 3 4 5 6 -1 -2 -3)
+(f42 1 2 3 4 5 6 -1 -2 -3 -4)
+
+
+(println "f03")
+(f03)
+(f03 1)
+(f03 1 2)
+(f03 1 2 3)
+(f03 1 2 3 -1)
+(f03 1 2 3 -1 -2)
+(f03 1 2 3 -1 -2 -3)
+(f03 1 2 3 -1 -2 -3 -4)
+
+(println "f13")
+(f13 1)
+(f13 1 2)
+(f13 1 2 3)
+(f13 1 2 3 4)
+(f13 1 2 3 4 -1)
+(f13 1 2 3 4 -1 -2)
+(f13 1 2 3 4 -1 -2 -3)
+(f13 1 2 3 4 -1 -2 -3 -4)
+
+(println "f23")
+(f23 1 2)
+(f23 1 2 3)
+(f23 1 2 3 4)
+(f23 1 2 3 4 5)
+(f23 1 2 3 4 5 -1)
+(f23 1 2 3 4 5 -1 -2)
+(f23 1 2 3 4 5 -1 -2 -3)
+(f23 1 2 3 4 5 -1 -2 -3 -4)
+
+(println "f33")
+(f33 1 2 3)
+(f33 1 2 3 4)
+(f33 1 2 3 4 5)
+(f33 1 2 3 4 5 6)
+(f33 1 2 3 4 5 6 -1)
+(f33 1 2 3 4 5 6 -1 -2)
+(f33 1 2 3 4 5 6 -1 -2 -3)
+(f33 1 2 3 4 5 6 -1 -2 -3 -4)
+
+(println "f43")
+(f43 1 2 3 4)
+(f43 1 2 3 4 5)
+(f43 1 2 3 4 5 6)
+(f43 1 2 3 4 5 6 7)
+(f43 1 2 3 4 5 6 7 -1)
+(f43 1 2 3 4 5 6 7 -1 -2)
+(f43 1 2 3 4 5 6 7 -1 -2 -3)
+(f43 1 2 3 4 5 6 7 -1 -2 -3 -4)
+
+
+(println "f04")
+(f04)
+(f04 1)
+(f04 1 2)
+(f04 1 2 3)
+(f04 1 2 3 4)
+(f04 1 2 3 4 -1)
+(f04 1 2 3 4 -1 -2)
+(f04 1 2 3 4 -1 -2 -3)
+(f04 1 2 3 4 -1 -2 -3 -4)
+
+(println "f14")
+(f14 1)
+(f14 1 2)
+(f14 1 2 3)
+(f14 1 2 3 4)
+(f14 1 2 3 4 5)
+(f14 1 2 3 4 5 -1)
+(f14 1 2 3 4 5 -1 -2)
+(f14 1 2 3 4 5 -1 -2 -3)
+(f14 1 2 3 4 5 -1 -2 -3 -4)
+
+(println "f24")
+(f24 1 2)
+(f24 1 2 3)
+(f24 1 2 3 4)
+(f24 1 2 3 4 5)
+(f24 1 2 3 4 5 6)
+(f24 1 2 3 4 5 6 -1)
+(f24 1 2 3 4 5 6 -1 -2)
+(f24 1 2 3 4 5 6 -1 -2 -3)
+(f24 1 2 3 4 5 6 -1 -2 -3 -4)
+
+(println "f34")
+(f34 1 2 3)
+(f34 1 2 3 4)
+(f34 1 2 3 4 5)
+(f34 1 2 3 4 5 6)
+(f34 1 2 3 4 5 6 7)
+(f34 1 2 3 4 5 6 7 -1)
+(f34 1 2 3 4 5 6 7 -1 -2)
+(f34 1 2 3 4 5 6 7 -1 -2 -3)
+(f34 1 2 3 4 5 6 7 -1 -2 -3 -4)
+
+(println "f44")
+(f44 1 2 3 4)
+(f44 1 2 3 4 5)
+(f44 1 2 3 4 5 6)
+(f44 1 2 3 4 5 6 7)
+(f44 1 2 3 4 5 6 7 8)
+(f44 1 2 3 4 5 6 7 8 -1)
+(f44 1 2 3 4 5 6 7 8 -1 -2)
+(f44 1 2 3 4 5 6 7 8 -1 -2 -3)
+(f44 1 2 3 4 5 6 7 8 -1 -2 -3 -4)
4 include/stamp.h
View
@@ -2,5 +2,5 @@
* Time stamp of last source code repository commit.
*/
-#define ___STAMP_YMD 20140221
-#define ___STAMP_HMS 171448
+#define ___STAMP_YMD 20140224
+#define ___STAMP_HMS 35435
Please sign in to comment.
Something went wrong with that request. Please try again.