Further code cleanup for cise type handling

lib/gauche/cgen/cise.scm

@@ -592,18 +592,8 @@
     (ensure-toplevel-ctx form env)
     (ensure-stmt-or-toplevel-ctx form env))
 
-  (let* ([canon (car (canonicalize-vardecl (list (cdr form))))]
-         [var (car canon)]
-         [spec (cdr canon)])
-    (receive (type init-and-quals)
-        (match spec
-          [()         (values 'ScmObj '())]
-          [('::)      (errorf "invalid variable decl in ~s: (~s ~s)"
-                              (car form) var spec)]
-          [(':: type) (values type '())]
-          [(':: type . init-and-quals) (values type init-and-quals)]
-          [else (values 'ScmObj spec)])
-      (check-quals var type '() init-and-quals))))
+  (receive [var type init-and-quals] (canonicalize-typed-var-1 form)
+    (check-quals var type '() init-and-quals)))
 
 ;;------------------------------------------------------------
 ;; CPS transformation
@@ -714,22 +704,17 @@
   (ensure-stmt-ctx form env)
   (match form
     [(_ vars . body)
-     (match (canonicalize-vardecl vars)
-       [((var . spec) ...)
+     (match (cgen-canonical-typed-var-list vars 'ScmObj)
+       [((var ':: type . maybe-init) ...)
         (let1 eenv (expr-env env)
           `(begin
-             ,@(map (^[var spec]
-                      (receive (type has-init? init)
-                          (match spec
-                            [()         (values 'ScmObj #f #f)]
-                            [('::)      (errorf "invalid variable decl in let* form: (~s ~s)" var spec)]
-                            [(init)     (values 'ScmObj #t init)]
-                            [(':: type) (values type #f #f)]
-                            [(':: type init) (values type #t init)])
-                        `(,(cise-render-typed-var type var env)
-                          ,@(cond-list [has-init? `("=",(render-rec init eenv))])
-                          ";")))
-                    var spec)
+             ,@(map (^[var type maybe-init]
+                      `(,(cise-render-typed-var type var env)
+                        ,@(cond-list
+                           [(pair? maybe-init)
+                            `("=",(render-rec (car maybe-init) eenv))])
+                        ";"))
+                    var type maybe-init)
              ,@(map (cut render-rec <> env) body)))]
        [_ (error "invalid variable decls in let* form:" form)])]
     ))
@@ -1376,10 +1361,7 @@
     [('.union tag . rest)
      (render-struct-or-union "union" tag #f rest var env)]
     [('.function (args ...) rettype . rest)
-     (let1 rt (let1 vv (canonicalize-vardecl `(_ ,rettype))
-                 (unless (null? (cdr vv))
-                  (errorf "Invalid return type in ~s" typespec))
-                (caddar vv))
+     (let1 rt (canonicalize-return-type rettype typespec)
        `(,(cise-render-typed-var rt "" env)
          "("
          ,(if (null? rest)
@@ -1389,7 +1371,7 @@
          "("
          ,@($ intersperse ", "
               $ map (^.[(arg ':: type) (cise-render-typed-var type arg env)])
-              $ canonicalize-vardecl args)
+              $ cgen-canonical-typed-var-list args 'ScmObj)
          ")"))]
     [(x)
      `(,(x->string x) " " ,(cise-render-identifier var))]
@@ -1416,12 +1398,6 @@
 (define (cise-render-identifier sym)
   (cgen-safe-name-friendly (x->string sym)))
 
-;; canonicalize-vardecl
-;; (foo bar::int baz::(const char*) (boom::int 0))
-;;  => ((foo :: ScmObj) (bar :: int) (baz :: (const char*)) (boom :: int 0))
-(define (canonicalize-vardecl vardecls)
-  (cgen-canonical-typed-var-list vardecls 'ScmObj))
-
 ;; For field declaration, you may need to include a C macro that doesn't
 ;; have type decl (e.g. SCM_HEADER).  If you just write SCM_HEADER,
 ;; it generates 'ScmObj SCM_HEADER;' which you don't want.
@@ -1433,6 +1409,20 @@
         [((? symbol?) ':: _ . _) #f]
         [bad (error "Invalid field declaration: " bad)]))))
 
+;; Parse and get canonical form of return type.  Basically it's a
+;; typed var with missing variable, so we add a dummy var and parse it.
+(define (canonicalize-return-type rettype typespec)
+  (match (cgen-canonical-typed-var-list `(_ ,rettype) 'ScmObj)
+    [((_ ':: rt)) rt]
+    [_ (errorf "Invalid return type in ~s" typespec)]))
+
+;; Deal with define-cvar/declare-cvar/define-ctype form.
+;; Returns three values: variable, type, and a list of init value / qualifies
+(define (canonicalize-typed-var-1 form)
+  (match (cgen-canonical-typed-var-list (list (cdr form)) 'ScmObj)
+    [((var ':: type . init-and-quals)) (values var type init-and-quals)]
+    [z (error "Invalid variable decl in " z form)]))
+
 ;;=============================================================
 ;; Sealing the default environment
 ;;   This must come at the bottom of the module.

lib/gauche/cgen/type.scm

@@ -386,7 +386,7 @@
 ;;
 ;; Each typed variable becomes this form:
 ;;
-;;   (varname :: type [init-val]])
+;;   (varname :: type [init-val] [qual ...])
 ;;
 ;; If type is omitted, <top> is assumed for stubs, while ScmObj is
 ;; assumed for CiSEs, so the default-type is provided by the caller.
@@ -439,9 +439,15 @@
       [([? symbol? var] . rest)
        (scan rest `((,var :: ,default-type) ,@r))]
       [(([? symbol? v] [? symbol? t] . args) . rest)
-       (scan rest `(,(expand-type v (expand-type t args)) ,@r))]
+       (let1 sub (expand-type v (expand-type t args))
+         (match sub
+           [(_ ':: . _) (scan rest `(,sub ,@r))]
+           [(var . opt) (scan rest `((,var :: ,default-type ,@opt) ,@r))]))]
       [(([? symbol? vt] . args) . rest)
-       (scan rest `(,(expand-type vt args) ,@r))]
+       (let1 sub (expand-type vt args)
+         (match sub
+           [(_ ':: . _) (scan rest `(,sub ,@r))]
+           [(var . opt) (scan rest `((,var :: ,default-type ,@opt) ,@r))]))]
       [(xx . rest) (reverse r (cons xx rest))]))
 
   (scan (fold-right expand-type '() typed-var-list) '()))

test/cgen.scm

@@ -56,18 +56,13 @@ some_trick();
 (use gauche.cgen.type)
 (test-module 'gauche.cgen.type)
 
-;;====================================================================
-(test-section "gauche.cgen.cise")
-(use gauche.cgen.cise)
-(test-module 'gauche.cgen.cise)
-
 (let ()
   (define (t in out)
-    (test* (format "canonicalize-vardecl ~s" in) out
-           ((with-module gauche.cgen.cise canonicalize-vardecl) in)))
+    (test* (format "cgen-canonical-typed-var-list ~s" in) out
+           (cgen-canonical-typed-var-list in 'default)))
 
-  (t '(a b c) '((a :: ScmObj) (b :: ScmObj) (c :: ScmObj)))
-  (t '((a) (b) (c)) '((a) (b) (c)))
+  (t '(a b c) '((a :: default) (b :: default) (c :: default)))
+  (t '((a) (b) (c)) '((a :: default) (b :: default) (c :: default)))
   (t '(a::x b::y (c::z)) '((a :: x) (b :: y) (c :: z)))
   (t '(a :: x b :: y (c :: z)) '((a :: x) (b :: y) (c :: z)))
   (t '(a:: x b ::y (c:: z)) '((a :: x) (b :: y) (c :: z)))
@@ -76,9 +71,15 @@ some_trick();
   (t '((a::x init) (b::(x) init) (c :: x init))
      '((a :: x init) (b :: (x) init) (c :: x init)))
   (t '((a init) (b init) (c init))
-     '((a init) (b init) (c init)))
+     '((a :: default init) (b :: default init) (c :: default init)))
   )
 
+
+;;====================================================================
+(test-section "gauche.cgen.cise")
+(use gauche.cgen.cise)
+(test-module 'gauche.cgen.cise)
+
 ;; define-cfn
 (parameterize ([cise-emit-source-line #f])
   (define (c form exp)