resolve-primitives tweaks

* module/ice-9/boot-9.scm (make-struct/no-tail): Define a version of
  this function. Because during optimization we resolve make-struct to
  make-struct/no-tail, we need an implemented make-struct/no-tail if we
  are to be able to run scheme made from tree-il->scheme.

* module/language/tree-il/compile-glil.scm (*primcall-ops*): Remove
  variable-set case, as there is no "variable-set!" primitive.
  (flatten): Add a special hack for variable-set!. Ugly, I know.

* module/language/tree-il/primitives.scm (*effect-free-primitives*): Add
  make-struct/no-tail.
  (*effect+exception-free-primitives*): Remove make-struct, as it could
  raise an exception.
  (variable-set!): Remove expansion to variable-set.

module/ice-9/boot-9.scm

@@ -254,6 +254,14 @@ If there is no handler at all, Guile prints an error and then exits."
 
 
 
+;;; {Structs}
+;;;
+
+(define (make-struct/no-tail vtable . args)
+  (apply make-struct vtable 0 args))
+
+
+
 ;;; {and-map and or-map}
 ;;;
 ;;; (and-map fn lst) is like (and (fn (car lst)) (fn (cadr lst)) (fn...) ...)

module/language/tree-il/compile-glil.scm

@@ -114,7 +114,6 @@
    ((vector-set! . 3) . vector-set)
    ((variable-ref . 1) . variable-ref)
    ;; nb, *not* variable-set! -- the args are switched
-   ((variable-set . 2) . variable-set)
    ((variable-bound? . 1) . variable-bound?)
    ((struct? . 1) . struct?)
    ((struct-vtable . 1) . struct-vtable)
@@ -385,6 +384,18 @@
               args))
             (maybe-emit-return))))
 
+        ;; A hack for variable-set, the opcode for which takes its args
+        ;; reversed, relative to the variable-set! function
+        ((and (primitive-ref? proc)
+              (eq? (primitive-ref-name proc) 'variable-set!)
+              (= (length args) 2))
+         (comp-push (cadr args))
+         (comp-push (car args))
+         (emit-code src (make-glil-call 'variable-set 2))
+         (case context
+           ((tail push vals) (emit-code #f (make-glil-void))))
+         (maybe-emit-return))
+        
         ((and (primitive-ref? proc)
               (or (hash-ref *primcall-ops*
                             (cons (primitive-ref-name proc) (length args)))

module/language/tree-il/primitives.scm

@@ -60,7 +60,6 @@
     vector-ref vector-set!
     variable-ref variable-set!
     variable-bound?
-    ;; args of variable-set are switched; it needs special help
 
     fluid-ref fluid-set!
 
@@ -121,7 +120,7 @@
     caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
     cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
     vector-ref
-    struct? struct-vtable make-struct struct-ref
+    struct? struct-vtable make-struct make-struct/no-tail struct-ref
     bytevector-u8-ref bytevector-s8-ref
     bytevector-u16-ref bytevector-u16-native-ref
     bytevector-s16-ref bytevector-s16-native-ref
@@ -140,7 +139,7 @@
     not
     pair? null? list? acons cons cons*
     list vector
-    struct? make-struct))
+    struct?))
 
 (define *effect-free-primitive-table* (make-hash-table))
 (define *effect+exceptions-free-primitive-table* (make-hash-table))
@@ -334,10 +333,6 @@
 
 (define-primitive-expander values (x) x)
 
-;; swap args
-(define-primitive-expander variable-set! (var val)
-  (variable-set val var))
-
 (define-primitive-expander make-struct (vtable tail-size . args)
   (if (and (const? tail-size)
            (let ((n (const-exp tail-size)))