home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / packs / skeem / skmisc.icn < prev    next >
Text File  |  2000-07-29  |  2KB  |  129 lines
  1. ############################################################################
  2. #
  3. #    Name:    skmisc.icn
  4. #
  5. #    Title:    Scheme in Icon
  6. #
  7. #    Author: Bob Alexander
  8. #
  9. #    Date:    March 23, 1995
  10. #
  11. #    Description: see skeem.icn
  12. #
  13. ############################################################################
  14.  
  15. #
  16. # skeem -- Scheme in Icon
  17. #
  18. # Various procedures:
  19. #
  20. #     Booleans
  21. #     Equivalence predicates
  22. #     Symbols
  23. #     System interface
  24. #
  25.  
  26. #
  27. # Initialize
  28. #
  29. # List entries are described in skfun.icn.
  30. #
  31. procedure InitMisc()
  32.    DefFunction([
  33.       BOOLEAN_P,
  34.       EQUAL_P,2,
  35.       EQV_P,2,
  36.       EQ_P,2,
  37.       LOAD,
  38.       NOT,
  39.       STRING_2_SYMBOL,
  40.       SYMBOL_2_STRING,
  41.       SYMBOL_P])
  42.    return
  43. end
  44.  
  45.  
  46. #
  47. # Booleans
  48. #
  49.  
  50. procedure NOT(bool)
  51.    return (F === bool,T) | F
  52. end
  53.  
  54. procedure BOOLEAN_P(x)
  55.    return (x === (T | F),T) | F
  56. end
  57.  
  58.  
  59. #
  60. # Equivalence predicates
  61. #
  62.  
  63. procedure EQV_P(x1,x2)
  64.    return (Eqv(x1,x2),T) | F
  65. end
  66.  
  67. procedure EQ_P(x1,x2)
  68.    return (x1 === x2,T) | F
  69. end
  70.  
  71. procedure EQUAL_P(x1,x2)
  72.    return (Equal(x1,x2),T) | F
  73. end
  74.  
  75. procedure Eqv(x1,x2)
  76.    local t1,t2
  77.    t1 := type(x1)
  78.    t2 := type(x2)
  79.    return {
  80.       if not (("integer" | "real") ~== (t1 | t2)) then x1 = x2
  81.       else if not ("Char" ~== (t1 | t2)) then x1.value == x2.value
  82.       else x1 === x2
  83.       }
  84. end
  85.  
  86. procedure Equal(x1,x2)
  87.    local t1,t2,i
  88.    return Eqv(x1,x2) | {
  89.       case (t1 := type(x1)) == (t2 := type(x2)) of {
  90.      "LLPair": Equal(LLFirst(x1),LLFirst(x2)) & Equal(LLRest(x1),LLRest(x2))
  91.      "list": {
  92.         not (every i := 1 to (*x1 == *x2) do
  93.            if not Equal(x1[i],x2[i]) then break)
  94.         }
  95.      "String": x1.value == x2.value
  96.      }
  97.       }
  98. end
  99.  
  100.  
  101. #
  102. # Symbols
  103. #
  104.  
  105. procedure SYMBOL_P(x)
  106.    return (SymbolP(x),T) | F
  107. end
  108.  
  109. procedure SYMBOL_2_STRING(sym)
  110.    return String(sym)
  111. end
  112.  
  113. procedure STRING_2_SYMBOL(s)
  114.    return s.value
  115. end
  116.  
  117.  
  118. #
  119. # System interface
  120. #
  121.  
  122. procedure LOAD(file)
  123.    local result,f
  124.    f := OpenFile(file,"r",LOAD) | fail
  125.    result := ReadEvalPrint(f,"quiet") | Failure
  126.    close(f)
  127.    return Failure ~=== result
  128. end
  129.