Add pattern matching for record types.

I like scheme because it's possible to add any convenient language
feature I can think of.

1 files changed, 36 insertions, 13 deletions

diff --git a/csc/ir1.csc b/csc/ir1.csc
index d82cf12..73ec703 100644
--- a/csc/ir1.csc
+++ b/csc/ir1.csc
@@ -1,5 +1,16 @@
 (define-library (csc ir1)
   (export
+    %call
+    %constant
+    %define-syntax
+    %if
+    %lambda
+    %letrec
+    %lexical-ref
+    %lexical-set
+    %library-define
+    %library-ref
+    %sequence
     call-arguments
     call-procedure
     call?
@@ -12,7 +23,6 @@
     if-consequent
     if-test
     if?
-    import?
     ir1=?
     lambda-arguments
     lambda-body
@@ -53,7 +63,9 @@
   (import (scheme base)
           (only (csc list)
             all)
-          (only (csc loop) loop return))
+          (only (csc loop) loop return)
+          (only (csc match)
+            define-match-record-type))
   (begin
     ; This library defines the intermediate representation IR1. An expression
     ; in IR1 has one of the following forms (plagiarized from Guile's
@@ -62,9 +74,10 @@
 
     ; <constant> expression
     ; Constant is used to include literal constants in scheme code.
-    (define-record-type <constant>
+    (define-match-record-type <constant>
       (make-constant expression)
       constant?
+      %constant
       (expression constant-expression))
 
 
@@ -72,9 +85,10 @@
     ; A reference to a lexically-bound variable. The name is the original name
     ; of the variable in the source program. gensym is a unique identifier for
     ; this variable.
-    (define-record-type <lexical-ref>
+    (define-match-record-type <lexical-ref>
       (make-lexical-ref name gensym)
       lexical-ref?
+      %lexical-ref
       (name lexical-ref-name)
       (gensym lexical-ref-gensym))
 
@@ -82,27 +96,30 @@
     ; <library-ref> name
     ; A free reference to a variable in a library. If the library is 'main,
     ; then it is a top-level global variable.
-    (define-record-type <library-ref>
+    (define-match-record-type <library-ref>
       (make-library-ref name library)
       library-ref?
+      %library-ref
       (name library-ref-name)
       (library library-ref-library))
 
 
     ; <lexical-set> name gensym expression
     ; Sets a lexically-bound variable.
-    (define-record-type <lexical-set>
+    (define-match-record-type <lexical-set>
       (make-lexical-set ref expression)
       lexical-set?
+      %lexical-set
       (ref lexical-set-ref)
       (expression lexical-set-expression))
 
 
     ; <library-define> name expression
     ; Defines a new variable in the current library.
-    (define-record-type <library-define>
+    (define-match-record-type <library-define>
       (make-library-define ref expression)
       library-define?
+      %library-define
       (ref library-define-ref)
       (expression library-define-expression))
 
@@ -110,18 +127,20 @@
     ; <define-syntax> name transformer
     ; Defines a new macro in the current environment. name is the name of the
     ; macro. transformer is a macro transformer.
-    (define-record-type <define-syntax>
+    (define-match-record-type <define-syntax>
       (make-define-syntax name transformer)
       define-syntax?
+      %define-syntax
       (name define-syntax-name)
       (transformer define-syntax-transformer))
 
 
     ; <if> test consequent alternate
     ; A conditional.
-    (define-record-type <if>
+    (define-match-record-type <if>
       (make-if test consequent alternate)
       if?
+      %if
       (test if-test)
       (consequent if-consequent)
       (alternate if-alternate))
@@ -131,18 +150,20 @@
     ; A procedure call. The procedure and arguments are evaluated in an
     ; unspecified order, and the resulting procedure is passed the
     ; resulting arguments.
-    (define-record-type <call>
+    (define-match-record-type <call>
       (make-call procedure arguments)
       call?
+      %call
       (procedure call-procedure)
       (arguments call-arguments))
 
 
     ; <sequence> head tail
     ; Evaluate head, ignoring any result. Then tail is evaluated.
-    (define-record-type <sequence>
+    (define-match-record-type <sequence>
       (make-sequence head tail)
       sequence?
+      %sequence
       (head sequence-head)
       (tail sequence-tail))
 
@@ -150,9 +171,10 @@
     ; <lambda> body
     ; A closure. Arguments is a list of lexical-refs.
     ; Rest is a lexical ref or #f if the lambda doesn't take a rest parameter.
-    (define-record-type <lambda>
+    (define-match-record-type <lambda>
       (make-lambda arguments rest body)
       lambda?
+      %lambda
       (arguments lambda-arguments)
       (rest lambda-rest)
       (body lambda-body))
@@ -163,9 +185,10 @@
     ; names are the original binding names, gensyms are gensyms corresponding
     ; to the names, and values are IR1 expressions for the values. expression
     ; is a single IR1 expression.
-    (define-record-type <letrec>
+    (define-match-record-type <letrec>
       (make-letrec in-order? names gensyms values expression)
       letrec?
+      %letrec
       (in-order? letrec-in-order?)
       (names letrec-names)
       (gensyms letrec-gensyms)