added type checks

assemble-open-coded.rkt

@@ -209,7 +209,7 @@
 (: maybe-typecheck-operand (OperandDomain Natural String CompileTimeEnvironmentEntry -> String))
 (define (maybe-typecheck-operand domain-type position operand-string knowledge)
   (cond
-    [#t #;(redundant-check? domain-type knowledge)
+    [(redundant-check? domain-type knowledge)
      operand-string]
     [else
      (assemble-domain-check domain-type operand-string position)]))
@@ -217,9 +217,22 @@
 
 (: redundant-check? (OperandDomain CompileTimeEnvironmentEntry -> Boolean))
 (define (redundant-check? domain-type knowledge)
-  #f)
+  (cond [(Const? knowledge)
+         (case domain-type
+           [(number)
+            (number? (Const-const knowledge))]
+           [(string)
+            (string? (Const-const knowledge))]
+           [(box)
+            (box? (Const-const knowledge))]
+           [(list)
+            (list? (Const-const knowledge))]
+           [(pair)
+            (pair? (Const-const knowledge))])]
+        [else
+         #f]))
 
 
-         (: repeat (All (A) (A Natural -> (Listof A))))
+(: repeat (All (A) (A Natural -> (Listof A))))
 (define (repeat x n)
   (build-list n (lambda (i) x)))

compile.rkt

@@ -396,7 +396,9 @@
             [(StaticallyKnownLam? op-knowledge)
              (compile-statically-known-lam-application op-knowledge exp cenv extended-cenv target linkage)]
             [(Prefix? op-knowledge)
-             (error 'impossible)]))))
+             (error 'impossible)]
+            [(Const? op-knowledge)
+             (error 'application "Can't apply constant ~s as a function" (Const-const op-knowledge))]))))
 
 
 (: compile-general-application (App CompileTimeEnvironment CompileTimeEnvironment Target Linkage -> InstructionSequence))
@@ -754,6 +756,8 @@
               name]
              [else
               '?]))]
+    [(Constant? exp)
+     (make-Const (Constant-v exp))]
     [else
      '?]))
 

il-structs.rkt

@@ -325,6 +325,7 @@
      Prefix      ;; placeholder: necessary since the toplevel lives in the environment too
      StaticallyKnownLam ;; The value is a known lam
      ModuleVariable     ;; The value is a known module variable
+     Const
      ))
 
 (define-type CompileTimeEnvironment (Listof CompileTimeEnvironmentEntry))