diff --git a/src/codegen/pattern.lisp b/src/codegen/pattern.lisp index c2692073c..ad4ff7067 100644 --- a/src/codegen/pattern.lisp +++ b/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 diff --git a/src/parser/expression.lisp b/src/parser/expression.lisp index 7c9284965..2b813b949 100644 --- a/src/parser/expression.lisp +++ b/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 diff --git a/src/typechecker/define.lisp b/src/typechecker/define.lisp index 930b0e7a3..e3cf25e3e 100644 --- a/src/typechecker/define.lisp +++ b/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 diff --git a/tests/parser/parse-break.bad.coalton b/tests/parser/parse-break.bad.coalton index 0780119dc..9fecf977d 100644 --- a/tests/parser/parse-break.bad.coalton +++ b/tests/parser/parse-break.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse-Break (package test-parser) -(define f (break)) \ No newline at end of file +(define f (break)) diff --git a/tests/parser/parse-break.good.coalton b/tests/parser/parse-break.good.coalton index 5b2904538..3f331f4cb 100644 --- a/tests/parser/parse-break.good.coalton +++ b/tests/parser/parse-break.good.coalton @@ -19,4 +19,5 @@ (define m (loop :alabel (break))) + diff --git a/tests/parser/parse-continue.bad.coalton b/tests/parser/parse-continue.bad.coalton index 16097ebcd..cf49c3fcf 100644 --- a/tests/parser/parse-continue.bad.coalton +++ b/tests/parser/parse-continue.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse Continue (package test-parser) -(define f (continue)) \ No newline at end of file +(define f (continue)) diff --git a/tests/parser/parse-for.1.bad.coalton b/tests/parser/parse-for.1.bad.coalton index 0000aaacf..afcd18d3d 100644 --- a/tests/parser/parse-for.1.bad.coalton +++ b/tests/parser/parse-for.1.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse For (package test-parser) -(define f (for)) \ No newline at end of file +(define f (for)) diff --git a/tests/parser/parse-for.2.bad.coalton b/tests/parser/parse-for.2.bad.coalton index 3c6df8f53..ddad66c87 100644 --- a/tests/parser/parse-for.2.bad.coalton +++ b/tests/parser/parse-for.2.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse For (package test-parser) -(define f (for x)) \ No newline at end of file +(define f (for x)) diff --git a/tests/parser/parse-for.3.bad.coalton b/tests/parser/parse-for.3.bad.coalton index 5f6381ac4..4cb1dddb2 100644 --- a/tests/parser/parse-for.3.bad.coalton +++ b/tests/parser/parse-for.3.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse For (package test-parser) -(define f (for x y)) \ No newline at end of file +(define f (for x y)) diff --git a/tests/parser/parse-for.4.bad.coalton b/tests/parser/parse-for.4.bad.coalton index 9434cabad..6f05f8137 100644 --- a/tests/parser/parse-for.4.bad.coalton +++ b/tests/parser/parse-for.4.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse For (package test-parser) -(define f (for x in iter)) \ No newline at end of file +(define f (for x in iter)) diff --git a/tests/parser/parse-loop.bad.coalton b/tests/parser/parse-loop.bad.coalton index 8bb7ffc36..f05eefeda 100644 --- a/tests/parser/parse-loop.bad.coalton +++ b/tests/parser/parse-loop.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse Loop (package test-parser) -(define f (loop)) \ No newline at end of file +(define f (loop)) diff --git a/tests/parser/parse-while.1.bad.coalton b/tests/parser/parse-while.1.bad.coalton index 208d63605..47f9db89e 100644 --- a/tests/parser/parse-while.1.bad.coalton +++ b/tests/parser/parse-while.1.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse While (package test-parser) -(define f (while)) \ No newline at end of file +(define f (while)) diff --git a/tests/parser/parse-while.2.bad.coalton b/tests/parser/parse-while.2.bad.coalton index 9b4b553d5..73d15ce1b 100644 --- a/tests/parser/parse-while.2.bad.coalton +++ b/tests/parser/parse-while.2.bad.coalton @@ -1,4 +1,4 @@ ;; BAD: Parse While (package test-parser) -(define f (while false)) \ No newline at end of file +(define f (while false))