![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to seqtest.icn CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / icon / tests|
Return to seqtest.icn CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / tests |
1.1 ! root 1: procedure Gk(k) ! 2: local i, m_ ! 3: i := 0 ! 4: m_ := table(0) ! 5: ! 6: suspend m_[C_([i +:= |1,k])] := i - m_[C_([m_[C_([i - k,k])],k])] ! 7: end ! 8: procedure Q() ! 9: local i, m_ ! 10: i := 0 ! 11: m_ := table(0) ! 12: suspend m_[i +:= 1] := 1 ! 13: suspend m_[i +:= 1] := 1 ! 14: suspend m_[i +:= |1] := m_[i - m_[i - 1]] + m_[i - m_[i - 2]] ! 15: end ! 16: procedure Fib() ! 17: local i, m_ ! 18: i := 0 ! 19: m_ := table(0) ! 20: suspend m_[i +:= 1] := 1 ! 21: suspend m_[i +:= 1] := 1 ! 22: suspend m_[i +:= |1] := m_[i - 1] + m_[i - 2] ! 23: end ! 24: procedure G() ! 25: local i, m_ ! 26: i := 0 ! 27: m_ := table(0) ! 28: ! 29: suspend m_[i +:= |1] := i - m_[m_[i - 1]] ! 30: end ! 31: procedure Fibs() ! 32: local i, m_ ! 33: i := 0 ! 34: m_ := table("") ! 35: suspend m_[i +:= 1] := "a" ! 36: suspend m_[i +:= 1] := "b" ! 37: suspend m_[i +:= |1] := m_[i - 1] || m_[i - 2] ! 38: end ! 39: procedure Unop_(op,X) # op(X) ! 40: local e, a, i, s ! 41: if S_(X) then { ! 42: a := copy(X.a) ! 43: i := *X.a ! 44: e := create !a | Pre_(X.e,i) ! 45: return Sequence([],create |Unop_(op,@e)) ! 46: } ! 47: else suspend op(X) ! 48: end ! 49: ! 50: procedure Binop_(op,X1,X2) # op(X1,X2) ! 51: local e1, e2, a1, a2, i1, i2, s1, s2 ! 52: if not S_(X1 | X2) then suspend op(X1,X2) ! 53: else { ! 54: s1 := Seq_(X1) ! 55: s2 := Seq_(X2) ! 56: a1 := copy(s1.a) ! 57: a2 := copy(s2.a) ! 58: i1 := *s1.a ! 59: i2 := *s2.a ! 60: e1 := create !a1 | Pre_(s1.e,i1) ! 61: e2 := create !a2 | Pre_(s2.e,i2) ! 62: return Sequence([],create |Binop_(op,@e1,@e2)) ! 63: } ! 64: end ! 65: ! 66: procedure Triop_(op,X1,X2,X3) # op(X1,X2,X2) ! 67: local e1, e2, e3, a1, a2, a3, i1, i2, i3, s1, s2, s3 ! 68: if not S_(X1 | X2 | X3) then suspend op(X1,X2,X3) ! 69: else { ! 70: s1 := Seq_(X1) ! 71: s2 := Seq_(X2) ! 72: s3 := Seq_(X3) ! 73: a1 := copy(s1.a) ! 74: a2 := copy(s2.a) ! 75: a3 := copy(s3.a) ! 76: i1 := *s1.a ! 77: i2 := *s2.a ! 78: i3 := *s3.a ! 79: e1 := create !a1 | Pre_(s1.e,i1) ! 80: e2 := create !a2 | Pre_(s2.e,i2) ! 81: e3 := create !a3 | Pre_(s3.e,i3) ! 82: return Sequence([],create |Triop_(op,@e1,@e2,@e3)) ! 83: } ! 84: end ! 85: ! 86: procedure Quadop_(op,X1,X2,X3,X4) # op(X1,X2,X3,X4) ! 87: local e1, e2, e3, e4, a1, a2, a3, a4, i1, i2, i3, i4, s1, s2, s3, s4 ! 88: if not S_(X1 | X2 | X3 | X4) then suspend op(X1,X2,X3,X4) ! 89: else { ! 90: s1 := Seq_(X1) ! 91: s2 := Seq_(X2) ! 92: s3 := Seq_(X3) ! 93: s4 := Seq_(X4) ! 94: a1 := copy(s1.a) ! 95: a2 := copy(s2.a) ! 96: a3 := copy(s3.a) ! 97: a4 := copy(s4.a) ! 98: i1 := *s1.a ! 99: i2 := *s2.a ! 100: i3 := *s3.a ! 101: i4 := *s4.a ! 102: e1 := create !a1 | Pre_(s1.e,i1) ! 103: e2 := create !a2 | Pre_(s2.e,i2) ! 104: e3 := create !a3 | Pre_(s3.e,i3) ! 105: e4 := create !a4 | Pre_(s4.e,i4) ! 106: return Sequence([],create |Quadop_(op,@e1,@e2,@e3,@e4)) ! 107: } ! 108: end ! 109: ! 110: procedure P_(a) # limited evaluation ! 111: return case *a of { ! 112: 2 : Unop_(a[1],a[2]) ! 113: 3 : Binop_(a[1],a[2],a[3]) ! 114: 4 : Triop_(a[1],a[2],a[3],a[4]) ! 115: 5 : Quadop_(a[1],a[2],a[3],a[4],a[5]) ! 116: default : stop("Too many arguments in parallel evaluation") ! 117: } ! 118: end ! 119: ! 120: record Sequence(a,e) # sequence data type ! 121: record Undef() # for unique "undefined" value ! 122: ! 123: global Phi, Iplus, Iplus_, Izero, Undef_, X_, Genseq_, GenJ_ ! 124: ! 125: procedure At(X) # element generation for sequences ! 126: every i := seq() do ! 127: if s := Ref_(X,i) then suspend s ! 128: else fail ! 129: end ! 130: ! 131: procedure C_(a) # identifying "subscript" for ! 132: local s # recurrence lookup ! 133: s := a[1] ! 134: every s ||:= "." || image(a[2 to *a]) ! 135: return s ! 136: end ! 137: ! 138: procedure Cat_(X1,X2) # concatenation of X1 and X2 ! 139: local s1, s2, e1, e2, i1, i2, a1, a2 ! 140: s1 := Seq_(X1) ! 141: s2 := Seq_(X2) ! 142: e1 := s1.e ! 143: i1 := *s1.a ! 144: e2 := s2.e ! 145: i2 := *s2.a ! 146: a2 := copy(s2.a) ! 147: return Sequence(copy(s1.a),create Pre_(e1,i1) | !a2 | Pre_(e2,i2)) ! 148: end ! 149: ! 150: procedure Collapse_(X) # generate scalars from X ! 151: if S_(X) then ! 152: suspend Collapse_(Gen_(X)) ! 153: else return X ! 154: end ! 155: ! 156: procedure Expr_(X) # return refreshed co-expression for X ! 157: if type(X) == "Sequence" then return ^X.e | &null ! 158: else if /X then return Phi.e ! 159: else return create X ! 160: end ! 161: ! 162: procedure Gen_(X,v) # generate elements of X ! 163: local i, x ! 164: if X_[\v] === Undef_ then fail # termination heuristic ! 165: if not S_(X) then return X # note: does not fail if X null-valued ! 166: every i := seq() do { ! 167: if x := X.a[i] then # produce stored values first ! 168: suspend x ! 169: else { # transfer remaining values ! 170: put(X.a,@X.e) | fail ! 171: if x := X.a[i] then suspend x else fail ! 172: } ! 173: if X_[\v] === Undef_ then fail # termination heuristic ! 174: } ! 175: end ! 176: ! 177: procedure Generic_(p,X) # apply p to X ! 178: if /X then fail ! 179: return if S_(X) then every p(Gen_(X)) else p(X) ! 180: end ! 181: ! 182: procedure Init_() ! 183: GenJ_ := Gen_ ! 184: Undef_ := Undef() ! 185: X_ := table() ! 186: Iplus := Sequence([],create seq(1)) ! 187: Iplus_ := Sequence([],create seq(1)) ! 188: Izero := Sequence([],create seq(0)) ! 189: Izero_ := Sequence([],create seq(0)) ! 190: Phi := Sequence([], create &fail) ! 191: Genseq_ := Iplus_ ! 192: end ! 193: ! 194: procedure Lim_(X,i) # limit X to i elements ! 195: local e, s, a, n ! 196: ! 197: if i < 1 then return .Phi ! 198: s := Seq_(X) ! 199: a := copy(s.a) ! 200: n := *s.a ! 201: return Sequence([],create (!a | Pre_(s.e,n)) \ i) ! 202: ! 203: end ! 204: ! 205: procedure Post_(e,i) # limit X to at most i values ! 206: e := ^e ! 207: suspend |@e \ i ! 208: end ! 209: ! 210: procedure Pp_(v) # push/pop undefined marker ! 211: X_[\v] := &null ! 212: suspend ! 213: X_[\v] := &null ! 214: fail ! 215: end ! 216: ! 217: procedure Pre_(e,i) # skip first i values of X ! 218: e := ^e ! 219: every 1 to i ! 220: do @e | fail ! 221: suspend |@e ! 222: end ! 223: ! 224: procedure Qq_(v) # pop/push undefined marker ! 225: X_[\v] := &null ! 226: suspend ! 227: X_[\v] := &null ! 228: fail ! 229: end ! 230: ! 231: procedure Red_(X,op) # reduction of X over op ! 232: local x, y, i ! 233: i := 1 ! 234: suspend x := Ref_(X,i) ! 235: while y := Ref_(X,i +:= 1) do ! 236: suspend (x := op(x,y)) # op(x,y) may fail, not changing x ! 237: end ! 238: ! 239: procedure Ref_(X,i,v) # X!i ! 240: local x ! 241: if i < 1 then { ! 242: X_[\v] := Undef_ # termination heuristic ! 243: fail ! 244: } ! 245: if not S_(X) then # J: coerce to a sequence ! 246: X := Sequence([],create X) ! 247: if i > *X.a then ! 248: every 1 to i - *X.a do ! 249: put(X.a,@X.e) | { ! 250: X_[\v] := Undef_ # termination heuristic ! 251: fail ! 252: } ! 253: return X.a[i] # note that this is not dereffed ! 254: end ! 255: ! 256: procedure S_(x) # is X a sequence? ! 257: return type(x) == "Sequence" ! 258: end ! 259: ! 260: procedure Seq_(X) # coerce X to a unit sequence ! 261: if type(X) == "Sequence" then return X ! 262: else if /X then return Phi ! 263: else return Sequence([],create X) ! 264: end ! 265: ! 266: procedure Shift_(X,i) # shift X left by i elements ! 267: local e,a,n,s ! 268: if i < 1 then return .Phi ! 269: s := Seq_(X) ! 270: a := copy(s.a) ! 271: n := *a ! 272: if n > i then { ! 273: e := create a[i+1 to n] | Pre_(s.e,n) ! 274: return Sequence([],create |@e) ! 275: } ! 276: else ! 277: return Sequence([], create Pre_(s.e,i)) ! 278: end ! 279: global Fibseq, Abc, U, L ! 280: procedure main(); ! 281: Init_() ! 282: Abc := Sequence([], create ("") | ("a") | ("b") | ("c") | ("aa") | ("ab") | ("ac") | ("ba") | ("bb") | ("bc") | ("ca") | ("cb") | ("cc") | ("aaa")); ! 283: Fibseq := Sequence([], create (Fib())); ! 284: U := Sequence([], create ("A") | ("B") | ("C")); ! 285: L := Sequence([], create ("a") | ("b")); ! 286: sec1(); ! 287: sec1(); ! 288: sec1(); ! 289: sec2_0(); ! 290: sec2_0(); ! 291: sec2_0(); ! 292: sec2_1(); ! 293: sec2_1(); ! 294: sec2_1(); ! 295: sec2_3(); ! 296: sec2_3(); ! 297: sec2_3(); ! 298: sec2_4(); ! 299: sec2_4(); ! 300: sec2_4(); ! 301: sec3_1(); ! 302: sec3_1(); ! 303: sec3_1(); ! 304: sec3_2(); ! 305: sec3_2(); ! 306: sec3_2(); ! 307: sec3_3(); ! 308: sec3_3(); ! 309: sec3_3(); ! 310: sec4(); ! 311: sec4(); ! 312: sec4(); ! 313: sec5(); ! 314: sec5(); ! 315: sec5(); ! 316: end ! 317: procedure sec1(); ! 318: write("{x, {y}}: ",Image(Sequence([], create ("x") | (Sequence([], create ("y")))))); ! 319: write("|{{1,2}}|: ",Length(Sequence([], create (Sequence([], create (1) | (2)))))); ! 320: write("F!6: ",Ref_((Fibseq),6,)); ! 321: write("{1,2,3} -> {6,7,8,9}: ",Image(Cat_((Sequence([], create (1) | (2) | (3))),(Sequence([], create (6) | (7) | (8) | (9)))),10)); ! 322: write("F sub 3:5: ",Image(Subseq(Fibseq,3,5))); ! 323: write("F sub 5:inf: ",Image(Shift_((Fibseq),4))); ! 324: end ! 325: procedure sec2_0(); ! 326: write("Fibonacci sequence: ",Image(Fibseq,10)); ! 327: write("closure of a,b,c: ",Image(Abc,10)); ! 328: write("[i]: ",Image(Sequence([],create (Pp_("i") & ! 329: i := Gen_(Genseq_,"i") & 1(GenJ_((i) ,"i"),Qq_("i")))))); ! 330: write("[i - 1]: ",Image(Sequence([],create (Pp_("i") & ! 331: i := Gen_(Genseq_,"i") & 1(GenJ_((Binop_("-",i,1)) ,"i"),Qq_("i")))))); ! 332: write("[i ^ 2]: ",Image(Sequence([],create (Pp_("i") & ! 333: i := Gen_(Genseq_,"i") & 1(GenJ_((Binop_("^",i,2)) ,"i"),Qq_("i")))))); ! 334: write("[i mod 3]: ",Image(Sequence([],create (Pp_("i") & ! 335: i := Gen_(Genseq_,"i") & 1(GenJ_((Binop_("%",i,3)) ,"i"),Qq_("i")))))); ! 336: write("[a to i]: ",Image(Sequence([],create (Pp_("i") & ! 337: i := Gen_(Genseq_,"i") & 1(GenJ_((repl("a",i)) ,"i"),Qq_("i")))))); ! 338: write("[1]: ",Image(Sequence([],create (Pp_("i") & ! 339: i := Gen_(Genseq_,"i") & 1(GenJ_((1) ,"i"),Qq_("i")))))); ! 340: write("[aa]: ",Image(Sequence([],create (Pp_("i") & ! 341: i := Gen_(Genseq_,"i") & 1(GenJ_(("aa") ,"i"),Qq_("i")))))); ! 342: end ! 343: procedure sec2_1(); ! 344: write("[Iplus:i]: ",Image(Sequence([],create (Pp_("i") & ! 345: i := Gen_(.Iplus,"i") & 1(GenJ_((i) ,"i"),Qq_("i")))))); ! 346: write("[Izero:i]: ",Image(Sequence([],create (Pp_("i") & ! 347: i := Gen_(.Izero,"i") & 1(GenJ_((i) ,"i"),Qq_("i")))))); ! 348: write("[Fibseq:i]: ",Image(Sequence([],create (Pp_("i") & ! 349: i := Gen_(Fibseq,"i") & 1(GenJ_((i) ,"i"),Qq_("i")))))); ! 350: write("[[i ^ 2]:F]: ",Image(Sequence([],create (Pp_("i") & ! 351: i := Gen_(Sequence([],create (Pp_("i") & ! 352: i := Gen_(Genseq_,"i") & 1(GenJ_((Binop_("^",i,2)) ,"i"),Qq_("i")))),"i") & 1(GenJ_((Ref_((Fibseq),i,"i")) ,"i"),Qq_("i")))))); ! 353: write("[[i ** 2]:F]: ",Image(Sequence([],create (Pp_("i") & ! 354: i := Gen_(Sequence([], create (1) | (4) | (9) | (16)),"i") & 1(GenJ_((Ref_((Fibseq),i,"i")) ,"i"),Qq_("i")))))); ! 355: write("[{1,3,5}:Abc!i]: ",Image(Sequence([],create (Pp_("i") & ! 356: i := Gen_(Sequence([], create (1) | (3) | (5)),"i") & 1(GenJ_((Ref_((Abc),i,"i")) ,"i"),Qq_("i")))))); ! 357: write("Iplus \\ 4: ",Image(Lim_((.Iplus) ,4),10)); ! 358: write("[Iplus \\ 4:Abc!i]: ",Image(Sequence([],create (Pp_("i") & ! 359: i := Gen_(Lim_((.Iplus) ,4),"i") & 1(GenJ_((Ref_((Abc),i,"i")) ,"i"),Qq_("i")))),10)); ! 360: end ! 361: procedure sec2_2(); ! 362: write("[{i,i}]: ",Image(Sequence([],create (Pp_("i") & ! 363: i := Gen_(Genseq_,"i") & 1(GenJ_((Sequence([], create (i) | (i))) ,"i"),Qq_("i")))))); ! 364: end ! 365: procedure sec2_3(); ! 366: k := 100; ! 367: write("[lambda(j)k + j]: ",Image(Sequence([],create (Pp_("j") & ! 368: j := Gen_(Genseq_,"j") & 1(GenJ_((Binop_("+",k,j)) ,"j"),Qq_("j")))))); ! 369: write("[F:lambda(j)k + j]: ",Image(Sequence([],create (Pp_("j") & ! 370: j := Gen_(Fibseq,"j") & 1(GenJ_((Binop_("+",k,j)) ,"j"),Qq_("j")))))); ! 371: write("[Abc:lambda(s)s || s]: ",Image(Sequence([],create (Pp_("s") & ! 372: s := Gen_(Abc,"s") & 1(GenJ_((Binop_("||",s,s)) ,"s"),Qq_("s")))))); ! 373: end ! 374: procedure sec2_4(); ! 375: write("[lambda(i)[lambda(j) U!i || L!j]: ",Image(Sequence([],create (Pp_("i") & ! 376: i := Gen_(Genseq_,"i") & 1(GenJ_((Sequence([],create (Pp_("j") & ! 377: j := Gen_(Genseq_,"j") & 1(GenJ_((Binop_("||",Ref_((U),i,"i"),Ref_((L),j,"j"))) ,"j"),Qq_("j"))))) ,"i"),Qq_("i")))))); ! 378: write("[lambda(i)[lambda(j) U!j || L!i]: ",Image(Sequence([],create (Pp_("i") & ! 379: i := Gen_(Genseq_,"i") & 1(GenJ_((Sequence([],create (Pp_("j") & ! 380: j := Gen_(Genseq_,"j") & 1(GenJ_((Binop_("||",Ref_((U),j,"j"),Ref_((L),i,"i"))) ,"j"),Qq_("j"))))) ,"i"),Qq_("i")))))); ! 381: write("[Izero:lambda(j)[(Iplus %% j) \\ (j + 1):i]]: ",Image(Sequence([],create (Pp_("j") & ! 382: j := Gen_(.Izero,"j") & 1(GenJ_((Sequence([],create (Pp_("i") & ! 383: i := Gen_(Lim_(((Shift_((.Iplus),j))) ,(Binop_("+",j,1))),"i") & 1(GenJ_((i) ,"i"),Qq_("i"))))) ,"j"),Qq_("j")))))); ! 384: end ! 385: procedure sec3_1(); ! 386: I := Sequence([], create (1) | (2) | (3) | (4) | (5) | (6)); ! 387: J := Sequence([], create (100) | (200) | (300) | (400) | (500) | (600)); ! 388: write("I + J: ",Image(Binop_("+",I,J))); ! 389: write("{a, ab, c} || {c, b, a}: ",Image(Binop_("||",Sequence([], create ("a") | ("ab") | ("c")),Sequence([], create ("c") | ("b") | ("a"))))); ! 390: write("Abc || Abc: ",Image(Binop_("||",Abc,Abc))); ! 391: write("{1,2,3,4} + {1,4}: ",Image(Binop_("+",Sequence([], create (1) | (2) | (3) | (4)),Sequence([], create (1) | (4))))); ! 392: write("{a, ab, c} || {x}: ",Image(Binop_("||",Sequence([], create ("a") | ("ab") | ("c")),Sequence([], create ("x"))))); ! 393: end ! 394: procedure sec3_2(); ! 395: I := Sequence([], create (1) | (2) | (0) | (0) | (45) | (0)); ! 396: write("[if I!i = 0 then {0} else {1}]: ",Image(Sequence([],create (Pp_("i") & ! 397: i := Gen_(Genseq_,"i") & 1(GenJ_((if Binop_("=",Ref_((I),i,"i"),0) then Sequence([], create (0)) else Sequence([], create (1))) ,"i"),Qq_("i")))))); ! 398: write("[if I!i = 0 then 0 else 1]: ",Image(Sequence([],create (Pp_("i") & ! 399: i := Gen_(Genseq_,"i") & 1(GenJ_((if Binop_("=",Ref_((I),i,"i"),0) then 0 else 1) ,"i"),Qq_("i")))))); ! 400: end ! 401: procedure sec3_3(); ! 402: write("Red(Iplus \\ 5,+): ",Image(Red(Lim_((.Iplus) ,5),"+"))); ! 403: write("[Red(F \\ i,+)]: ",Image(Sequence([],create (Pp_("i") & ! 404: i := Gen_(Genseq_,"i") & 1(GenJ_((Red(Lim_((Fibseq) ,i),"+")) ,"i"),Qq_("i")))))); ! 405: write("[Red(Abc \\ (i + 1),||)]: ",Image(Sequence([],create (Pp_("i") & ! 406: i := Gen_(Genseq_,"i") & 1(GenJ_((Red(Lim_((Abc) ,(Binop_("+",i,1))),"||")) ,"i"),Qq_("i")))))); ! 407: end ! 408: procedure sec4(); ! 409: write("[if Iplus!i mod 2 = 0 then Iplus!i]: ",Image(Sequence([],create (Pp_("i") & ! 410: i := Gen_(Genseq_,"i") & 1(GenJ_((if Binop_("=",Binop_("%",Ref_((.Iplus),i,"i"),2),0) then Ref_((.Iplus),i,"i")) ,"i"),Qq_("i")))))); ! 411: write("[if |Abc!i| mod 2 = 0 then Abc!i]: ",Image(Sequence([],create (Pp_("i") & ! 412: i := Gen_(Genseq_,"i") & 1(GenJ_((if Binop_("=",Binop_("%",Unop_("*",(Ref_((Abc),i,"i"))),2),0) then Ref_((Abc),i,"i")) ,"i"),Qq_("i")))))); ! 413: write("[if i mod 2 = 1 then F!(i + 1) else F!(i - 1)]: ",Image(Sequence([],create (Pp_("i") & ! 414: i := Gen_(Genseq_,"i") & 1(GenJ_((if Binop_("=",Binop_("%",i,2),1) then Ref_((Fibseq),(Binop_("+",i,1)),) else Ref_((Fibseq),(Binop_("-",i,1)),)) ,"i"),Qq_("i")))),10)); ! 415: write("[if i mod 2 = 1 then Iplus!i + Iplus!(i + 1)]: ",Image(Sequence([],create (Pp_("i") & ! 416: i := Gen_(Genseq_,"i") & 1(GenJ_((if Binop_("=",Binop_("%",i,2),1) then Binop_("+",Ref_((.Iplus),i,"i"),Ref_((.Iplus),(Binop_("+",i,1)),))) ,"i"),Qq_("i")))))); ! 417: I := Sequence([], create (0) | (1) | (2) | (3) | (0) | (2) | (0) | (5)); ! 418: write("[if I!i = 0 then i]: ",Image(Sequence([],create (Pp_("i") & ! 419: i := Gen_(Genseq_,"i") & 1(GenJ_((if Binop_("=",Ref_((I),i,"i"),0) then i) ,"i"),Qq_("i")))))); ! 420: end ! 421: procedure sec5(); ! 422: write("[Fib(i)]: ",Image(Sequence([],create (Pp_("i") & ! 423: i := Gen_(Genseq_,"i") & 1(GenJ_((Fib()) ,"i"),Qq_("i")))))); ! 424: write("[Fibs(i)]: ",Image(Sequence([],create (Pp_("i") & ! 425: i := Gen_(Genseq_,"i") & 1(GenJ_((Fibs()) ,"i"),Qq_("i")))))); ! 426: write("[G(i - 1)]: ",Image(Sequence([], create (0 | G())))); ! 427: write("[Izero:G(i)]: ",Image(Sequence([], create (0 | G())))); ! 428: write("[Izero:Gk(i,2)]: ",Image(Sequence([], create (Gk(2))))); ! 429: end ! 430: procedure Compress(X) # compression of X to scalar sequence ! 431: return Sequence([],create Collapse_(Copy(X))) ! 432: end ! 433: ! 434: procedure Copy(X) # copy X ! 435: local e, i ! 436: i := *X.a ! 437: return Sequence(copy(X.a),create Pre_(X.e,i)) ! 438: end ! 439: ! 440: procedure Compose(f,X1,X2,X3,X4) # apply f in parallel ! 441: local a ! 442: end ! 443: ! 444: procedure Empty(X) # is X an empty sequence? ! 445: if /X then return Phi ! 446: if not(S_(X)) | (*X.a > 0) | put(X.a,@X.e) then fail ! 447: else return Phi ! 448: end ! 449: ! 450: procedure Image(X,i,r) # image of X to i values ! 451: local s, t, j ! 452: if S_(X) then { ! 453: /i := 5 ! 454: /r := 0 ! 455: if r >= i then return "{...}" ! 456: j := 0 ! 457: s := "{" ! 458: every t := (Gen_(X) \ i) do { ! 459: s ||:= Image(t,i,r +:= 1) || "," ! 460: j +:= 1 ! 461: } ! 462: if j = 0 then return "{}" ! 463: if Ref_(X,i + 1) then s ||:= "...," ! 464: s[-1] := "}" ! 465: return s ! 466: } ! 467: else return image(X) ! 468: end ! 469: ! 470: ! 471: procedure ImageW(X,i,r) # image of X to i values ! 472: local s, t, j ! 473: if S_(X) then { ! 474: /i := 5 ! 475: /r := 0 ! 476: if r >= i then return "{...}" ! 477: j := 0 ! 478: s := "{" ! 479: every t := (Gen_(X) \ i) do { ! 480: s ||:= write(ImageW(t,i,r +:= 1)) || "," ! 481: j +:= 1 ! 482: } ! 483: if j = 0 then return "{}" ! 484: if Ref_(X,i + 1) then s ||:= "...," ! 485: s[-1] := "}" ! 486: return s ! 487: } ! 488: else return image(X) ! 489: end ! 490: ! 491: procedure Index(X) # current size of X ! 492: if not S_(X) then return 1 ! 493: return *X.a ! 494: end ! 495: ! 496: procedure Last(X) # produce all values of X ! 497: if not S_(X) then return X ! 498: return X.a[Length(X)] ! 499: end ! 500: ! 501: procedure Length(X) # length of X ! 502: if not S_(X) then return 1 ! 503: while put(X.a,@X.e) ! 504: return *X.a ! 505: end ! 506: ! 507: procedure Next(X) # produce next value of X ! 508: local x ! 509: if not S_(X) then fail ! 510: if x := @X.e then { ! 511: put(X.a,x) ! 512: return x ! 513: } ! 514: end ! 515: ! 516: procedure Print(X,i) # write the image of a stream ! 517: Write(Image(X,i)) ! 518: return X ! 519: end ! 520: ! 521: procedure Read(f) # sequence from file f ! 522: return Sequence([],create read(!f)) ! 523: end ! 524: ! 525: procedure Red(X,op) # reduction of X over op ! 526: local S ! 527: ! 528: S := Seq_(X) ! 529: a := copy(S.a) ! 530: e := S.e ! 531: return Sequence([], create Red_(Sequence([], create !a | |@e),op)) ! 532: end ! 533: ! 534: procedure Run(X,i) # force computation of next i elements ! 535: ! 536: if not S_(X) then return X ! 537: every 1 to i do ! 538: put(X.a,@X.e) | fail ! 539: return X ! 540: end ! 541: ! 542: procedure Subseq(X,i,j) # subsequence of X from i to j ! 543: return Lim_(Shift_(X,i-1),j - i + 1) ! 544: end ! 545: ! 546: procedure Trace(X,i) # image of X, returning X ! 547: write(Image(X,i)) ! 548: return X ! 549: end ! 550: ! 551: procedure Write(X) # write elements in X with linefeeds ! 552: return Generic_(write,X) ! 553: end ! 554: ! 555: procedure Writes(X) # write elements in X without linefeeds ! 556: return Generic_(writes,X) ! 557: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.