1(module-static #t) 2 3(define-namespace Repl "class:kawa.repl") 4(define-namespace Repl2 <kawa.repl>) 5 6(define (set-home1 (x :: <String>)) (set! (<kawa.repl>:.homeDirectory) x)) 7(define (set-home2 (x :: <String>)) (set! <kawa.repl>:homeDirectory x)) 8(define (set-home3 (x :: <String>)) (set! (Repl:.homeDirectory) x)) 9(define (set-home4 (x :: <String>)) (set! Repl:homeDirectory x)) 10(define (set-home5 (x :: <String>)) (set! (kawa.repl:.homeDirectory) x)) 11(define (set-home6 (x :: <String>)) (set! kawa.repl:homeDirectory x)) 12(define (set-home7 (x :: <String>)) (set! (Repl2:.homeDirectory) x)) 13(define (set-home8 (x :: <String>)) (set! Repl2:homeDirectory x)) 14 15(define (get-home1) (<kawa.repl>:.homeDirectory)) 16(define (get-home2) <kawa.repl>:homeDirectory) 17(define (get-home3) (Repl:.homeDirectory)) 18(define (get-home4) Repl:homeDirectory) 19(define (get-home5) (kawa.repl:.homeDirectory)) 20(define (get-home6) kawa.repl:homeDirectory) 21(define (get-home7) (Repl2:.homeDirectory)) 22(define (get-home8) Repl2:homeDirectory) 23 24(define-namespace Pair1 <pair>) 25(define-namespace Pair2 <gnu.lists.Pair>) 26(define-namespace Pair3 "class:gnu.lists.Pair") 27 28(define (set-car1 (p ::<pair>) x) (set! (*:.car p) x)) 29(define (set-car2 (p ::<pair>) x) (set! (<pair>:.car p) x)) 30(define (set-car3 (p ::<pair>) x) (set! (gnu.lists.Pair:.car p) x)) 31(define (set-car4 (p ::<pair>) x) (set! (<gnu.lists.Pair>:.car p) x)) 32(define (set-car5 (p ::<pair>) x) (set! (Pair1:.car p) x)) 33(define (set-car6 (p ::<pair>) x) (set! (Pair2:.car p) x)) 34(define (set-car7 (p ::<pair>) x) (set! (Pair3:.car p) x)) 35(define (set-car8 (p ::<pair>) x) (set! p:car x)) 36(define (set-car9 p x) (set! (Pair1:.car p) x)) 37 38(define (get-car1 (p ::<pair>)) (*:.car p)) 39(define (get-car2 (p ::<pair>)) (<pair>:.car p)) 40(define (get-car3 (p ::<pair>)) (gnu.lists.Pair:.car p)) 41(define (get-car4 (p ::<pair>)) (<gnu.lists.Pair>:.car p)) 42(define (get-car5 (p ::<pair>)) (Pair1:.car p)) 43(define (get-car6 (p ::<pair>)) (Pair2:.car p)) 44(define (get-car7 (p ::<pair>)) (Pair3:.car p)) 45(define (get-car8 (p ::<pair>)) p:car) 46(define (get-car9 p) (Pair3:.car p)) 47(define (get-car10 p) (<pair>:.car p)) 48(define (get-car11 p::pair) (car p)) 49 50(define (is-pair1 x) (<pair>:instance? x)) 51(define (is-pair2 x) (gnu.lists.Pair:instance? x)) 52(define (is-pair3 x) (<gnu.lists.Pair>:instance? x)) 53(define (is-pair4 x) (Pair1:instance? x)) 54(define (is-pair5 x) (Pair2:instance? x)) 55(define (is-pair6 x) (Pair3:instance? x)) 56(define (is-pair7 x) (instance? x <pair>)) 57(define (is-pair9 x) (instance? x <gnu.lists.Pair>)) 58(define (is-pair10 x) (instance? x Pair1:<>)) 59(define (is-pair11 x) (instance? x Pair2:<>)) 60(define (is-pair12 x) (instance? x Pair3:<>)) 61(define (is-pair13 x) (gnu.lists.Pair? x)) 62(define (is-pair14 x) (Pair1? x)) 63(define (is-pair15 x) (Pair2? x)) 64(define (is-pair16 x) (Pair3? x)) 65 66(define (cast-to-pair1 x) (<pair>:@ x)) 67(define (cast-to-pair2 x) (->gnu.lists.Pair x)) 68(define (cast-to-pair3 x) (<gnu.lists.Pair>:@ x)) 69(define (cast-to-pair4 x) (Pair1:@ x)) 70(define (cast-to-pair5 x) (Pair2:@ x)) 71(define (cast-to-pair6 x) (->Pair3 x)) 72(define (cast-to-pair7 x) (as <pair> x)) 73(define (cast-to-pair9 x) (as <gnu.lists.Pair> x)) 74(define (cast-to-pair10 x) (as Pair1:<> x)) 75(define (cast-to-pair11 x) (as Pair2:<> x)) 76(define (cast-to-pair12 x) (as Pair3:<> x)) 77 78(define (new-pair1 x y) (<pair>:new x y)) 79(define (new-pair2 x y) (gnu.lists.Pair:new x y)) 80(define (new-pair3 x y) (<gnu.lists.Pair>:new x y)) 81(define (new-pair4 x y) (Pair1:new x y)) 82(define (new-pair5 x y) (Pair2:new x y)) 83(define (new-pair6 x y) (Pair3:new x y)) 84(define (new-pair7 x y) (make <pair> x y)) 85(define (new-pair9 x y) (make <gnu.lists.Pair> x y)) 86(define (new-pair10 x y) (make Pair1:<> x y)) 87(define (new-pair11 x y) (make Pair2:<> x y)) 88(define (new-pair12 x y) (make Pair3:<> x y)) 89 90(define (is-empty1 (p::<pair>)) ;; OK 91 (*:isEmpty p)) 92 93(define (make-iarr1 (n :: <int>)) (make <int[]> size: n)) 94(define (make-iarr2 (n :: <int>)) (<int[]> size: n)) 95(define (make-iarr3 (n :: <int>)) (<int[]> size: n 3 4 5)) 96 97(define (length-iarr1 (arr :: <int[]>)) :: <int> 98 (field arr 'length)) 99(define (length-iarr2(arr :: <int[]>)) :: <int> 100 (*:.length arr)) 101(define (length-iarr3 (arr :: <int[]>)) :: <int> 102 arr:length) 103(define (get-iarr1 (arr :: <int[]>) (i :: <int>)) :: <int> 104 (arr i)) 105 106(define (set-iarr1 (arr :: <int[]>) (i :: <int>) (val :: <int>)) :: <void> 107 (set! (arr i) val)) 108 109#| 110(define (car1 (x :: <pair>)) ;; OK 111 (*:.car x)) 112(define (get-ns str) 113 (<gnu.mapping.Namespace>:getInstance str)) 114 115(define (xcarx (p <pair>)) 116 (p:isEmpty)) 117; (*:isEmpty p)) 118; (*:.car p)) 119;(define-alias xx #,(namespace "XX")) 120(define TWO xx:TWO) 121|# 122(define-simple-class <Int> () 123 (value :: <int>) 124 ((toHex) 125 (<java.lang.Integer>:toHexString value)) 126 ((toHex x) allocation: 'static 127 (<java.lang.Integer>:toHexString x)) 128 ((toHex x) allocation: 'static 129 (<java.lang.Integer>:toHexString x))) 130(define (tohex1 x) 131 (<Int>:toHex x)) 132(define (tohex2 (x :: <Int>)) 133 (invoke x 'toHex)) 134(define (tohex3 (x :: <Int>)) 135 (x:toHex)) 136 137(define (varargs1) 138 (invoke gnu.math.IntNum 'getMethod "valueOf" 139 java.lang.String java.lang.Integer:TYPE)) 140(define (varargs2 (argtypes :: java.lang.Class[])) 141 (invoke gnu.math.IntNum 'getMethod "valueOf" @argtypes)) 142(define (varargs3 argtypes) 143 (invoke gnu.math.IntNum 'getMethod "valueOf" @argtypes)) 144 145 146(define (top-level-recurse1 x::pair) 147 (set-car! x 123) 148 (top-level-recurse1 x)) 149 150(define (top-level-recurse2 a b) 151 (top-level-recurse2 b a)) 152 153(define-namespace xx "XX") 154(define xx:two 222) 155(define list-two (list 'xx:Two)) 156 157(define (factoriali1 x :: int) :: int 158 (if (< x 1) 1 159 (* x (factoriali1 (- x 1))))) 160(define (factoriali2 x :: <int>) :: <int> 161 (if (< x 1) 1 162 (* x (factoriali2 (- x 1))))) 163(define (factoriall1 x :: long) :: long 164 (if (< x 1) 1 165 (* x (factoriall1 (- x 1))))) 166(define (factorialI1 x :: <integer>) :: <integer> 167 (if (< x 1) 1 168 (* x (factorialI1 (- x 1))))) 169 170(define (plus-lambda1) :: int 171 ((lambda (x y) (+ x y)) 3 4)) 172 173(define (first-negative (vals :: double[])) :: double 174 (let ((count vals:length)) 175 (call-with-current-continuation 176 (lambda (exit) 177 (do ((i :: int 0 (+ i 1))) 178 ((= i count) 179 0) 180 (let ((x (vals i))) 181 (if (< x 0) 182 (exit x)))))))) 183 184(define (inline-two-calls (x :: int)) :: int 185 (define (f (w :: int)) (+ w 10)) 186 (if (> x 0) 187 (let ((y1 (+ x 1))) 188 (f y1)) 189 (let ((y2 (+ x 2))) 190 (f y2)))) 191 192(define (inline-two-functions x) 193 (letrec ((f (lambda () 194 (if x (f) (g)))) 195 (g (lambda () 196 (if x (g) (f))))) 197 (f))) 198 199(define (check-even (x :: int)) ::boolean 200 (letrec ((even? 201 (lambda ((n1 :: int)) 202 (if (= n1 0) 203 #t 204 (odd? (- n1 1))))) 205 (odd? 206 (lambda ((n2 :: int)) 207 (if (= n2 0) 208 #f 209 (even? (- n2 1)))))) 210 (even? x))) 211 212;; Same as check-even, but without return-type specifier 213(define (check-even-unspec-return (x :: int)) 214 (letrec ((even? 215 (lambda ((n1 :: int)) 216 (if (= n1 0) 217 #t 218 (odd? (- n1 1))))) 219 (odd? 220 (lambda ((n2 :: int)) 221 (if (= n2 0) 222 #f 223 (even? (- n2 1)))))) 224 (even? x))) 225 226(define (constant-propagation1) 227 (define x :: int 6) 228 (define x2 (* x 2)) 229 (+ x x2)) 230 231(define (constant-propagation2) 232 (let ((cont2 (lambda (j::int) (+ 10 j)))) 233 (cont2 3))) 234 235;; FIXME constant-folding is not done as well as we'd like. 236;; Partly caused by setting dval=null in InlineCalls:visitReferenceExp. 237;; The other problem is we visit a called Lambda (here cont2) before 238;; visiting the argument (here i). That also means we visit the 239;; arguments without using the required parameter type. 240(define (constant-propagation3) 241 (let* ((i::int 2) 242 (cont2 (lambda (j::int) (+ i j)))) 243 (cont2 i))) 244 245(define (factorial-infer1 (x ::int)) 246 ;; The type of r should be inferred as integer. 247 (define r 1) 248 (do ((i ::int 1 (+ i 1))) 249 ((> i x) r) 250 (set! r (* r i)))) 251 252;; FUTURE - would like to infer type of r as integer 253(define (factorial-infer2 (x ::int)) 254 (do ((i ::int 1 (+ i 1)) (r 1 (* r i))) 255 ((> i x) r))) 256 257(define (get-from-vector1 x::gnu.lists.FVector[java.lang.Integer] i::int) 258 (x:get i)) 259(define (get-from-vector2 x::gnu.lists.FVector[java.lang.Integer] i::int) 260 (x i)) 261 262(define (sum1 n::integer) 263 (let loop ((i 0) (sum 0)) 264 (if (< i n) 265 sum 266 (loop (+ i 1) (+ i sum))))) 267 268(define (sum2 n::double) ::double 269 (let loop ((i 0.0d0) (sum 0)) 270 (if (< i n) 271 sum 272 (loop (+ i 1) (+ i sum))))) 273 274(define (numcomp1 x y) ::int 275 (if (< x y) 5 6)) 276 277(define(numcomp2 x y) ::int 278 (let ((b (<= x y))) 279 (if b 4 5))) 280 281(define (numcomp3 x y z) ::int 282 (if (> x y z) 3 2)) 283 284(define (numcomp4 x y z) ::int 285 (if (> x 10 y 5 z) 6 3)) 286 287(define (numcomp5 x y z) ::int 288 (let ((b (> x 10 y 5 z))) 289 (if b 4 3))) 290 291(define (eqv1 x y) 292 (eqv? y x)) 293 294(define (raise1 x::int y) 295 (if (< x 0) (raise y) (* x 2))) 296 297(define (read1 p::input-port) ::int 298 (let ((ch (read-char p))) 299 (cond ((eof-object? ch) 1) 300 ((char=? ch #\space) 2) 301 ((and (char-ci>=? ch #\A) (char-ci<=? ch #\Z)) 3) 302 (else 4)))) 303 304(define (handle-char ch::character)::void 305 (format #t "{~w}" ch)) 306(define (string-for-each1 str::string)::void 307 (string-for-each (lambda (x) (if (char>? x #\Space) (handle-char x))) str)) 308(define (string-for-each2 str::string)::void 309 (string-for-each handle-char str)) 310(import (kawa string-cursors)) 311(define (string-for-each3 str::string)::void 312 (string-cursor-for-each (lambda (x) (if (char>? x #\Space) (handle-char x))) 313 str)) 314(define (string-for-each4 str::string 315 start::string-cursor end::string-cursor)::void 316 (string-cursor-for-each handle-char str start end)) 317(define (string-for-each5 str::string 318 start::int end::int)::void 319 (srfi-13-string-for-each handle-char str start end)) 320(define (string-for-each6 str::string)::void 321 (string-for-each 322 (lambda (x y z) (handle-char x) (handle-char y) (handle-char z)) 323 str "BCDE" str)) 324 325(define (string-append1 (str::gnu.lists.FString) (ch::char)) 326 (string-append! str ch)) 327 328(define (string-append2 (str::gnu.lists.FString) (ch::character)) 329 (string-append! str ch)) 330(define (string-append3 (str::gnu.lists.FString) (ch::gnu.lists.FString)) 331 (string-append! str ch)) 332(define (string-append4 (str::gnu.lists.FString) (ch::gnu.text.Char)) 333 (string-append! str ch)) 334(define (string-append5 (str::gnu.lists.FString) (ch::java.lang.Character)) 335 (string-append! str ch)) 336(define (string-append6 (str::gnu.lists.FString) ch) 337 (string-append! str ch)) 338(define (string-append7 (str::gnu.lists.FString) ch1 (ch2::character)) 339 (string-append! str ch1 ch2)) 340 341(define (translate-space-to-newline str::string)::string 342 (let ((result (make-string 0))) 343 (string-for-each 344 (lambda (ch) 345 (string-append! result 346 (if (char=? ch #\Space) #\Newline ch))) 347 str) 348 result)) 349 350(define (case01) 351 (let ((key 5)) 352 (case key 353 ((1 2 3 4) '1to4) 354 ((5 6 7 8) '5to8)))) 355 356(define (case02) 357 (let ((key (* 2 3))) 358 (case key 359 ((1 2 3 4) '1to4) 360 ((5 6 7 8) '5to8)))) 361 362(define (case03) 363 (let ((key 'five)) 364 (case key 365 ((one two three four) '1to4) 366 ((five six seven eight) '5to8)))) 367 368(define (case04 key) 369 (case key 370 ((1 2 3 4) (+ 5 (* 2 3))) 371 ((5 6 7 8) (* 2 (+ 3 4))) 372 (else (+ (* 3 2) 6)))) 373 374(define (case05 key::int) 375 (case key 376 ((1 2 3 4) (+ 5 (* 2 3))) 377 ((5 6 7 8) (* 2 (+ 3 4))) 378 (else (+ (* 3 2) 6)))) 379 380(define (case06 key::long) 381 (case key 382 ((1 2 3 4) (+ 5 (* 2 3))) 383 ((5 6 7 8) (* 2 (+ 3 4))) 384 (else (+ (* 3 2) 6)))) 385 386(define (case07 key) 387 (case key 388 ((1 2 3 4) 1) 389 ((5 6 7 8) 2) 390 (else 3))) 391 392(define (case08 key::int) 393 (case key 394 ((1 2 3 4) 1) 395 ((5 6 7 8) 2) 396 (else 3))) 397 398(define (case09 key::long) 399 (case key 400 ((1 2 3 4) 1) 401 ((5 6 7 8) 2) 402 (else 3))) 403 404(define (case10 key) 405 (case key 406 ((1 2 3 4) '1to4) 407 ((5 6 7 8) '5to8) 408 (else 3))) 409 410(define (case11 key::int) 411 (case key 412 ((1 2 3 4) '1to4) 413 ((5 6 7 8) '5to8) 414 (else 3))) 415 416(define (case12 key::long) 417 (case key 418 ((1 2 3 4) '1to4) 419 ((5 6 7 8) '5to8) 420 (else 3))) 421 422(define (case13 key::integer) 423 (case key 424 ((1 2 3 4) 1) 425 ((5 6 7 8) 2) 426 (else 3))) 427 428(define (case14 key::char) 429 (case key 430 ((#\a #\b #\c #\d) 1) 431 ((#\e #\f #\g #\h) 2) 432 (else 3))) 433 434(define (callWithValues1 x::integer y::integer) 435 (call-with-values (lambda () (floor/ x y)) 436 (lambda (a b) (list b a)))) 437 438(define (callWithValues2 x::integer y::integer) 439 (call-with-values (lambda () (values (+ x 1) (- y 1))) 440 list)) 441 442(define (callWithValues3 x::integer y::integer) 443 (call-with-values (lambda () (floor/ x y)) 444 list)) 445 446(define (mmemq x list) 447 (let lp ((lst list)) 448 (and (? p::pair lst) 449 (if (eq? x p:car) lst 450 (lp p:cdr))))) 451 452(define (greater-equal x y)::boolean 453 (>= x y)) 454(define (greater-equal-u32-s32 x::uint y::int) 455 (>= x y)) 456(define (greater-equal-u32-s32-generic x::uint y::int) 457 (greater-equal x y)) 458(define (greater-equal-u64-s32 x::ulong y::int) 459 (>= x y)) 460(define (greater-equal-u64-u64 x::ulong y::ulong) 461 (>= x y)) 462(define (greater-equal-u64-u64-generic x::ulong y::ulong) 463 (greater-equal x y)) 464 465(define s8a::byte 123) 466(define (increment-s8a) (set! s8a (+ s8a 1))) 467(define (increment-arr-s8 arr::byte[] i::int) (set! (arr i) (+ (arr i) 1))) 468 469(define u8a::ubyte 253) 470(define u16a::ushort #xff35) 471(define (increment-u8a) (set! u8a (+ u8a 1))) 472(define (set-u16a val::int) (set! u16a val)) 473(define (add-u8a-u16a) 474 (+ u8a u16a)) 475 476(define (rshift-integer x::integer y::int) 477 (bitwise-arithmetic-shift-right x y)) 478(define (rshift-s16 x::short y::int) 479 (bitwise-arithmetic-shift-right x y)) 480(define (rshift-s32 x::int y::int) 481 (bitwise-arithmetic-shift-right x y)) 482(define (rshift-s64 x::long y::int) 483 (bitwise-arithmetic-shift-right x y)) 484(define (rshift-u32 x::uint y::int) 485 (bitwise-arithmetic-shift-right x y)) 486(define (rshift-u64 x::ulong y::int) 487 (bitwise-arithmetic-shift-right x y)) 488 489(define (lshift-integer x::integer y::int) 490 (bitwise-arithmetic-shift-left x y)) 491(define (lshift-s16 x::short y::int) 492 (bitwise-arithmetic-shift-left x y)) 493(define (lshift-s32 x::int y::int) 494 (bitwise-arithmetic-shift-left x y)) 495(define (lshift-s64 x::long y::int) 496 (bitwise-arithmetic-shift-left x y)) 497(define (lshift-u32 x::uint y::int) 498 (bitwise-arithmetic-shift-left x y)) 499(define (lshift-u64 x::ulong y::int) 500 (bitwise-arithmetic-shift-left x y)) 501 502(define (index-s16 i::int) 503 (let ((v #s16(3 5 -12 2))) 504 (v i))) 505(define (make-u8v1 x::int) 506 (u8vector 5 253 x)) 507(define (index-u8v1 i::int) 508 (let ((v (make-u8v1 3))) 509 (v i))) 510(define (index-u8i1 i::int) ::int 511 (let ((v (make-u8v1 3))) 512 (v i))) 513(define (index-u8i2 i::int) ::int 514 (index-u8v1 i)) 515(define (index-f32 i::int) 516 (let ((v #f32(3.4 1/2 55))) 517 (f32vector-ref v i))) 518 519(define (set-u8vector1 v::u8vector i::int x::long) 520 (u8vector-set! v i x)) 521 522(define (set-u8vector2 v::u8vector i::int x::long) 523 (set! (v i) x)) 524 525(define (index-seq q::sequence i::int) 526 (q i)) 527 528(define (index-str1 x::string i::int) 529 (x i)) 530 531(define (index-str2 x::string i::int) 532 ((dynamic x) i)) 533 534(define (index-str3 x::string i::int) 535 (index-seq x i)) 536 537(define (index-garr1 x::array2 i::int j::int) 538 (x i j)) 539 540(define (index-garr2 x::array2 i::int j::int) 541 (+ (x j i) 100)) 542 543(define (index-garr3 x::array2[double] i::int j::int) 544 (x i j)) 545 546(define (index-garr4 x::array2[long] i::int j::int) 547 (+ (x j i) 100)) 548 549(define (index-garr5 x::array[double] i::int j::int) 550 (x i j)) 551 552(define (index-garr6 x::array i::int j::int) 553 (x i j)) 554 555(define (index-garr7 x::array[int] i::int j::int) 556 (x i j)) 557 558;; From GitLab issue #32 "Imprecise infered return type". 559(define (list-cond x) (if x '() (list 1 2))) 560