Remove usages of environment-map

coalton-compiler.asd

@@ -63,7 +63,6 @@
                              (:file "type-errors")
                              (:file "unify")
                              (:file "fundeps")
-                             (:file "map")
                              (:file "environment")
                              (:file "lisp-type")
                              (:file "context-reduction")

coalton.asd

@@ -241,8 +241,7 @@
                (:file "runtime-tests")
                (:module "typechecker"
                 :serial t
-                :components ((:file "map-tests")
-                             (:file "lisp-type-tests")))
+                :components ((:file "lisp-type-tests")))
                (:file "environment-persist-tests")
                (:file "coalton-tests")
                (:file "slice-tests")

src/codegen/optimizer.lisp

@@ -638,7 +638,10 @@ NODE in the environment ENV."
   (declare (type node node)
            (type tc:environment env)
            (values node &optional))
-  (labels ((handle-static-superclass (node bound-variables)
+  (labels ((get-named-superclass (class name)
+             (cdr (assoc name (tc:ty-class-superclass-map class) :test #'equal)))
+
+           (handle-static-superclass (node bound-variables)
              (declare (type util:symbol-list bound-variables))
 
              (unless (or (node-variable-p (node-field-dict node))
@@ -659,7 +662,7 @@ NODE in the environment ENV."
                     (superclass-dict (tc:ty-class-superclass-dict class))
 
                     ;; Map the accessor to a named superclass
-                    (superclass-name (tc:get-value (tc:ty-class-superclass-map class) (node-field-name node)))
+                    (superclass-name (get-named-superclass class (node-field-name node)))
 
                     ;; Find the predicate of the accessed superclass
                     (superclass-pred (car (find superclass-name superclass-dict :key #'cdr)))

src/codegen/translate-instance.lisp

@@ -50,7 +50,7 @@
            (loop :for method :in (tc:ty-class-unqualified-methods class)
                  :for method-name := (tc:ty-class-method-name method)
                  :for binding := (gethash method-name (tc:toplevel-define-instance-methods instance))
-                 :for codegen-sym := (tc:get-value method-codegen-syms method-name)
+                 :for codegen-sym :in method-codegen-syms
 
                  :collect (cons codegen-sym (translate-toplevel binding env method-name))))
 

src/typechecker/define-class.lisp

@@ -221,20 +221,15 @@
              := (loop :for super :in (partial-class-superclasses partial)
                       :for i :from 0
                       :collect (cons super
-                                     (alexandria:format-symbol
-                                      *package*
-                                      (format nil "SUPER-~D" i))))
+                                     (alexandria:format-symbol *package* "SUPER-~D"
+                                                               i)))
 
            :for superclass-map
-             := (loop :with table := (tc:make-map :test 'eq)
-                      :for (pred . super-name) :in superclass-dict
-                      :for prefixed-name := (alexandria:format-symbol
-                                             *package*
-                                             "~A-~A"
-                                             codegen-sym
-                                             super-name)
-                      :do (setf (tc:get-value table prefixed-name) super-name)
-                      :finally (return table))
+             := (loop :for (pred . super-name) :in superclass-dict
+                      :for prefixed-name := (alexandria:format-symbol *package* "~A-~A"
+                                                                      codegen-sym
+                                                                      super-name)
+                      :collect (cons prefixed-name super-name))
 
            :for fundeps
              := (loop :for fundep :in (parser:toplevel-define-class-fundeps class)
@@ -248,15 +243,7 @@
                   :predicate pred
                   :superclasses (partial-class-superclasses partial)
                   :class-variables class-vars
-
-                  :class-variable-map (loop :with table := (tc:make-map :test 'eq)
-                                            :for var :in class-vars
-                                            :for i :from 0
-                                            :do (setf (tc:get-value table var) i)
-                                            :finally (return table))
-
                   :fundeps fundeps
-
                   :unqualified-methods (loop :for method-ty :in (partial-class-method-tys partial)
                                              :for method :in (parser:toplevel-define-class-methods class)
 

src/typechecker/define-instance.lisp

@@ -105,14 +105,11 @@
              (method-names (mapcar #'tc:ty-class-method-name
                                    (tc:ty-class-unqualified-methods class)))
 
-             (method-codegen-syms
-               (loop :with table := (tc:make-map :test 'eq)
-                     :for method-name :in method-names
-                     :do (setf (tc:get-value table method-name)
-                               (alexandria:format-symbol *package* "~A-~S"
-                                                         instance-codegen-sym
-                                                         method-name))
-                     :finally (return table)))
+             (method-codegen-syms (mapcar (lambda (method-name)
+                                            (alexandria:format-symbol *package* "~A-~S"
+                                                                      instance-codegen-sym
+                                                                      method-name))
+                                          method-names))
 
              (instance-entry
                (tc:make-ty-class-instance
@@ -147,7 +144,7 @@
                                    "instance overlaps with ~S" (tc:overlapping-instance-error-inst2 e)))))
 
         (loop :for method-name :in method-names
-              :for method-codegen-sym := (tc:get-value method-codegen-syms method-name) :do
+              :for method-codegen-sym :in method-codegen-syms :do
                 (setf env (tc:set-method-inline env method-name instance-codegen-sym method-codegen-sym)))
 
         (values instance-entry env)))))

src/typechecker/define.lisp

@@ -2391,9 +2391,9 @@ Returns (VALUES INFERRED-TYPE NODE SUBSTITUTIONS)")
 
                      (new-vars (set-difference closure-vars fundep-vars :test #'eq))
 
-                     (new-tys (util:project-map
+                     (new-tys (util:project-elements
                                new-vars
-                               (tc:get-table (tc:ty-class-class-variable-map class))
+                               (tc:ty-class-class-variables class)
                                (tc:ty-predicate-types pred))))
 
                 (loop :for var :in (set-difference

src/typechecker/environment.lisp

@@ -3,7 +3,6 @@
    #:cl
    #:coalton-impl/algorithm
    #:coalton-impl/typechecker/base
-   #:coalton-impl/typechecker/map
    #:coalton-impl/typechecker/type-errors
    #:coalton-impl/typechecker/types
    #:coalton-impl/typechecker/predicate
@@ -79,7 +78,6 @@
    #:ty-class-predicate                     ; ACCESSOR
    #:ty-class-superclasses                  ; ACCESSOR
    #:ty-class-class-variables               ; ACCESSOR
-   #:ty-class-class-variable-map            ; ACCESSOR
    #:ty-class-fundeps                       ; ACCESSOR
    #:ty-class-unqualified-methods           ; ACCESSOR
    #:ty-class-codegen-sym                   ; ACCESSOR
@@ -172,10 +170,6 @@
    #:initialize-fundep-environment          ; FUNCTION
    #:update-instance-fundeps                ; FUNCTION
    #:solve-fundeps                          ; FUNCTION
-   #:environment-map                        ; STRUCT
-   #:make-map                               ; FUNCTION
-   #:get-value                              ; FUNCTION
-   #:get-table                              ; FUNCTION
    ))
 
 ;;; Coalton environment management
@@ -618,19 +612,16 @@
   (predicate           (util:required 'predicate)           :type ty-predicate        :read-only t)
   (superclasses        (util:required 'superclasses)        :type ty-predicate-list   :read-only t)
   (class-variables     (util:required 'class-variables)     :type util:symbol-list    :read-only t)
-
-  ;; Hash table mapping variable symbols to their index in the predicate
-  (class-variable-map  (util:required 'class-variable-map)  :type environment-map     :read-only t)
   (fundeps             (util:required 'fundeps)             :type fundep-list         :read-only t)
 
   ;; Methods of the class containing the same tyvars in PREDICATE for
   ;; use in pretty printing
   (unqualified-methods (util:required 'unqualified-methods) :type ty-class-method-list :read-only t)
   (codegen-sym         (util:required 'codegen-sym)         :type symbol               :read-only t)
   (superclass-dict     (util:required 'superclass-dict)     :type list                 :read-only t)
-  (superclass-map      (util:required 'superclass-map)      :type environment-map      :read-only t)
+  (superclass-map      (util:required 'superclass-map)      :type list                 :read-only t)
   (docstring           (util:required 'docstring)           :type (or null string)     :read-only t)
-  (location            (util:required 'location)            :type source:location             :read-only t))
+  (location            (util:required 'location)            :type source:location      :read-only t))
 
 (defmethod source:location ((self ty-class))
   (ty-class-location self))
@@ -659,7 +650,6 @@
    :predicate (apply-substitution subst-list (ty-class-predicate class))
    :superclasses (apply-substitution subst-list (ty-class-superclasses class))
    :class-variables (ty-class-class-variables class)
-   :class-variable-map (ty-class-class-variable-map class)
    :fundeps (ty-class-fundeps class)
    :unqualified-methods (mapcar (lambda (method)
                                   (make-ty-class-method :name (ty-class-method-name method)
@@ -697,7 +687,7 @@
   (constraints         (util:required 'constraints)         :type ty-predicate-list :read-only t)
   (predicate           (util:required 'predicate)           :type ty-predicate      :read-only t)
   (codegen-sym         (util:required 'codegen-sym)         :type symbol            :read-only t)
-  (method-codegen-syms (util:required 'method-codegen-syms) :type environment-map   :read-only t)
+  (method-codegen-syms (util:required 'method-codegen-syms) :type util:symbol-list  :read-only t)
   (docstring           (util:required 'docstring)           :type (or null string)  :read-only t))
 
 (defmethod source:docstring ((self ty-class-instance))
@@ -1458,14 +1448,13 @@
        entry)
       #'make-fundep-environment))))
 
-
 (define-env-updater update-instance-fundeps (env pred)
   (declare (type environment env)
            (type ty-predicate pred))
 
   (let* ((class (lookup-class env (ty-predicate-class pred)))
          (fundep-env (lookup-fundep-environment env (ty-predicate-class pred)))
-         (class-variable-map (ty-class-class-variable-map class)))
+         (class-variables (ty-class-class-variables class)))
 
     (loop :for fundep :in (ty-class-fundeps class)
           :for i :from 0
@@ -1475,13 +1464,13 @@
           :for from-tys
             := (mapcar
                 (lambda (var)
-                  (nth (get-value class-variable-map var) (ty-predicate-types pred)))
+                  (nth (position var class-variables) (ty-predicate-types pred)))
                 (fundep-from fundep))
 
           :for to-tys
             := (mapcar
                 (lambda (var)
-                  (nth (get-value class-variable-map var) (ty-predicate-types pred)))
+                  (nth (position var class-variables) (ty-predicate-types pred)))
                 (fundep-to fundep))
 
           :do (block update-block
@@ -1646,7 +1635,7 @@
 
          (class (lookup-class env class-name))
 
-         (class-variable-map (ty-class-class-variable-map class))
+         (class-variables (ty-class-class-variables class))
 
          (fundep-env (lookup-fundep-environment env class-name)))
 
@@ -1656,28 +1645,28 @@
           :for state := (immutable-listmap-lookup fundep-env i :no-error t)
 
           :when state
-            :do (setf subs (generate-fundep-subs-for-pred% pred state class-variable-map fundep subs)))
+            :do (setf subs (generate-fundep-subs-for-pred% pred state class-variables fundep subs)))
 
     subs))
 
-(defun generate-fundep-subs-for-pred% (pred state class-variable-map fundep subs)
+(defun generate-fundep-subs-for-pred% (pred state class-variables fundep subs)
   (declare (type ty-predicate pred)
            (type fset:seq state)
-           (type environment-map class-variable-map)
+           (type util:symbol-list class-variables)
            (type fundep fundep)
            (type substitution-list subs)
            (values substitution-list &optional))
 
   (let* ((from-tys
            (mapcar
             (lambda (var)
-              (nth (get-value class-variable-map var) (ty-predicate-types pred)))
+              (nth (position var class-variables) (ty-predicate-types pred)))
             (fundep-from fundep)))
 
          (to-tys
            (mapcar
             (lambda (var)
-              (nth (get-value class-variable-map var) (ty-predicate-types pred)))
+              (nth (position var class-variables) (ty-predicate-types pred)))
             (fundep-to fundep))))
 
     (fset:do-seq (entry state)

src/typechecker/parse-type.lisp

@@ -199,12 +199,12 @@
                       :for pred-tys := (tc:ty-predicate-types pred)
                       :for class-name := (tc:ty-predicate-class pred)
                       :for class := (tc:lookup-class env class-name)
-                      :for map := (tc:get-table (tc:ty-class-class-variable-map class))
+                      :for vars := (tc:ty-class-class-variables class)
                       :when (tc:ty-class-fundeps class) :do
                         (loop :for fundep :in (tc:ty-class-fundeps class)
-                              :for from-vars := (util:project-map (tc:fundep-from fundep) map pred-tys)
+                              :for from-vars := (util:project-elements (tc:fundep-from fundep) vars pred-tys)
                               :do (when (subsetp from-vars unambiguous-vars :test #'equalp)
-                                    (let ((to-vars (util:project-map (tc:fundep-to fundep) map pred-tys)))
+                                    (let ((to-vars (util:project-elements (tc:fundep-to fundep) vars pred-tys)))
                                       (setf unambiguous-vars
                                             (remove-duplicates (append to-vars unambiguous-vars) :test #'equalp))))))
 

src/typechecker/stage-1.lisp

@@ -1,7 +1,6 @@
 (uiop:define-package #:coalton-impl/typechecker/stage-1
   (:mix-reexport
    #:coalton-impl/typechecker/base
-   #:coalton-impl/typechecker/map
    #:coalton-impl/typechecker/kinds
    #:coalton-impl/typechecker/types
    #:coalton-impl/typechecker/substitutions