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-op1 'six.!x '!x
  49   type-rule-int-op1
  50   (lambda (ast) ;; TODO implement these ?
  51     ast)
  52   (lambda (ast)
  53     ...))
  54
  55
  56 (define-op1 'six.++x '++x
  57   type-rule-int-op1
  58   (lambda (ast)
  59     ast)
  60   (lambda (ast)
  61     ...))
  62
  63 (define-op1 'six.x++ 'x++
  64   type-rule-int-op1
  65   (lambda (ast)
  66     ast)
  67   (lambda (ast)
  68     ...))
  69
  70 (define-op1 'six.--x '--x
  71   type-rule-int-op1
  72   (lambda (ast)
  73     ast)
  74   (lambda (ast)
  75     ...))
  76
  77 (define-op1 'six.x-- 'x--
  78   type-rule-int-op1
  79   (lambda (ast)
  80     ast)
  81   (lambda (ast)
  82     ...))
  83
  84 (define-op1 'six.~x '~x
  85   type-rule-int-op1
  86   (lambda (ast)
  87     ast)
  88   (lambda (ast)
  89     ...))
  90
  91 (define-op2 'six.x%y 'x%y
  92   type-rule-int-op2
  93   (lambda (ast)
  94     ast)
  95   (lambda (ast)
  96     ...))
  97
  98 (define-op2 'six.x*y 'x*y
  99   type-rule-int-op2
 100   (lambda (ast)
 101     ast)
 102   (lambda (ast)
 103     ...))
 104
 105 (define-op1 'six.*x '*x
 106   (lambda (ast)
 107     'byte) ; we only have byte arrays
 108   (lambda (ast)
 109     ast)
 110   (lambda (ast)
 111     ...))
 112
 113 (define-op2 'six.index 'index
 114   (lambda (ast)
 115     'byte) ; we only have byte arrays
 116   (lambda (ast)
 117     ast)
 118   (lambda (asr)
 119     ...))
 120
 121 (define-op2 'six.x/y 'x/y
 122   type-rule-int-op2
 123   (lambda (ast)
 124     ast)
 125   (lambda (ast)
 126     ...))
 127
 128 (define-op2 'six.x+y 'x+y
 129   type-rule-int-op2
 130   (lambda (ast)
 131     ast)
 132   (lambda (ast)
 133     ...))
 134
 135 (define-op1 'six.+x '+x
 136   type-rule-int-op1
 137   (lambda (ast)
 138     (subast1 ast))
 139   (lambda (ast)
 140     ...))
 141
 142 (define-op2 'six.x-y 'x-y
 143   type-rule-int-op2
 144   (lambda (ast)
 145     ast)
 146   (lambda (ast)
 147     ...))
 148
 149 (define-op1 'six.-x '-x
 150   type-rule-int-op1
 151   (lambda (ast)
 152     ast)
 153   (lambda (ast)
 154     ...))
 155
 156 ;; TODO check with the C standard for the next 2
 157 (define-op2 'six.x<<y 'x<<y
 158   type-rule-int-op2
 159   (lambda (ast)
 160     ast)
 161   (lambda (ast)
 162     ...))
 163
 164 (define-op2 'six.x>>y 'x>>y
 165   type-rule-int-op2
 166   (lambda (ast)
 167     ast)
 168   (lambda (ast)
 169     ...))
 170
 171 (define-op2 'six.x<y 'x<y
 172   type-rule-int-comp-op2
 173   (lambda (ast)
 174     ast)
 175   (lambda (ast)
 176     ...))
 177
 178 (define-op2 'six.x<=y 'x<=y
 179   type-rule-int-comp-op2
 180   (lambda (ast)
 181     ast)
 182   (lambda (ast)
 183     ...))
 184
 185 (define-op2 'six.x>y 'x>y
 186   type-rule-int-comp-op2
 187   (lambda (ast)
 188     ast)
 189   (lambda (ast)
 190     ...))
 191
 192 (define-op2 'six.x>=y 'x>=y
 193   type-rule-int-comp-op2
 194   (lambda (ast)
 195     ast)
 196   (lambda (ast)
 197     ...))
 198
 199 (define-op2 'six.x!=y 'x!=y
 200   type-rule-int-comp-op2
 201   (lambda (ast)
 202     ast)
 203   (lambda (ast)
 204     ...))
 205
 206 (define-op2 'six.x==y 'x==y
 207   type-rule-int-comp-op2
 208   (lambda (ast)
 209     ast)
 210   (lambda (ast)
 211     ...))
 212
 213 (define-op2 'six.x&y 'x&y
 214   type-rule-int-op2
 215   (lambda (ast)
 216     ast)
 217   (lambda (ast)
 218     ...))
 219
 220 (define-op1 'six.&x '&x
 221   (lambda (ast)
 222     ...)
 223   (lambda (ast)
 224     ast)
 225   (lambda (ast)
 226     ...))
 227
 228 (define-op2 'six.x^y 'x^y
 229   type-rule-int-op2
 230   (lambda (ast)
 231     ast)
 232   (lambda (ast)
 233     ...))
 234
 235 (define-op2 '|six.x\|y| '|x\|y|
 236   type-rule-int-op2
 237   (lambda (ast)
 238     ast)
 239   (lambda (ast)
 240     ...))
 241
 242 (define-op2 'six.x&&y 'x&&y
 243   type-rule-bool-op2
 244   (lambda (ast)
 245     ast)
 246   (lambda (ast)
 247     ...))
 248
 249 (define-op2 '|six.x\|\|y| '|x\|\|y|
 250   type-rule-bool-op2
 251   (lambda (ast)
 252     ast)
 253   (lambda (ast)
 254     ...))
 255
 256 (define-op3 'six.x?y:z 'x?y:z
 257   (lambda (ast)
 258     ;; largest of the 2 branches
 259     (let ((t1 (expr-type (subast2 ast)))
 260           (t2 (expr-type (subast3 ast))))
 261     (largest t1 t2)))
 262   (lambda (ast)
 263     ast)
 264   (lambda (ast)
 265     ...))
 266
 267 (define-op2 'six.x:y 'x:y
 268   (lambda (ast)
 269     ...)
 270   (lambda (ast)
 271     ast)
 272   (lambda (ast)
 273     ...))
 274
 275 (define-op2 'six.x%=y 'x%=y ;; TODO these don't work
 276   type-rule-assign
 277   (lambda (ast)
 278     ast)
 279   (lambda (ast)
 280     ...))
 281
 282 (define-op2 'six.x&=y 'x&=y
 283   type-rule-assign
 284   (lambda (ast)
 285     ast)
 286   (lambda (ast)
 287     ...))
 288
 289 (define-op2 'six.x*=y 'x*=y
 290   type-rule-assign
 291   (lambda (ast)
 292     ast)
 293   (lambda (ast)
 294     ...))
 295
 296 (define-op2 'six.x+=y 'x+=y
 297   type-rule-assign
 298   (lambda (ast)
 299     ast)
 300   (lambda (ast)
 301     ...))
 302
 303 (define-op2 'six.x-=y 'x-=y
 304   type-rule-assign
 305   (lambda (ast)
 306     ast)
 307   (lambda (ast)
 308     ...))
 309
 310 (define-op2 'six.x/=y 'x/=y
 311   type-rule-assign
 312   (lambda (ast)
 313     ast)
 314   (lambda (ast)
 315     ...))
 316
 317 (define-op2 'six.x<<=y 'x<<=y
 318   type-rule-assign
 319   (lambda (ast)
 320     ast)
 321   (lambda (ast)
 322     ...))
 323
 324 (define-op2 'six.x=y 'x=y
 325   type-rule-assign
 326   (lambda (ast)
 327     ast)
 328   (lambda (ast)
 329     ...))
 330
 331 (define-op2 'six.x>>=y 'x>>=y
 332   type-rule-assign
 333   (lambda (ast)
 334     ast)
 335   (lambda (ast)
 336     ...))
 337
 338 (define-op2 'six.x^=y 'x^=y
 339   type-rule-assign
 340   (lambda (ast)
 341     ast)
 342   (lambda (ast)
 343     ...))
 344
 345 (define-op2 '|six.x\|=y| '|x\|=y|
 346   type-rule-assign
 347   (lambda (ast)
 348     ast)
 349   (lambda (ast)
 350     ...))
 351
 352 (define-op2 'six.x:=y 'x:=y
 353   (lambda (ast)
 354     ...)
 355   (lambda (ast)
 356     ...)
 357   (lambda (ast)
 358     ...))
 359
 360 (define-op2 '|six.x,y| '|x,y|
 361   (lambda (ast)
 362     ...)
 363   (lambda (ast)
 364     ...)
 365   (lambda (ast)
 366     ...))
 367
 368 (define-op2 'six.x:-y 'x:-y
 369   (lambda (ast)
 370     ...)
 371   (lambda (ast)
 372     ...)
 373   (lambda (ast)
 374     ...))
 375
 376 (define (operation? source)
 377   (and (pair? source)
 378        (let ((x (car source)))
 379          (let loop ((lst operators))
 380            (cond ((null? lst)
 381                   #f)
 382                  ((eq? (op-six-id (car lst)) x)
 383                   (car lst))
 384                  (else
 385                   (loop (cdr lst))))))))