Skip to content

Commit

Permalink
Untabify and remove copyright statement.
Browse files Browse the repository at this point in the history
  • Loading branch information
@robert-strandh
robert-strandh committed Sep 22, 2020
1 parent 91275c0 commit e7fd4ea
Show file tree
Hide file tree
Showing 3 changed files with 109 additions and 121 deletions.
2 changes: 1 addition & 1 deletion Code/Loop/Test/loop-defmacro.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,5 +3,5 @@
(defmacro loop (&rest forms)
(let ((end-tag (gensym)))
`(macrolet ((loop-finish ()
`(go ,',end-tag)))
`(go ,',end-tag)))
,(sicl-loop::expand-body forms end-tag))))
86 changes: 43 additions & 43 deletions Code/Loop/Test/loop-test.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,10 +9,10 @@

(defmacro deftest (name form &rest results)
`(push (make-instance 'test
:name ',name
:form ',form
:results ',results)
*tests*))
:name ',name
:form ',form
:results ',results)
*tests*))

(defmacro signals-error (form error-type)
`(handler-case (eval ,form)
Expand All @@ -25,7 +25,7 @@

(defun run-test (test)
(assert (equal (multiple-value-list (eval (form test)))
(results test))))
(results test))))

(deftest loop-until-t
(loop until t)
Expand All @@ -50,67 +50,67 @@
(deftest loop-do
(let ((n 0))
(block abc
(loop do (progn (incf n)
(when (= n 10)
(return-from abc nil)))))
(loop do (progn (incf n)
(when (= n 10)
(return-from abc nil)))))
n)
10)

(defun loop-until-do ()
(assert (equal (let ((n 0))
(loop until (= n 10)
do (incf n))
n)
10)))
(loop until (= n 10)
do (incf n))
n)
10)))

(defun loop-repeat-do ()
(assert (equal (let ((n 0))
(loop repeat 5
do (incf n 2))
n)
10)))
(loop repeat 5
do (incf n 2))
n)
10)))

(defun loop-with-repeat-do ()
(assert (equal (let ((n 0))
(loop with step = 2
repeat 5
do (incf n step))
n)
10)))
(loop with step = 2
repeat 5
do (incf n step))
n)
10)))

(defun loop-initially-repeat-do ()
(assert (equal (let ((n 0))
(loop initially (incf n 10)
repeat 2
do (setf n (* n 2)))
n)
40)))
(loop initially (incf n 10)
repeat 2
do (setf n (* n 2)))
n)
40)))

(defun loop-repeat-do-finally ()
(assert (equal (let ((n 0))
(loop repeat 2
do (incf n 10)
finally (setf n (* n 2)))
n)
40)))
(loop repeat 2
do (incf n 10)
finally (setf n (* n 2)))
n)
40)))

;; (defun loop-with-repeat-do-collect-finally ()
;; (assert (equal (let ((result nil))
;; (loop with n = 0
;; repeat 4
;; do (incf n)
;; collect n into foo
;; finally (setf result foo))
;; result)
;; '(1 2 3 4))))
;; (loop with n = 0
;; repeat 4
;; do (incf n)
;; collect n into foo
;; finally (setf result foo))
;; result)
;; '(1 2 3 4))))

;; (defun loop-repeat-sum-finally ()
;; (assert (equal (let ((result nil))
;; (loop repeat 5
;; sum 2 into foo
;; finally (setf result foo))
;; result)
;; 10)))
;; (loop repeat 5
;; sum 2 into foo
;; finally (setf result foo))
;; result)
;; 10)))

(defun loop-test ()
(mapc #'run-test *tests*)
Expand Down
142 changes: 65 additions & 77 deletions Code/Loop/combinatory-parsing.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,15 +1,3 @@
;;;; Copyright (c) 2014
;;;;
;;;; Robert Strandh ([email protected])
;;;;
;;;; all rights reserved.
;;;;
;;;; Permission is hereby granted to use this software for any
;;;; purpose, including using, modifying, and redistributing it.
;;;;
;;;; The software is provided "as-is" with no warranty. The user of
;;;; this software assumes any responsibility of the consequences.

(cl:in-package #:sicl-loop)

;;; A parser is a function that takes a list of tokens to parse, and
Expand All @@ -34,14 +22,14 @@
(defun parse-trace-output (format-control &rest arguments)
(when *parse-trace-p*
(format *trace-output*
(make-string (* 2 *indent-level*) :initial-element #\Space))
(make-string (* 2 *indent-level*) :initial-element #\Space))
(apply #'format *trace-output* format-control arguments)))

(defun trace-parser (name parser tokens)
(let ((*indent-level* (1+ *indent-level*)))
(parse-trace-output "trying ~s on ~s~%" name tokens)
(multiple-value-bind (successp result rest)
(funcall parser tokens)
(funcall parser tokens)
(parse-trace-output "~asuccess~%" (if successp "" "no "))
(values successp result rest))))

Expand All @@ -52,15 +40,15 @@
;; warnings at compile time saying the function does not exist.
(eval-when (:compile-toplevel)
(setf (fdefinition ',name)
(lambda (tokens)
(declare (ignore tokens))
(error "Undefined parser: ~s" ',name))))
(lambda (tokens)
(declare (ignore tokens))
(error "Undefined parser: ~s" ',name))))
;; At load time, we set the FDEFINITION of the name to the
;; result of executing BODY.
(eval-when (:load-toplevel :execute)
(setf (fdefinition ',name)
(lambda (tokens)
(trace-parser ',name (progn ,@body) tokens))))))
(lambda (tokens)
(trace-parser ',name (progn ,@body) tokens))))))

;;; Take a function designator (called the TRANSFORMER) and a
;;; predicate P and return a parser Q that invokes the predicate on
Expand All @@ -85,16 +73,16 @@
;; TAGBODY instead.
(block nil
(let ((remaining-parsers parsers))
(tagbody
again
(if (null remaining-parsers)
(return (values nil nil tokens))
(multiple-value-bind (successp result rest)
(funcall (car remaining-parsers) tokens)
(pop remaining-parsers)
(if successp
(return (values t result rest))
(go again)))))))))
(tagbody
again
(if (null remaining-parsers)
(return (values nil nil tokens))
(multiple-value-bind (successp result rest)
(funcall (car remaining-parsers) tokens)
(pop remaining-parsers)
(if successp
(return (values t result rest))
(go again)))))))))

;;; Take a function designator (called the COMBINER) and a list of
;;; parsers P1, P2, ..., Pn and return a parser Q that invokes every
Expand All @@ -108,22 +96,22 @@
;; TAGBODY instead.
(block nil
(let ((remaining-tokens tokens)
(remaining-parsers parsers)
(results '()))
(tagbody
again
(if (null remaining-parsers)
(return (values t
(apply combiner (reverse results))
remaining-tokens))
(multiple-value-bind (successp result rest)
(funcall (car remaining-parsers) remaining-tokens)
(pop remaining-parsers)
(if successp
(progn (push result results)
(setf remaining-tokens rest)
(go again))
(return (values nil nil tokens))))))))))
(remaining-parsers parsers)
(results '()))
(tagbody
again
(if (null remaining-parsers)
(return (values t
(apply combiner (reverse results))
remaining-tokens))
(multiple-value-bind (successp result rest)
(funcall (car remaining-parsers) remaining-tokens)
(pop remaining-parsers)
(if successp
(progn (push result results)
(setf remaining-tokens rest)
(go again))
(return (values nil nil tokens))))))))))

;;; Take a function designator (called the COMBINER) and a parser P
;;; and return a parser Q that invokes P repeatedly until it fails,
Expand All @@ -136,19 +124,19 @@
(defun repeat* (combiner parser)
(lambda (tokens)
(let ((remaining-tokens tokens)
(results '()))
(results '()))
(block nil
(tagbody
again
(multiple-value-bind (successp result rest)
(funcall parser remaining-tokens)
(if successp
(progn (push result results)
(setf remaining-tokens rest)
(go again))
(return (values t
(apply combiner (reverse results))
remaining-tokens)))))))))
(tagbody
again
(multiple-value-bind (successp result rest)
(funcall parser remaining-tokens)
(if successp
(progn (push result results)
(setf remaining-tokens rest)
(go again))
(return (values t
(apply combiner (reverse results))
remaining-tokens)))))))))

;;; Take a function designator (called the COMBINER) and a parser P
;;; and return a parser Q that invokes P repeatedly until it fails,
Expand All @@ -160,23 +148,23 @@
(lambda (tokens)
(let ((results '()))
(multiple-value-bind (successp result rest)
(funcall parser tokens)
(if (not successp)
(values nil nil tokens)
(let ((remaining-tokens rest))
(push result results)
(block nil
(tagbody
again
(multiple-value-bind (successp result rest)
(funcall parser remaining-tokens)
(if successp
(progn (push result results)
(setf remaining-tokens rest)
(go again))
(return (values t
(apply combiner (reverse results))
remaining-tokens))))))))))))
(funcall parser tokens)
(if (not successp)
(values nil nil tokens)
(let ((remaining-tokens rest))
(push result results)
(block nil
(tagbody
again
(multiple-value-bind (successp result rest)
(funcall parser remaining-tokens)
(if successp
(progn (push result results)
(setf remaining-tokens rest)
(go again))
(return (values t
(apply combiner (reverse results))
remaining-tokens))))))))))))

;;; Take a default value and a parser P and return a parser Q that
;;; always succeeds. Q invokes P once. If P succeeds, then Q
Expand All @@ -186,9 +174,9 @@
(defun optional (default parser)
(lambda (tokens)
(multiple-value-bind (successp result rest)
(funcall parser tokens)
(funcall parser tokens)
(if successp
(values t result rest)
(values t default tokens)))))
(values t result rest)
(values t default tokens)))))

;;; LocalWords: parsers

0 comments on commit e7fd4ea

Please sign in to comment.