operators.scm

   1 ;;; operators
   2
   3 (define operators '())
   4
   5 (define (define-op constructor six-id id type-rule constant-fold code-gen)
   6   (set! operators
   7         (cons (constructor six-id id type-rule constant-fold code-gen)
   8               operators)))
   9 (define (define-op1 six-id id type-rule constant-fold code-gen)
  10   (define-op make-op1 six-id id type-rule constant-fold code-gen))
  11 (define (define-op2 six-id id type-rule constant-fold code-gen)
  12   (define-op make-op2 six-id id type-rule constant-fold code-gen))
  13 (define (define-op3 six-id id type-rule constant-fold code-gen)
  14   (define-op make-op3 six-id id type-rule constant-fold code-gen))
  15
  16 ;; no need for type checks, every type sixpic supports can be casted to / from
  17 ;; ints (except void, but this is a non-issue) and promotion (by padding) and
  18 ;; truncation is done at the cfg level
  19 (define (type-rule-int-op1 ast)
  20   (expr-type (subast1 ast)))
  21
  22 (define (largest t1 t2)
  23   (if (> (type->bytes t1) (type->bytes t2))
  24       t1
  25       t2))
  26
  27 (define (type-rule-int-op2 ast)
  28   ;; used for any binary operation involving two integers where the result is
  29   ;; of the size of the biggest operand (subtraction, bitwise operations, ...)
  30   (let ((t1 (expr-type (subast1 ast)))
  31         (t2 (expr-type (subast2 ast))))
  32     (largest t1 t2)))
  33
  34 (define (type-rule-assign ast)
  35   (let ((t1 (expr-type (subast1 ast))))
  36     ;; the type of the rhs is irrelevant, since it will be promoted
  37     ;; or truncated at the cfg level
  38     ;; TODO not sure it's true anymore
  39     t1))
  40
  41 ;; the standard says it should be int
  42 (define (type-rule-int-comp-op2 ast)
  43   'int)
  44
  45 (define (type-rule-bool-op2 ast)
  46   'int)
  47
  48 (define (constant-fold-op2 op)
  49   (lambda (ast)
  50     (let ((x (subast1   ast))
  51           (y (subast2   ast)))
  52       (if (and (literal? x) (literal? y))
  53           (new-literal (expr-type ast) (op (literal-val x) (literal-val y)))
  54           ast))))
  55
  56 (define-op1 'six.!x '!x
  57   type-rule-int-op1
  58   (lambda (ast)
  59     ast) ;; TODO also call this when testing expressions
  60   (lambda (ast)
  61     ...))
  62
  63
  64 (define-op1 'six.++x '++x
  65   type-rule-int-op1
  66   (lambda (ast)
  67     ast) ;; TODO
  68   (lambda (ast)
  69     ...))
  70
  71 (define-op1 'six.x++ 'x++
  72   type-rule-int-op1
  73   (lambda (ast)
  74     ast) ;; TODO
  75   (lambda (ast)
  76     ...))
  77
  78 (define-op1 'six.--x '--x
  79   type-rule-int-op1
  80   (lambda (ast)
  81     ast) ;; TODO
  82   (lambda (ast)
  83     ...))
  84
  85 (define-op1 'six.x-- 'x--
  86   type-rule-int-op1
  87   (lambda (ast)
  88     ast) ;; TODO
  89   (lambda (ast)
  90     ...))
  91
  92 (define-op1 'six.~x '~x
  93   type-rule-int-op1
  94   (lambda (ast)
  95     ast) ;; TODO
  96   (lambda (ast)
  97     ...))
  98
  99 (define-op2 'six.x%y 'x%y
 100   type-rule-int-op2
 101   (constant-fold-op2 modulo)
 102   (lambda (ast)
 103     ...))
 104
 105 (define-op2 'six.x*y 'x*y
 106   type-rule-int-op2
 107   (constant-fold-op2 *)
 108   (lambda (ast)
 109     ...))
 110
 111 (define-op1 'six.*x '*x
 112   (lambda (ast)
 113     'byte) ; we only have byte arrays
 114   (lambda (ast)
 115     ast)
 116   (lambda (ast)
 117     ...))
 118
 119 (define-op2 'six.index 'index
 120   (lambda (ast)
 121     'byte) ; we only have byte arrays
 122   (lambda (ast)
 123     ast)
 124   (lambda (asr)
 125     ...))
 126
 127 (define-op2 'six.x/y 'x/y
 128   type-rule-int-op2
 129   (constant-fold-op2 /)
 130   (lambda (ast)
 131     ...))
 132
 133 (define-op2 'six.x+y 'x+y
 134   type-rule-int-op2
 135   (constant-fold-op2 +)
 136   (lambda (ast)
 137     ...))
 138
 139 (define-op1 'six.+x '+x
 140   type-rule-int-op1
 141   (lambda (ast)
 142     (subast1 ast))
 143   (lambda (ast)
 144     ...))
 145
 146 (define-op2 'six.x-y 'x-y
 147   type-rule-int-op2
 148   (constant-fold-op2 -)
 149   (lambda (ast)
 150     ...))
 151
 152 (define-op1 'six.-x '-x
 153   type-rule-int-op1
 154   (lambda (ast)
 155     ast) ;; TODO
 156   (lambda (ast)
 157     ...))
 158
 159 ;; TODO check with the C standard for the next 2
 160 (define-op2 'six.x<<y 'x<<y
 161   type-rule-int-op2
 162   (constant-fold-op2 arithmetic-shift)
 163   (lambda (ast)
 164     ...))
 165
 166 (define-op2 'six.x>>y 'x>>y
 167   type-rule-int-op2
 168   (constant-fold-op2 (lambda (x y) (arithmetic-shift x (- y))))
 169   (lambda (ast)
 170     ...))
 171
 172 (define-op2 'six.x<y 'x<y
 173   type-rule-int-comp-op2
 174   (constant-fold-op2 (lambda (x y) (if (< x y) 1 0)))
 175   (lambda (ast)
 176     ...))
 177
 178 (define-op2 'six.x<=y 'x<=y
 179   type-rule-int-comp-op2
 180   (constant-fold-op2 (lambda (x y) (if (<= x y) 1 0)))
 181   (lambda (ast)
 182     ...))
 183
 184 (define-op2 'six.x>y 'x>y
 185   type-rule-int-comp-op2
 186   (constant-fold-op2 (lambda (x y) (if (> x y) 1 0)))
 187   (lambda (ast)
 188     ...))
 189
 190 (define-op2 'six.x>=y 'x>=y
 191   type-rule-int-comp-op2
 192   (constant-fold-op2 (lambda (x y) (if (>= x y) 1 0)))
 193   (lambda (ast)
 194     ...))
 195
 196 (define-op2 'six.x!=y 'x!=y
 197   type-rule-int-comp-op2
 198   (constant-fold-op2 (lambda (x y) (if (not (= x y)) 1 0)))
 199   (lambda (ast)
 200     ...))
 201
 202 (define-op2 'six.x==y 'x==y
 203   type-rule-int-comp-op2
 204   (constant-fold-op2 (lambda (x y) (if (= x y) 1 0)))
 205   (lambda (ast)
 206     ...))
 207
 208 (define-op2 'six.x&y 'x&y
 209   type-rule-int-op2
 210   (constant-fold-op2 bitwise-and)
 211   (lambda (ast)
 212     ...))
 213
 214 (define-op1 'six.&x '&x
 215   (lambda (ast)
 216     ...)
 217   (lambda (ast)
 218     ast) ;; TODO
 219   (lambda (ast)
 220     ...))
 221
 222 (define-op2 'six.x^y 'x^y
 223   type-rule-int-op2
 224   (constant-fold-op2 bitwise-xor)
 225   (lambda (ast)
 226     ...))
 227
 228 (define-op2 '|six.x\|y| '|x\|y|
 229   type-rule-int-op2
 230   (constant-fold-op2 bitwise-ior)
 231   (lambda (ast)
 232     ...))
 233
 234 (define-op2 'six.x&&y 'x&&y
 235   type-rule-bool-op2
 236   (constant-fold-op2 (lambda (x y) (if (and (not (= x 0)) (not (= y 0))) 1 0)))
 237   (lambda (ast)
 238     ...))
 239
 240 (define-op2 '|six.x\|\|y| '|x\|\|y|
 241   type-rule-bool-op2
 242   (constant-fold-op2 (lambda (x y) (if (or (not (= x 0)) (not (= y 0))) 1 0)))
 243   (lambda (ast)
 244     ...))
 245
 246 (define-op3 'six.x?y:z 'x?y:z
 247   (lambda (ast)
 248     ;; largest of the 2 branches
 249     (let ((t1 (expr-type (subast2 ast)))
 250           (t2 (expr-type (subast3 ast))))
 251     (largest t1 t2)))
 252   (lambda (ast)
 253     ast) ;; TODO
 254   (lambda (ast)
 255     ...))
 256
 257 (define-op2 'six.x:y 'x:y
 258   (lambda (ast)
 259     ...)
 260   (lambda (ast)
 261     ast)
 262   (lambda (ast)
 263     ...))
 264
 265 (define-op2 'six.x%=y 'x%=y
 266   type-rule-assign
 267   (lambda (ast)
 268     ast)
 269   (lambda (ast)
 270     ...))
 271
 272 (define-op2 'six.x&=y 'x&=y
 273   type-rule-assign
 274   (lambda (ast)
 275     ast)
 276   (lambda (ast)
 277     ...))
 278
 279 (define-op2 'six.x*=y 'x*=y
 280   type-rule-assign
 281   (lambda (ast)
 282     ast)
 283   (lambda (ast)
 284     ...))
 285
 286 (define-op2 'six.x+=y 'x+=y
 287   type-rule-assign
 288   (lambda (ast)
 289     ast)
 290   (lambda (ast)
 291     ...))
 292
 293 (define-op2 'six.x-=y 'x-=y
 294   type-rule-assign
 295   (lambda (ast)
 296     ast)
 297   (lambda (ast)
 298     ...))
 299
 300 (define-op2 'six.x/=y 'x/=y
 301   type-rule-assign
 302   (lambda (ast)
 303     ast)
 304   (lambda (ast)
 305     ...))
 306
 307 (define-op2 'six.x<<=y 'x<<=y
 308   type-rule-assign
 309   (lambda (ast)
 310     ast)
 311   (lambda (ast)
 312     ...))
 313
 314 (define-op2 'six.x=y 'x=y
 315   type-rule-assign
 316   (lambda (ast)
 317     ast)
 318   (lambda (ast)
 319     ...))
 320
 321 (define-op2 'six.x>>=y 'x>>=y
 322   type-rule-assign
 323   (lambda (ast)
 324     ast)
 325   (lambda (ast)
 326     ...))
 327
 328 (define-op2 'six.x^=y 'x^=y
 329   type-rule-assign
 330   (lambda (ast)
 331     ast)
 332   (lambda (ast)
 333     ...))
 334
 335 (define-op2 '|six.x\|=y| '|x\|=y|
 336   type-rule-assign
 337   (lambda (ast)
 338     ast)
 339   (lambda (ast)
 340     ...))
 341
 342 (define-op2 'six.x:=y 'x:=y
 343   (lambda (ast)
 344     ...)
 345   (lambda (ast)
 346     ...)
 347   (lambda (ast)
 348     ...))
 349
 350 (define-op2 '|six.x,y| '|x,y|
 351   (lambda (ast)
 352     ...)
 353   (lambda (ast)
 354     ...)
 355   (lambda (ast)
 356     ...))
 357
 358 (define-op2 'six.x:-y 'x:-y
 359   (lambda (ast)
 360     ...)
 361   (lambda (ast)
 362     ...)
 363   (lambda (ast)
 364     ...))
 365
 366 (define (operation? source)
 367   (and (pair? source)
 368        (let ((x (car source)))
 369          (let loop ((lst operators))
 370            (cond ((null? lst)
 371                   #f)
 372                  ((eq? (op-six-id (car lst)) x)
 373                   (car lst))
 374                  (else
 375                   (loop (cdr lst))))))))