operators.scm

   1 ;;; operators
   2
   3 (define operators '())
   4
   5 (define (define-op1 six-id id type-rule constant-fold code-gen)
   6   (set! operators
   7         (cons (make-op1 six-id id type-rule constant-fold code-gen)
   8               operators)))
   9
  10 (define (define-op2 six-id id type-rule constant-fold code-gen)
  11   (set! operators
  12         (cons (make-op2 six-id id type-rule constant-fold code-gen)
  13               operators)))
  14
  15 (define (type-rule-int-op1 ast)
  16   (let ((t1 (expr-type (subast1 ast))))
  17     (cond ((eq? t1 'int)
  18            'int) ; TODO add support for other types
  19           (else
  20            (error "int-op1: type error" ast)))))
  21
  22 (define (type-rule-int-op2 ast)
  23   (let ((t1 (expr-type (subast1 ast)))
  24         (t2 (expr-type (subast2 ast))))
  25     (cond ((and (eq? t1 'int) (eq? t2 'int)) ; TODO are there any operations that do otherwise ? add cast support also
  26            'int)
  27           (else
  28            (error "int-op2: type error" ast)))))
  29
  30 (define (type-rule-int-assign ast) ;; TODO add cast support, and why the int in the name ?
  31   (let ((t1 (expr-type (subast1 ast)))
  32         (t2 (expr-type (subast2 ast))))
  33     (if (not (eq? t1 t2))
  34         (error "int-assign: type error" ast))
  35     t1))
  36
  37 (define (type-rule-int-comp-op2 ast)
  38   (let ((t1 (expr-type (subast1 ast)))
  39         (t2 (expr-type (subast2 ast))))
  40     (cond ((and (eq? t1 'int) (eq? t2 'int))
  41            'bool)
  42           (else
  43            (error "int-comp-op2: type error" ast)))))
  44
  45 (define (type-rule-bool-op2 ast)
  46   (let ((t1 (expr-type (subast1 ast)))
  47         (t2 (expr-type (subast2 ast))))
  48     (cond ((or (and (eq? t1 'bool) (eq? t2 'bool))
  49                (and (eq? t1 'bool) (eq? t2 'int)) ; ints can be cast to bools
  50                (and (eq? t1 'int)  (eq? t2 'bool)))
  51            'bool)
  52           (else
  53            (error "bool-op2: type error" ast)))))
  54
  55 (define-op1 'six.!x '!x
  56   type-rule-int-op1
  57   (lambda (ast) ;; TODO implement these
  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-op1 'six.~x '~x
  91   type-rule-int-op1
  92   (lambda (ast)
  93     ast)
  94   (lambda (ast)
  95     ...))
  96
  97 (define-op2 'six.x%y 'x%y
  98   type-rule-int-op2
  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     ...)
 114   (lambda (ast)
 115     ast)
 116   (lambda (ast)
 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 (define-op2 'six.x<<y 'x<<y
 155   type-rule-int-op2
 156   (lambda (ast)
 157     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-op2 'six.x<y 'x<y
 169   type-rule-int-comp-op2
 170   (lambda (ast)
 171     ast)
 172   (lambda (ast)
 173     ...))
 174
 175 (define-op2 'six.x<=y 'x<=y
 176   type-rule-int-comp-op2
 177   (lambda (ast)
 178     ast)
 179   (lambda (ast)
 180     ...))
 181
 182 (define-op2 'six.x>y 'x>y
 183   type-rule-int-comp-op2
 184   (lambda (ast)
 185     ast)
 186   (lambda (ast)
 187     ...))
 188
 189 (define-op2 'six.x>=y 'x>=y
 190   type-rule-int-comp-op2
 191   (lambda (ast)
 192     ast)
 193   (lambda (ast)
 194     ...))
 195
 196 (define-op2 'six.x!=y 'x!=y
 197   type-rule-int-comp-op2
 198   (lambda (ast)
 199     ast)
 200   (lambda (ast)
 201     ...))
 202
 203 (define-op2 'six.x==y 'x==y
 204   type-rule-int-comp-op2
 205   (lambda (ast)
 206     ast)
 207   (lambda (ast)
 208     ...))
 209
 210 (define-op2 'six.x&y 'x&y
 211   type-rule-int-op2
 212   (lambda (ast)
 213     ast)
 214   (lambda (ast)
 215     ...))
 216
 217 (define-op1 'six.&x '&x
 218   (lambda (ast)
 219     ...)
 220   (lambda (ast)
 221     ast)
 222   (lambda (ast)
 223     ...))
 224
 225 (define-op2 'six.x^y 'x^y
 226   type-rule-int-op2
 227   (lambda (ast)
 228     ast)
 229   (lambda (ast)
 230     ...))
 231
 232 (define-op2 '|six.x\|y| '|x\|y|
 233   type-rule-int-op2
 234   (lambda (ast)
 235     ast)
 236   (lambda (ast)
 237     ...))
 238
 239 (define-op2 'six.x&&y 'x&&y
 240   type-rule-bool-op2
 241   (lambda (ast)
 242     ast)
 243   (lambda (ast)
 244     ...))
 245
 246 (define-op2 '|six.x\|\|y| '|x\|\|y|
 247   type-rule-bool-op2
 248   (lambda (ast)
 249     ast)
 250   (lambda (ast)
 251     ...))
 252
 253 (define-op2 'six.x?y:z 'x?y:z
 254   (lambda (ast)
 255     ...)
 256   (lambda (ast)
 257     ast)
 258   (lambda (ast)
 259     ...))
 260
 261 (define-op2 'six.x:y 'x:y
 262   (lambda (ast)
 263     ...)
 264   (lambda (ast)
 265     ast)
 266   (lambda (ast)
 267     ...))
 268
 269 (define-op2 'six.x%=y 'x%=y
 270   type-rule-int-assign
 271   (lambda (ast)
 272     ast)
 273   (lambda (ast)
 274     ...))
 275
 276 (define-op2 'six.x&=y 'x&=y
 277   type-rule-int-assign
 278   (lambda (ast)
 279     ast)
 280   (lambda (ast)
 281     ...))
 282
 283 (define-op2 'six.x*=y 'x*=y
 284   type-rule-int-assign
 285   (lambda (ast)
 286     ast)
 287   (lambda (ast)
 288     ...))
 289
 290 (define-op2 'six.x+=y 'x+=y
 291   type-rule-int-assign
 292   (lambda (ast)
 293     ast)
 294   (lambda (ast)
 295     ...))
 296
 297 (define-op2 'six.x-=y 'x-=y
 298   type-rule-int-assign
 299   (lambda (ast)
 300     ast)
 301   (lambda (ast)
 302     ...))
 303
 304 (define-op2 'six.x/=y 'x/=y
 305   type-rule-int-assign
 306   (lambda (ast)
 307     ast)
 308   (lambda (ast)
 309     ...))
 310
 311 (define-op2 'six.x<<=y 'x<<=y
 312   type-rule-int-assign
 313   (lambda (ast)
 314     ast)
 315   (lambda (ast)
 316     ...))
 317
 318 (define-op2 'six.x=y 'x=y
 319   type-rule-int-assign
 320   (lambda (ast)
 321     ast)
 322   (lambda (ast)
 323     ...))
 324
 325 (define-op2 'six.x>>=y 'x>>=y
 326   type-rule-int-assign
 327   (lambda (ast)
 328     ast)
 329   (lambda (ast)
 330     ...))
 331
 332 (define-op2 'six.x^=y 'x^=y
 333   type-rule-int-assign
 334   (lambda (ast)
 335     ast)
 336   (lambda (ast)
 337     ...))
 338
 339 (define-op2 '|six.x\|=y| '|x\|=y|
 340   type-rule-int-assign
 341   (lambda (ast)
 342     ast)
 343   (lambda (ast)
 344     ...))
 345
 346 (define-op2 'six.x:=y 'x:=y
 347   (lambda (ast)
 348     ...)
 349   (lambda (ast)
 350     ...)
 351   (lambda (ast)
 352     ...))
 353
 354 (define-op2 '|six.x,y| '|x,y|
 355   (lambda (ast)
 356     ...)
 357   (lambda (ast)
 358     ...)
 359   (lambda (ast)
 360     ...))
 361
 362 (define-op2 'six.x:-y 'x:-y
 363   (lambda (ast)
 364     ...)
 365   (lambda (ast)
 366     ...)
 367   (lambda (ast)
 368     ...))
 369
 370 (define (operation? source)
 371   (and (pair? source)
 372        (let ((x (car source)))
 373          (let loop ((lst operators))
 374            (cond ((null? lst)
 375                   #f)
 376                  ((eq? (op-six-id (car lst)) x)
 377                   (car lst))
 378                  (else
 379                   (loop (cdr lst))))))))