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 ;; TODO really ignore the void issue ? assigning the "result" of a void function to an int variable should be an error
  20 (define (type-rule-int-op1 ast)
  21   (expr-type (subast1 ast)))
  22
  23 (define (largest t1 t2)
  24   (if (> (type->bytes t1) (type->bytes t2))
  25       t1
  26       t2))
  27
  28 (define (type-rule-int-op2 ast)
  29   ;; used for any binary operation involving two integers where the result is
  30   ;; of the size of the biggest operand (subtraction, bitwise operations, ...)
  31   (let ((t1 (expr-type (subast1 ast)))
  32         (t2 (expr-type (subast2 ast))))
  33     (largest t1 t2)))
  34
  35 (define (type-rule-assign ast)
  36   (let ((t1 (expr-type (subast1 ast))))
  37     ;; the type of the rhs is irrelevant, since it will be promoted
  38     ;; or truncated at the cfg level
  39     t1))
  40
  41 (define (type-rule-int-comp-op2 ast)
  42   'bool) ;; TODO why even bother ? anything can be casted to int to be used as argument here, old version is in garbage (and in version control) if needed
  43
  44 (define (type-rule-bool-op2 ast)
  45   'bool) ;; TODO same here
  46
  47 (define-op1 'six.!x '!x
  48   type-rule-int-op1
  49   (lambda (ast) ;; TODO implement these ?
  50     ast)
  51   (lambda (ast)
  52     ...))
  53
  54
  55 (define-op1 'six.++x '++x
  56   type-rule-int-op1
  57   (lambda (ast)
  58     ast)
  59   (lambda (ast)
  60     ...))
  61
  62 (define-op1 'six.x++ 'x++
  63   type-rule-int-op1
  64   (lambda (ast)
  65     ast)
  66   (lambda (ast)
  67     ...))
  68
  69 (define-op1 'six.--x '--x
  70   type-rule-int-op1
  71   (lambda (ast)
  72     ast)
  73   (lambda (ast)
  74     ...))
  75
  76 (define-op1 'six.x-- 'x--
  77   type-rule-int-op1
  78   (lambda (ast)
  79     ast)
  80   (lambda (ast)
  81     ...))
  82
  83 (define-op1 'six.~x '~x
  84   type-rule-int-op1
  85   (lambda (ast)
  86     ast)
  87   (lambda (ast)
  88     ...))
  89
  90 (define-op2 'six.x%y 'x%y
  91   (lambda (ast)
  92     ;; if we know the second operand, we can have an upper bound on the size
  93     ;; of the result
  94     (if (literal? (subast1 ast))
  95         ;; the number of bits needed by the result is lg(y)
  96         (bytes->type (ceiling (/ (log (literal-val (subast1 ast))) (log 2) 8)))
  97         ;; fall back to the general case
  98         (type-rule-int-op2 ast))) ;; TODO is this optimization worth it, or does it break the samentics of C ?
  99   (lambda (ast)
 100     ast)
 101   (lambda (ast)
 102     ...))
 103
 104 (define-op2 'six.x*y 'x*y
 105   type-rule-int-op2
 106   (lambda (ast)
 107     ast)
 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   (lambda (ast)
 129     ;; if we know the second operand, we can have an upper bound on the size
 130     ;; of the result
 131     (if (literal? (subast1 ast))
 132         ;; for every byte over 1 in the length of y, we can remove a byte from
 133         ;; the result
 134         ;; ex : the smallest value which needs 2 bytes to encode is 256, and
 135         ;; dividing by 256 is equivalent to truncating the 8 lowest bits, and
 136         ;; so on
 137         (let ((l1 (type->bytes (expr-type (subast1 ast))))
 138               (l2 (ceiling (/ (log y) (log 2) 8))))
 139           (bytes->type (- (max l1 l2) (- l2 1))))
 140         ;; fall back to the general case
 141         (type-rule-int-op2 ast))) ;; TODO as for modulo, is this optimisation worth it ? if so, & could have a similar or, by being the size of the smaller operand
 142   (lambda (ast)
 143     ast)
 144   (lambda (ast)
 145     ...))
 146
 147 (define-op2 'six.x+y 'x+y
 148   type-rule-int-op2
 149   (lambda (ast)
 150     ast)
 151   (lambda (ast)
 152     ...))
 153
 154 (define-op1 'six.+x '+x
 155   type-rule-int-op1
 156   (lambda (ast)
 157     (subast1 ast))
 158   (lambda (ast)
 159     ...))
 160
 161 (define-op2 'six.x-y 'x-y
 162   type-rule-int-op2
 163   (lambda (ast)
 164     ast)
 165   (lambda (ast)
 166     ...))
 167
 168 (define-op1 'six.-x '-x
 169   type-rule-int-op1
 170   (lambda (ast)
 171     ast)
 172   (lambda (ast)
 173     ...))
 174
 175 (define-op2 'six.x<<y 'x<<y ;; TODO for the general case, would give scary results (a single byte for y can still mean a shift by 255)
 176   (lambda (ast)
 177     (if (not (literal? (subast2 ast)))
 178         (error "only shifting by literals is supported"))
 179     (let ((l1 (type->bytes (expr-type (subast1 ast))))
 180           (v2 (literal-val (subast2 ast))))
 181       ;; we might have to add some bytes to the result
 182       (bytes->type (+ l1 (ceiling (/ v2 8))))))
 183   (lambda (ast)
 184     ast)
 185   (lambda (ast)
 186     ...))
 187
 188 (define-op2 'six.x>>y 'x>>y
 189   (lambda (ast)
 190     (if (not (literal? (subast2 ast)))
 191         (error "only shifting by literals is supported"))
 192     (let ((l1 (type->bytes (expr-type (subast1 ast))))
 193           (v2 (literal-val (subast2 ast))))
 194       ;; we might be able to shave some bytes off
 195       (bytes->type (- l1 (floor (/ v2 8))))))
 196   (lambda (ast)
 197     ast)
 198   (lambda (ast)
 199     ...))
 200
 201 (define-op2 'six.x<y 'x<y
 202   type-rule-int-comp-op2
 203   (lambda (ast)
 204     ast)
 205   (lambda (ast)
 206     ...))
 207
 208 (define-op2 'six.x<=y 'x<=y
 209   type-rule-int-comp-op2
 210   (lambda (ast)
 211     ast)
 212   (lambda (ast)
 213     ...))
 214
 215 (define-op2 'six.x>y 'x>y
 216   type-rule-int-comp-op2
 217   (lambda (ast)
 218     ast)
 219   (lambda (ast)
 220     ...))
 221
 222 (define-op2 'six.x>=y 'x>=y
 223   type-rule-int-comp-op2
 224   (lambda (ast)
 225     ast)
 226   (lambda (ast)
 227     ...))
 228
 229 (define-op2 'six.x!=y 'x!=y
 230   type-rule-int-comp-op2
 231   (lambda (ast)
 232     ast)
 233   (lambda (ast)
 234     ...))
 235
 236 (define-op2 'six.x==y 'x==y
 237   type-rule-int-comp-op2
 238   (lambda (ast)
 239     ast)
 240   (lambda (ast)
 241     ...))
 242
 243 (define-op2 'six.x&y 'x&y
 244   type-rule-int-op2
 245   (lambda (ast)
 246     ast)
 247   (lambda (ast)
 248     ...))
 249
 250 (define-op1 'six.&x '&x
 251   (lambda (ast)
 252     ...)
 253   (lambda (ast)
 254     ast)
 255   (lambda (ast)
 256     ...))
 257
 258 (define-op2 'six.x^y 'x^y
 259   type-rule-int-op2
 260   (lambda (ast)
 261     ast)
 262   (lambda (ast)
 263     ...))
 264
 265 (define-op2 '|six.x\|y| '|x\|y|
 266   type-rule-int-op2
 267   (lambda (ast)
 268     ast)
 269   (lambda (ast)
 270     ...))
 271
 272 (define-op2 'six.x&&y 'x&&y
 273   type-rule-bool-op2
 274   (lambda (ast)
 275     ast)
 276   (lambda (ast)
 277     ...))
 278
 279 (define-op2 '|six.x\|\|y| '|x\|\|y|
 280   type-rule-bool-op2
 281   (lambda (ast)
 282     ast)
 283   (lambda (ast)
 284     ...))
 285
 286 (define-op3 'six.x?y:z 'x?y:z
 287   (lambda (ast)
 288     ;; largest of the 2 branches
 289     (let ((t1 (expr-type (subast2 ast)))
 290           (t2 (expr-type (subast3 ast))))
 291     (largest t1 t2)))
 292   (lambda (ast)
 293     ast)
 294   (lambda (ast)
 295     ...))
 296
 297 (define-op2 'six.x:y 'x:y
 298   (lambda (ast)
 299     ...)
 300   (lambda (ast)
 301     ast)
 302   (lambda (ast)
 303     ...))
 304
 305 (define-op2 'six.x%=y 'x%=y ;; TODO these don't work
 306   type-rule-assign
 307   (lambda (ast)
 308     ast)
 309   (lambda (ast)
 310     ...))
 311
 312 (define-op2 'six.x&=y 'x&=y
 313   type-rule-assign
 314   (lambda (ast)
 315     ast)
 316   (lambda (ast)
 317     ...))
 318
 319 (define-op2 'six.x*=y 'x*=y
 320   type-rule-assign
 321   (lambda (ast)
 322     ast)
 323   (lambda (ast)
 324     ...))
 325
 326 (define-op2 'six.x+=y 'x+=y
 327   type-rule-assign
 328   (lambda (ast)
 329     ast)
 330   (lambda (ast)
 331     ...))
 332
 333 (define-op2 'six.x-=y 'x-=y
 334   type-rule-assign
 335   (lambda (ast)
 336     ast)
 337   (lambda (ast)
 338     ...))
 339
 340 (define-op2 'six.x/=y 'x/=y
 341   type-rule-assign
 342   (lambda (ast)
 343     ast)
 344   (lambda (ast)
 345     ...))
 346
 347 (define-op2 'six.x<<=y 'x<<=y
 348   type-rule-assign
 349   (lambda (ast)
 350     ast)
 351   (lambda (ast)
 352     ...))
 353
 354 (define-op2 'six.x=y 'x=y
 355   type-rule-assign
 356   (lambda (ast)
 357     ast)
 358   (lambda (ast)
 359     ...))
 360
 361 (define-op2 'six.x>>=y 'x>>=y
 362   type-rule-assign
 363   (lambda (ast)
 364     ast)
 365   (lambda (ast)
 366     ...))
 367
 368 (define-op2 'six.x^=y 'x^=y
 369   type-rule-assign
 370   (lambda (ast)
 371     ast)
 372   (lambda (ast)
 373     ...))
 374
 375 (define-op2 '|six.x\|=y| '|x\|=y|
 376   type-rule-assign
 377   (lambda (ast)
 378     ast)
 379   (lambda (ast)
 380     ...))
 381
 382 (define-op2 'six.x:=y 'x:=y
 383   (lambda (ast)
 384     ...)
 385   (lambda (ast)
 386     ...)
 387   (lambda (ast)
 388     ...))
 389
 390 (define-op2 '|six.x,y| '|x,y|
 391   (lambda (ast)
 392     ...)
 393   (lambda (ast)
 394     ...)
 395   (lambda (ast)
 396     ...))
 397
 398 (define-op2 'six.x:-y 'x:-y
 399   (lambda (ast)
 400     ...)
 401   (lambda (ast)
 402     ...)
 403   (lambda (ast)
 404     ...))
 405
 406 (define (operation? source)
 407   (and (pair? source)
 408        (let ((x (car source)))
 409          (let loop ((lst operators))
 410            (cond ((null? lst)
 411                   #f)
 412                  ((eq? (op-six-id (car lst)) x)
 413                   (car lst))
 414                  (else
 415                   (loop (cdr lst))))))))