bjoli/goof-loop
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Big change: lexical scoping

Browse source 
This introduces lexical scoping of for clauses. See README.md
This commit is contained in:
Linus 2021-05-18 18:12:01 +02:00
parent 769553832b
commit 2c323be362
5 changed files with 132 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

67
goof-impl.scm
View file

@ -29,7 +29,7 @@
(define-aux-syntaxes
;; Auxiliary syntax for the loop clauses
:when :unless :break :final :bind :subloop :for :acc
:when :unless :break :final :bind :do :subloop :for :acc
;; Auxiliary syntax for the iterators.
:gen
;; auxiliary auxiliary syntax
@ -121,7 +121,7 @@
;; cl sorts all the clauses into subloops and positions everything where it should be.
(define-syntax cl
(syntax-rules (=> :for :acc :when :unless :break :final :bind :subloop)
(syntax-rules (=> :for :acc :when :unless :break :final :do :bind :subloop)
((_ orig name l a v c r f ff user () => expr . body)
(emit orig name l a v c r f ff user expr . body))
((_ orig name l a v c r f ff user () . body)
@ -143,8 +143,12 @@
(cl orig name l a v c r f ff ((cur-ub ... (:break expr)) . ub-rest) (clauses ...) . body))
;; user final
;; This pushes a #t to the user when expression, thus forcing a subloop if a for-clause is found afterwards.
((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest)((:final expr) clauses ...) . body)
(cl orig name l a v c r f ff ((cur-uw ... (:final expr)) . uw-rest) (clauses ...) . body))
((_ orig name l a v c r f ff user ((:final expr) clauses ...) . body)
(final :acc ((_) (expr)) cl-next/acc orig name l a v c r f ff user (clauses ...) . body))
;; User do - sideffecting stuff.
((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) ((:do expr ...) clauses ...) . body)
(cl orig name l a v c r f ff ((cur-uw ... (:do expr ...)) . uw-rest) (clauses ...) . body))
;; Explicit subloop. Shorthand for (:when #t)
((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) (:subloop clauses ...) . body)
@ -164,9 +168,9 @@
;; ERROR HANDLING?
((_ orig name l a v c r f ff user (clause . rest) . body)
(syntax-error "Invalid clause in loop" clause orig))
(syntax-error "Invalid clause in loop" clause orig))))
))
;; HOLY CODE-DUPLICATION-BATMAN!
@ -184,15 +188,15 @@
checks
((refs ...))
(finals ...)
ff ul uw ((cur-ub ...) . ub-rest) uf clauses . body)
ff ((cur-ub ...) . ub-rest) clauses . body)
(cl orig name
((lets ... new-lets ...))
((accs ... (accvar accinit accupdate) ...))
((accs ... (accvar accinit accvar) ...))
vars
checks
((refs ... new-refs ...))
(finals ... new-finals ...)
ff ul uw ((cur-ub ... new-checks ...) . ub-rest) uf clauses . body))
ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body))
;; We have ONE subloop!
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name
@ -202,15 +206,15 @@
checks
((refs ...) . refs-rest)
(finals ...)
ff ul uw ((cur-ub ...) . ub-rest) uf clauses . body)
ff ((cur-ub ...) . ub-rest) clauses . body)
(cl orig name
(lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
((accs ... (accvar accvar accvar) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
vars
checks
((refs ... new-refs ...) . refs-rest)
(finals ... new-finals ...)
ff ul uw ((cur-ub ... new-checks ...) . ub-rest) uf clauses . body))
ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body))
;; We have several subloops!
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name
@ -220,16 +224,16 @@
checks
((refs ...) . refs-rest)
(finals ...)
ff ul uw ((cur-ub ...) . ub-rest) uf clauses . body)
ff ((cur-ub ...) . ub-rest) clauses . body)
(cl orig name
(lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
((accs ... (accvar accvar accvar) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...))
vars
checks
((refs ... new-refs ...) . refs-rest)
(finals ... new-finals ...)
ff ul uw ((cur-ub ... new-checks ...) . ub-rest) uf clauses . body))))
ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body))))
;; Integrating for clauses is not as involved, since they only want to be introduced into the current
;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop
@ -259,15 +263,13 @@
(define-syntax user
(syntax-rules (:when :bind :break :final :nop)
(syntax-rules (:when :bind :break :do :nop)
((_ final-expr next outer () body ...)
(begin body ...))
((_ f n o (:nop . rest) . body)
(user f n o rest . body))
((_ f n o ((:bind pairs ...) . rest) . body)
(let (pairs ...)
(ref-let (pairs ...)
(user f n o rest . body)))
((_ f n o ((:when test) . rest) . body)
(cond
@ -277,8 +279,12 @@
(cond
(expr final-expr ...)
(else (user (final-expr ...) n o rest . body))))
((_ f n o ((:do expr ...) . rest) . body)
(begin
expr ...
(user f n o rest . body)))))
))
;; If there are no subloops, we emit to the simple case
(define-syntax emit
@ -413,6 +419,7 @@
(user (ff-cur ... ff-above ... final)
(intermediate-loop accstep ... step ...)
#f
(us ...)
(emit-many/rest orig
name
(intermediate-loop accstep ... step ...)
@ -427,14 +434,14 @@
. body)))))))))
(define-syntax forify
(syntax-rules (%acc)
((_ orig name () ((%acc . acc-rest) . argsrest) . body)
(forify* orig name () ((:for ensure-once (up-from 0 1)) (%acc . acc-rest) . argsrest) . body))
((_ . rest)
(forify* . rest))))
(syntax-rules (%acc)
((_ orig name () ((%acc . acc-rest) . argsrest) . body)
(forify* orig name () ((:for ensure-once (up-from 0 1)) (%acc . acc-rest) . argsrest) . body))
((_ . rest)
(forify* . rest))))
(define-syntax forify*
(syntax-rules (:for :acc :when :unless :break :final :subloop :let :let* %acc)
(syntax-rules (:for :acc :when :unless :break :final :subloop :bind :do %acc)
((_ o n done-clauses () . body)
(%loop o n done-clauses . body))
((_ o n (s ...) ((:for c-rest ...) clauses ...) . body)
@ -447,12 +454,12 @@
(forify* o n (s ... (:break expr)) (clauses ...) . body))
((_ o n (s ...) ((:final expr) clauses ...) . body)
(forify* o n (s ... (:final expr)) (clauses ...) . body))
((_ o n (s ...) ((:do expr ...) clauses ...) . body)
(forify* o n (s ... (:do expr ...)) (clauses ...) . body))
((_ o n (s ...) (:subloop clauses ...) . body)
(forify* o n (s ... :subloop) (clauses ...) . body))
((_ o n (s ...) ((:let id id* ... expr) clauses ...) . body)
(forify* o n (s ... (:let id id* ... expr)) (clauses ...) . body))
((_ o n (s ...) ((:let* id id* ... expr) clauses ...) . body)
(forify* o n (s ... (:let* id id* ... expr)) (clauses ...) . body))
((_ o n (s ...) ((:bind pairs ...) clauses ...) . body)
(forify* o n (s ... (:bind pairs ...)) (clauses ...) . body))
((_ o n (s ...) ((%acc c-rest ...) clauses ...) . body)
(forify* o n (s ... (:acc c-rest ...)) (clauses ...) . body))
((_ o n (s ...) ((:acc c-rest ...) clauses ...) . body)