Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

coalton:match to codegen cl:case when possible #1399

Open
wants to merge 11 commits into
base: main
Choose a base branch
from
+134 −21
Open

coalton:match to codegen cl:case when possible #1399

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
cb0c1d3
match codegen optimization
garlic0x1 Feb 9, 2025
c513646
fix bugs
garlic0x1 Feb 9, 2025
5b68c48
match CL:CASE on enums and explicit number types
garlic0x1 Mar 5, 2025
ddc7802
testing enum matching
garlic0x1 Mar 5, 2025
ac769e1
repr enum works great now
garlic0x1 Mar 6, 2025
fed5068
error messages and tests
garlic0x1 Mar 6, 2025
eda1af1
beat the ccl tests
garlic0x1 Mar 6, 2025
cfeccf4
nvm
garlic0x1 Mar 6, 2025
e0d4aa1
ccl plz?
garlic0x1 Mar 6, 2025
c54cc21
inline eq
garlic0x1 Mar 6, 2025
e27aa5d
Merge branch 'main' into match-codegen
garlic0x1 Mar 6, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 9 additions & 6 deletions library/math/num.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,12 +45,15 @@

(cl:eval-when (:compile-toplevel :load-toplevel)
(cl:defmacro define-eq (type)
`(define-instance (Eq ,type)
(inline)
(define (== a b)
(lisp Boolean (a b)
;; Use cl:= so that (== 0.0 -0.0) => True
(cl:= a b)))))))
`(progn
(lisp-toplevel ()
(cl:pushnew ',type coalton-impl/typechecker/types:*number-types*))
(define-instance (Eq ,type)
(inline)
(define (== a b)
(lisp Boolean (a b)
;; Use cl:= so that (== 0.0 -0.0) => True
(cl:= a b))))))))

(define-eq Integer)
(define-eq IFix)
Expand Down
59 changes: 58 additions & 1 deletion src/codegen/codegen-expression.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -172,6 +172,63 @@
,(codegen-expression (match-branch-body (first (node-match-branches expr))) env)
,(codegen-expression (match-branch-body (second (node-match-branches expr))) env))))

;; Do cl:if when the order is reversed as well (this method is getting fat)
(when (and (equalp (node-type (node-match-expr expr)) tc:*boolean-type*)
(= 2 (length (node-match-branches expr)))
(equalp (match-branch-pattern (first (node-match-branches expr)))
(make-pattern-constructor :type tc:*boolean-type* :name 'coalton:False :patterns nil))
Copy link
Collaborator

@YarinHeffes YarinHeffes Mar 6, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Currently, we only codegen if when

(match bool
  ((True) ...)
  ((False) ...))

but not for

(match bool
  (True ...)
  (False ...))

I think this simple change could allow both:

Suggested change
(make-pattern-constructor :type tc:*boolean-type* :name 'coalton:False :patterns nil))
(or (make-pattern-constructor :type tc:*boolean-type* :name 'coalton:False :patterns nil))
(make-pattern-literal ...))

EDIT:

Actually, no, this won't work! In the main branch

(match True
  (True "hi")
  (False "bye"))

returns "hi"... but so does this:

(match True
  (False "hi")
  (True "bye"))

because False is being read as a variable!

So actually, I think we should emit an "unused variable" error in this case. And, that's a separate issue not related to this PR.

EDIT no. 2:

I think this problem only creates confusion for Enums and Booleans, so your PR will actually fix this, and if this is merged, I don't think there is a reason to open a separate issue.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's a long-standing issue that pattern variables can be confused as constructors by the programmer and we emit no good warning for this.

(equalp (match-branch-pattern (second (node-match-branches expr)))
(make-pattern-constructor :type tc:*boolean-type* :name 'coalton:True :patterns nil)))
(return-from codegen-expression
`(if ,(codegen-expression (node-match-expr expr) env)
,(codegen-expression (match-branch-body (second (node-match-branches expr))) env)
,(codegen-expression (match-branch-body (first (node-match-branches expr))) env))))

;; If we can use case, do that because a jump table is faster than cond
(let ((ty (node-type (node-match-expr expr))))
(when (or
;; Matching a number
(find ty (tc:number-types) :test #'equalp)
;; Matching a Char
(equalp ty tc:*char-type*)
;; Matching an Enum
(and (tc:tycon-p ty) (tc:type-entry-enum-repr (tc:lookup-type env (tc:tycon-name ty)))))
(return-from codegen-expression
(let ((subexpr (codegen-expression (node-match-expr expr) env))
(match-var (gensym "MATCH")))
`(let ((,match-var
,(if settings:*emit-type-annotations*
`(the ,(tc:lisp-type (node-type (node-match-expr expr)) env) ,subexpr)
subexpr)))
(declare (ignorable ,match-var))
(case ,(codegen-expression (node-match-expr expr) env)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This can be

Suggested change
(case ,(codegen-expression (node-match-expr expr) env)
(case ,subexpr

or even

Suggested change
(case ,(codegen-expression (node-match-expr expr) env)
(case ,match-var

,@(loop :for branch :in (node-match-branches expr)
:for pattern := (match-branch-pattern branch)
:for expr := (codegen-expression (match-branch-body branch) env)
:collect
(multiple-value-bind (pred bindings)
(codegen-pattern pattern match-var env)
(declare (ignore pred))
(cond ((pattern-literal-p pattern)
`(,(pattern-literal-value pattern)
,expr))
((pattern-constructor-p pattern)
(let* ((name (pattern-constructor-name pattern))
(entry (tc:lookup-constructor env name)))
`(,(tc:constructor-entry-compressed-repr entry)
,expr)))
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I get a bad error message for this example

(coalton-toplevel
  (repr :enum)
  (define-type MyEnum A B C))

(coalton
  (match A
    (A "hi")
    (B "bye")))

Because the patterns are read as pattern-vars and fall into t, and codegen otherwise for both of them:

(COMMON-LISP:LET ((#:MATCH4047
                   (COMMON-LISP:THE
                    (COMMON-LISP:MEMBER MYENUM/D MYENUM/C MYENUM/B MYENUM/A)
                    A)))
  (COMMON-LISP:DECLARE (COMMON-LISP:IGNORABLE #:MATCH4047))
  (COMMON-LISP:CASE A
    (COMMON-LISP:OTHERWISE
     (COMMON-LISP:LET ((A-3464 #:MATCH4047))
       "hi"))
    (COMMON-LISP:OTHERWISE
     (COMMON-LISP:LET ((B-3465 #:MATCH4047))
       "bye"))))

I think there should be a check to ensure that a variable or _ is only passed in the last branch.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If we add this check (it makes sense) we should do this before codegen.

(t
`(otherwise (let ,bindings ,expr))))))

;; Only emit a fallback if there is not a catch-all clause.
,@(unless (member-if (lambda (pat)
(or (pattern-wildcard-p pat)
(pattern-var-p pat)))
(node-match-branches expr)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If a check is done to ensure that a variable or _ is only passed in the last branch (see comment above), then this check here can just be a check on the last branch.

:key #'match-branch-pattern)
`((otherwise
(error "Fell through a non-exhaustive match."))))))))))

;; Otherwise do the thing
(let ((subexpr (codegen-expression (node-match-expr expr) env))
(match-var (gensym "MATCH")))
Expand Down Expand Up @@ -206,7 +263,7 @@
(node-match-branches expr)
:key #'match-branch-pattern)
`((t
(error "Pattern match not exhaustive error")))))))))
(error "Fell through a non-exhaustive match.")))))))))

(:method ((expr node-seq) env)
(declare (type tc:environment env))
Expand Down
12 changes: 12 additions & 0 deletions src/typechecker/types.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,8 @@
#:*fraction-type* ; VARIABLE
#:*arrow-type* ; VARIABLE
#:*list-type* ; VARIABLE
#:*number-types* ; VARIABLE
#:number-types ; FUNCTION
#:push-type-alias ; FUNCTION
#:flatten-type ; FUNCTION
#:apply-type-argument ; FUNCTION
Expand Down Expand Up @@ -266,6 +268,16 @@
(defvar *arrow-type* (make-tycon :name 'coalton:Arrow :kind (make-kfun :from +kstar+ :to (make-kfun :from +kstar+ :to +kstar+))))
(defvar *list-type* (make-tycon :name 'coalton:List :kind (make-kfun :from +kstar+ :to +kstar+)))

;;;
;;; Number Type Registry
;;;

(defvar *number-types*
'(coalton:Integer coalton:IFix coalton:UFix coalton:Single-Float coalton:Double-Float coalton:Fraction))

(defun number-types ()
(mapcar (lambda (name) (make-tycon :name name :kind +kstar+)) *number-types*))

;;;
;;; Operations on Types
;;;
Expand Down
69 changes: 55 additions & 14 deletions tests/pattern-matching-tests.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,32 +1,65 @@
(in-package #:coalton-native-tests)

(coalton-toplevel
(repr :enum)
(define-type MyEnum
Jalapeno
Onion
Lime))

(define-test test-match-on-enum ()
(let ((declare f (MyEnum -> String))
(f (fn (x)
(match x
((Jalapeno) "jalapeno")
((Onion) "onion")
(_ "lime?")))))
(is (== (f Jalapeno) "jalapeno"))
(is (== (f Onion) "onion"))
(is (== (f Lime) "lime?")))

(let ((declare f (Ord -> String))
(f (fn (x)
(match x
((LT) "lt")
((EQ) "eq")
((GT) "gt")))))
(is (== (f LT) "lt"))
(is (== (f EQ) "eq"))
(is (== (f GT) "gt"))))

(define-test test-match-on-ints ()
(let ((f (fn (x)
(match x
(0 "zero")
(1 "one")
(2 "two")
(_ "error")))))
(is (== (f 0)
"zero"))
(is (== (f 1)
"one"))
(is (== (f 2)
"two"))))
(is (== (f 0) "zero"))
(is (== (f 1) "one"))
(is (== (f 2) "two"))
(is (== (f 3) "error")))
(let ((declare f (Integer -> String))
(f (fn (x)
(match x
(0 "zero")
(1 "one")
(2 "two")
(_ "error")))))
(is (== (f 0) "zero"))
(is (== (f 1) "one"))
(is (== (f 2) "two"))
(is (== (f 3) "error"))))

(define-test test-match-on-nums ()

(let ((f (fn (x)
(match x
(0 "zero")
(1 "one")
(2 "two")))))
(is (== (f (the IFix 0))
"zero"))
(is (== (f (the U8 1))
"one"))
(is (== (f (the I16 2))
"two"))))
(is (== (f (the IFix 0)) "zero"))
(is (== (f (the U8 1)) "one"))
(is (== (f (the I16 2)) "two"))))

(define-test test-match-lists ()
(let ((f (fn (xs)
Expand Down Expand Up @@ -72,4 +105,12 @@
(define-test test-match-on-chars ()
(is (match #\c
(#\c True)
(_ False))))
(_ False)))

(let ((declare f (Char -> Boolean))
(f (fn (x)
(match x
(#\c True)
(_ False)))))
(is (== (f #\l) False))
(is (== (f #\c) True))))