[patch] Better representation of ClassExps in syntax-utils

[patch] Better representation of ClassExps in syntax-utils

[Jamison Hope]

[-- Attachment #1: Type: text/plain, Size: 752 bytes --]

The attached patch adds an unrewrite-class function to syntaxutils.scm,
to handle the expansion of ClassExps.  It's by no means complete, but
a significant step up from treating them as LambdaExps (and throwing
an error in unrewrite-arglist).

Before:

#|kawa:1|# (require 'syntax-utils)
#|kawa:2|# (expand '(define-simple-class Foo (java.util.ArrayList) ((foo) allocation: 'static #!native)))
#<ERROR nyi>

After:

#|kawa:1|# (require 'syntax-utils)
#|kawa:2|# (expand '(define-simple-class Foo (java.util.ArrayList) ((foo) allocation: 'static #!native)))
(let ((Foo #!undefined))
 (set Foo
  (class (<java.util.ArrayList>) ((foo) allocation: (quote static) #!native))))


--
Jamison Hope
The PTR Group
www.theptrgroup.com



[-- Attachment #2: syntaxutils_unrewrite-class.patch --]
[-- Type: application/octet-stream, Size: 3902 bytes --]

Index: gnu/kawa/slib/ChangeLog
===================================================================
--- gnu/kawa/slib/ChangeLog	(revision 8432)
+++ gnu/kawa/slib/ChangeLog	(working copy)
@@ -1,3 +1,11 @@
+2015-05-01  Jamison Hope  <jrh@theptrgroup.com>
+
+	* syntaxutils.scm (unrewrite-class, unrewrite-method): New
+	functions.
+	(unrewrite): Use unrewrite-class to handle instances of ClassExp.
+	(unrewrite-quote): Treat #!abstract and #!native as
+	self-evaluating, leave #!void in QuoteExp so that it is printed.
+
 2015-05-01  Per Bothner  <per@bothner.com>
 
 	* srfi69.scm (hash): Use HashUtils#boundedHash.
Index: gnu/kawa/slib/syntaxutils.scm
===================================================================
--- gnu/kawa/slib/syntaxutils.scm	(revision 8432)
+++ gnu/kawa/slib/syntaxutils.scm	(working copy)
@@ -82,7 +82,7 @@
      (! rewrite translator exp)
      (C:restore-current saved-comp))))
 
-;; Given an Expresssion try to reconstruct the corresponding Sexp.
+;; Given an Expression try to reconstruct the corresponding Sexp.
 (define (unrewrite (exp ::gnu.expr.Expression))
   (typecase exp
     (<gnu.expr.LetExp> (unrewrite-let exp))
@@ -89,6 +89,7 @@
     (<gnu.expr.QuoteExp> (unrewrite-quote exp))
     (<gnu.expr.SetExp> 
      `(set ,(! get-symbol exp) ,(unrewrite (! get-new-value exp))))
+    (<gnu.expr.ClassExp> (unrewrite-class exp))
     (<gnu.expr.LambdaExp>
      `(lambda ,(unrewrite-arglist exp)
 	,(unrewrite (|@| body exp))))
@@ -128,6 +129,7 @@
 				 (if rest? 1 0)
 				 (|@| length (|@| keywords exp)))))
 	       (set! key (cons var key)))
+              ((! is-this-parameter decl))
 	      (#t 
 	       (error "nyi")))))
     `(,@(reverse required)
@@ -160,12 +162,46 @@
         (type-name (lambda (name) (string->symbol (format "<~a>" name)))))
     (typecase val
       ((or <number> <boolean> <character> <keyword> <string> 
-           (eql #!undefined) (eql #!eof))
+           (eql #!undefined) (eql #!eof) (eql #!abstract) (eql #!native))
        val)
       (<gnu.bytecode.Type> (type-name (! get-name val)))
       (<java.lang.Class> (type-name (! get-name val)))
+      ((eql #!void) exp)
       (#t `(quote ,val)))))
 
+(define (unrewrite-class (exp ::gnu.expr.ClassExp))
+  `(class ,(unrewrite* (|@| supers exp))
+          ,@(let loop ((decl ::gnu.expr.Declaration (! first-decl exp)))
+              (cond ((eq? decl #!null) '())
+                    ((eq? (! get-type decl)
+                          gnu.expr.Compilation:typeProcedure)
+                     (loop (! next-decl decl)))
+                    (else
+                     (cons (list (! get-symbol decl) ':: (! get-type decl))
+                           (loop (! next-decl decl))))))
+          ,@(let loop ((child ::gnu.expr.LambdaExp (|@| firstChild exp)))
+              (if (eq? child #!null) '()
+                  (cons
+                   (unrewrite-method child)
+                   (loop (|@| nextSibling child)))))))
+
+(define (unrewrite-method (exp ::gnu.expr.LambdaExp))
+  (let* ((decl ::gnu.expr.Declaration (|@| nameDecl exp))
+         (name (! get-name exp))
+         (static? (or (and decl (! get-flag decl
+                                   gnu.expr.Declaration:STATIC_SPECIFIED))
+                      (eq? name "$clinit$")))
+         (private? (and decl (! get-flag decl
+                                gnu.expr.Declaration:PRIVATE_ACCESS)))
+         (protected? (and decl (! get-flag decl
+                                  gnu.expr.Declaration:PROTECTED_ACCESS))))
+    `((,name
+       ,@(unrewrite-arglist exp))
+      ,@(if static? '(allocation: 'static) '())
+      ,@(if (or private? protected?)
+            `(access: ,(if private? ''private ''protected)) '())
+      ,(unrewrite (|@| body exp)))))
+
 (define (unrewrite-apply (exp ::gnu.expr.ApplyExp))
   (let* ((fun (! get-function exp))
          (args (unrewrite* (! get-args exp)))

Re: [patch] Better representation of ClassExps in syntax-utils

[Per Bothner]

On 05/01/2015 12:26 PM, Jamison Hope wrote:
> The attached patch adds an unrewrite-class function to syntaxutils.scm,
> to handle the expansion of ClassExps.

Thanks - I checked this in.
-- 
	--Per Bothner
per@bothner.com   http://per.bothner.com/