fixes and nits

src/codegen/pattern.lisp

@@ -6,7 +6,6 @@
    (#:tc #:coalton-impl/typechecker))
   (:export
    #:pattern                            ; STRUCT
-   #:pattern-source                     ; ACCESSOR THIS DOESN'T SEEM TO EXIST
    #:pattern-type                       ; ACCESSOR
    #:pattern-list                       ; TYPE
    #:pattern-var                        ; STRUCT

src/parser/expression.lisp

@@ -975,31 +975,48 @@ this list.")
 
     ((and (cst:atom (cst:first form))
           (eq 'coalton:while-let (cst:raw (cst:first form))))
-     (macrolet ((while-let-error (note)
-                  `(error 'parse-error
-                          :err (coalton-error
-                                :span (cst:source form)
-                                :file file
-                                :highlight :end
-                                :message "Malformed while-let expression"
-                                :primary-note ,note))))
-
-       ;; (while-let)
-       (unless (cst:consp (cst:nthrest 1 form))
-         (while-let-error "expected pattern")) 
+
+     ;; (while-let)
+     (unless (cst:consp (cst:nthrest 1 form))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed while-let expression"
+                    :primary-note  "expected pattern"))) 
 
-       ;; (while-let pattern)
-       (unless (and (cst:consp (cst:nthrest 2 form))
-                    (eq 'coalton:= (cst:raw (cst:nth 2 form))))
-         (while-let-error "expected ="))
+     ;; (while-let pattern)
+     (unless (and (cst:consp (cst:nthrest 2 form))
+                  (eq 'coalton:= (cst:raw (cst:nth 2 form))))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed while-let expression"
+                    :primary-note  "expected =")))
 
-       ;; (when-let pattern =)
-       (unless (cst:consp (cst:nthrest 3 form))
-         (while-let-error "expected expression"))
+     ;; (when-let pattern =)
+     (unless (cst:consp (cst:nthrest 3 form))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed while-let expression"
+                    :primary-note "expected expression")))
 
        ;; (when-let pattern = expr)
-       (unless (cst:consp (cst:nthrest 4 form))
-         (while-let-error "exptected body")))
+
+     (unless (cst:consp (cst:nthrest 4 form))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed while-let expression"
+                    :primary-note "exptected body")))
 
      (let ((*escapable-loop-context* t))
        (make-node-while-let
@@ -1008,51 +1025,49 @@ this list.")
         :expr (parse-expression (cst:fourth form) file)
         :body (parse-body (cst:nthrest 4 form) form  file))))
 
-
     ((and (cst:atom (cst:first form))
           (eq 'coalton:loop (cst:raw (cst:first form))))
 
-     (let* ((label
-              ;; (loop)
-              (when (and
-                     (cst:consp (cst:rest form))
-                     (cst:atom (cst:second form))
-                     (keywordp (cst:raw (cst:second form))))
-                (cst:raw (cst:second form))))
-            (unparsed-body
-              (cond (label
-                     ;; (loop label)
-                     (if (cst:consp (cst:nthrest 2 form))
-                         (cst:nthrest 2 form)
-                         (error 'parse-error
-                                :err (coalton-error
-                                      :span (cst:source form)
-                                      :file file
-                                      :highlight :end
-                                      :message "Malformed loop expression"
-                                      :primary-note "expected a loop body"))))
-                    ;; (loop)
-                    ((not (cst:consp (cst:rest form)))
-                     (error 'parse-error
-                            :err (coalton-error
-                                  :span (cst:source form)
-                                  :file file
-                                  :highlight :end
-                                  :message "Malformed loop expression"
-                                  :primary-note "expected a loop body or label")))
-
-                    (t
-                     (cst:rest form))))
-            (*escapable-loop-context* t)
-            (*loop-label-context*
-              (if label 
-                  (cons label *loop-label-context*)
-                  *loop-label-context*)))
-
-       (make-node-loop
-        :source (cst:source form)
-        :label label
-        :body (parse-body unparsed-body form file))))
+      (let* ((label
+               (when (and
+                      (cst:consp (cst:rest form))
+                      (cst:atom (cst:second form))
+                      (keywordp (cst:raw (cst:second form))))
+                 (cst:raw (cst:second form))))
+             (unparsed-body
+               (cond (label
+                      ;; (loop label)
+                      (if (cst:consp (cst:nthrest 2 form))
+                          (cst:nthrest 2 form)
+                          (error 'parse-error
+                                 :err (coalton-error
+                                       :span (cst:source form)
+                                       :file file
+                                       :highlight :end
+                                       :message "Malformed loop expression"
+                                       :primary-note "expected a loop body"))))
+                     ;; (loop)
+                     ((not (cst:consp (cst:rest form)))
+                      (error 'parse-error
+                             :err (coalton-error
+                                   :span (cst:source form)
+                                   :file file
+                                   :highlight :end
+                                   :message "Malformed loop expression"
+                                   :primary-note "expected a loop body or label")))
+
+                     (t
+                      (cst:rest form))))
+             (*escapable-loop-context* t)
+             (*loop-label-context*
+               (if label 
+                   (cons label *loop-label-context*)
+                   *loop-label-context*)))
+
+        (make-node-loop
+         :source (cst:source form)
+         :label label
+         :body (parse-body unparsed-body form file))))
 
     ((and (cst:atom (cst:first form))
           (eq 'coalton:break (cst:raw (cst:first form))))
@@ -1065,27 +1080,24 @@ this list.")
                       ;; (break not-a-keyword)
                       (error 'parse-error
                              :err (coalton-error
-                                   :span (cst:source form)
+                                   :span (cst:source (cst:second form))
                                    :file file
-                                   :highlight :end
-                                   :message "Invalid break expression"
-                                   :primary-note "expected a keyword label"))))))                 
+                                   :message "Invalid label in break"
+                                   :primary-note "expected a keyword"))))))                 
        (when label
          (unless (member label *loop-label-context*)
            (error 'parse-error
                   :err (coalton-error
-                        :span (cst:source form)
+                        :span (cst:source (cst:second form))
                         :file file
-                        :highlight :end
-                        :message "Invalid break expression"
-                        :primary-note (format nil "Label ~s not found in any enclosing loop" label)))))
+                        :message "Invalid label in break"
+                        :primary-note "Label not found in any enclosing loop"))))
 
        (unless *escapable-loop-context*
          (error 'parse-error
                 :err (coalton-error
                       :span (cst:source form)
                       :file file
-                      :highlight :end
                       :message "Invalid break expression"
                       :primary-note "no enclosing loop")))
 
@@ -1103,27 +1115,24 @@ this list.")
                       ;; (continue not-a-keyword)
                       (error 'parse-error
                              :err (coalton-error
-                                   :span (cst:source form)
+                                   :span (cst:source (cst:second form))
                                    :file file
-                                   :highlight :end
-                                   :message "Invalid continue expression"
-                                   :primary-note "expected a keyword label"))))))                 
+                                   :message "Invalid label in continue"
+                                   :primary-note "expected a keyword"))))))                 
        (when label
          (unless (member label *loop-label-context*)
            (error 'parse-error
                   :err (coalton-error
-                        :span (cst:source form)
+                        :span (cst:source (cst:second form))
                         :file file
-                        :highlight :end
-                        :message "Invalid continue expression"
-                        :primary-note (format nil "Label ~s not found in any enclosing loop" label)))))
+                        :message "Invalid label in continue"
+                        :primary-note "Label not found in any enclosing loop"))))
 
        (unless *escapable-loop-context*
          (error 'parse-error
                 :err (coalton-error
                       :span (cst:source form)
                       :file file
-                      :highlight :end
                       :message "Invalid continue expression"
                       :primary-note "no enclosing loop")))
 
@@ -1132,30 +1141,47 @@ this list.")
 
     ((and (cst:atom (cst:first form))
           (eq 'coalton:for (cst:raw (cst:first form))))
-     (macrolet ((for-error (note)
-                  `(error 'parse-error
-                          :err (coalton-error
-                                :span (cst:source form)
-                                :file file
-                                :highlight :end
-                                :message "Malformed for expression"
-                                :primary-note ,note))))
-       ;; (for)
-       (unless (cst:consp (cst:nthrest 1 form))
-         (for-error "expected pattern")) 
+
+     ;; (for)
+     (unless (cst:consp (cst:nthrest 1 form))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed for expression"
+                    :primary-note  "expected pattern"))) 
 
-       ;; (for pattern)
-       (unless (and (cst:consp (cst:nthrest 2 form))
-                    (eq 'coalton:in (cst:raw (cst:nth 2 form))))
-         (for-error "expected in"))
-
-       ;; (for pattern in)
-       (unless (cst:consp (cst:nthrest 3 form))
-         (for-error "expected expression"))
+     ;; (for pattern)
+     (unless (and (cst:consp (cst:nthrest 2 form))
+                  (eq 'coalton:in (cst:raw (cst:nth 2 form))))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed for expression"
+                    :primary-note "expected in")))
+
+     ;; (for pattern in)
+     (unless (cst:consp (cst:nthrest 3 form))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed for expression"
+                    :primary-note  "expected expression")))
 
-       ;; (for pattern in expr)
-       (unless (cst:consp (cst:nthrest 4 form))
-         (for-error "exptected body")))
+     ;; (for pattern in expr)
+     (unless (cst:consp (cst:nthrest 4 form))
+       (error 'parse-error
+              :err (coalton-error
+                    :span (cst:source form)
+                    :file file
+                    :highlight :end
+                    :message "Malformed for expression"
+                    :primary-note "exptected body")))
 
      (let ((*escapable-loop-context* t))
        (make-node-for

src/typechecker/define.lisp

@@ -1271,9 +1271,8 @@ Returns (VALUES INFERRED-TYPE PREDICATES NODE SUBSTITUTIONS)")
 
             (declare (ignore body-ty))
 
-            (setf
-             preds     (append preds     preds_)
-             accessors (append accessors accessors_))
+            (setf preds     (append preds     preds_))
+            (setf accessors (append accessors accessors_))
 
             (handler-case
                 (progn

tests/parser/parse-break.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse-Break
 (package test-parser)
 
-(define f (break))
+(define f (break))

tests/parser/parse-break.good.coalton

@@ -19,4 +19,5 @@
 
 (define m
   (loop :alabel (break)))
+
 

tests/parser/parse-continue.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse Continue
 (package test-parser)
 
-(define f (continue))
+(define f (continue))

tests/parser/parse-for.1.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse For
 (package test-parser)
 
-(define f (for))
+(define f (for))

tests/parser/parse-for.2.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse For
 (package test-parser)
 
-(define f (for x))
+(define f (for x))

tests/parser/parse-for.3.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse For
 (package test-parser)
 
-(define f (for x y))
+(define f (for x y))

tests/parser/parse-for.4.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse For
 (package test-parser)
 
-(define f (for x in iter))
+(define f (for x in iter))

tests/parser/parse-loop.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse Loop
 (package test-parser)
 
-(define f (loop))
+(define f (loop))

tests/parser/parse-while.1.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse While
 (package test-parser)
 
-(define f (while))
+(define f (while))

tests/parser/parse-while.2.bad.coalton

@@ -1,4 +1,4 @@
 ;; BAD: Parse While
 (package test-parser)
 
-(define f (while false))
+(define f (while false))