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