home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / IO / lfstint.gs < prev   
Text File  |  1994-06-23  |  3KB  |  105 lines
  1. -- Here is a version of the interpreter with lazy stream output that
  2. -- is described in the extended version of:
  3. --
  4. --   `Lazy Functional State Threads'
  5. --   John Launchbury and Simon Peyton Jones
  6. --   (short version is in PLDI '94).
  7. --
  8. -- This program requires array.gs, iomonad.gs, and ioarray.gs to run.
  9. -- For example, in the demos/IO directory, try:
  10. --
  11. --   :load ../../array.gs ../../iomonad.gs ../../ioarray.gs lfstint.gs
  12. --
  13.  
  14. data Com = Assign Var Exp | Read Var | Write Exp | While Exp [Com]
  15. type Var = Char
  16. data Exp = Variable Var | Const Int | Plus Exp Exp | Eq Exp Exp | Le Exp Exp
  17.  
  18. interpret :: [Com] -> [Int] -> [Int]
  19. interpret cs input = runST (newArr ('a', 'z') 0 `thenST` \store ->
  20.                             newVar input        `thenST` \inp   ->
  21.                             command cs store inp)
  22.  
  23. type Store s = MutArr s Var
  24.  
  25. command :: [Com] -> Store s Int -> MutVar s [Int] -> ST s [Int]
  26. command cs store inp = obey cs
  27.  where
  28.   -- obey :: [Com] -> ST s [Int]
  29.   obey []                = returnST []
  30.   obey (Assign v e : cs) = eval e              `thenST` \a ->
  31.                            writeArr store v a  `thenST_`
  32.                            obey cs
  33.   obey (Read v     : cs) = readVar inp         `thenST` \(x:xs) ->
  34.                            writeArr store v x  `thenST_`
  35.                            writeVar inp xs     `thenST_`
  36.                            obey cs
  37.   obey (Write e    : cs) = eval e              `thenST` \out ->
  38.                            obey cs             `thenST` \outs ->
  39.                            returnST (out:outs)
  40.   obey (While e bs : cs) = eval e              `thenST` \val ->
  41.                            if val==0 then
  42.                               obey cs
  43.                            else
  44.                               obey (bs ++ While e bs : cs)
  45.  
  46.   -- eval :: Exp -> ST s Int
  47.   eval (Variable v) = readArr store v
  48.   eval (Const n)    = returnST n
  49.   eval (Plus l r)   = binary (+) l r
  50.   eval (Eq l r)     = binary (\x y -> if x==y then 1 else 0) l r
  51.   eval (Le l r)     = binary (\x y -> if x<=y then 1 else 0) l r
  52.  
  53.   binary f l r      = eval l                   `thenST` \l' ->
  54.                       eval r                   `thenST` \r' ->
  55.                       returnST (f l' r')
  56.  
  57. -- Some sample programs:
  58.  
  59. prog1 = [ Write (Const 1),
  60.           While (Const 1) [],
  61.           Write (Const 2) ]
  62.  
  63. prog2 = [ Assign 'a' (Const 1),
  64.           While (Le (Variable 'a') (Const 10))
  65.              [ Write (Variable 'a'),
  66.                Assign 'a' (Plus (Variable 'a') (Const 1))
  67.              ]
  68.         ]
  69.  
  70. prog3 = [ Assign 'a' (Const 0),
  71.           While (Const 1)
  72.              [ Write (Variable 'a'),
  73.                Assign 'a' (Plus (Variable 'a') (Const 1))
  74.              ]
  75.         ]
  76.  
  77. prog4 = [ While (Const 1)
  78.              [ Read 'a',
  79.                Write (Plus (Variable 'a') (Const 1))
  80.              ]
  81.         ]
  82.  
  83. prog5 = [ Read 'a',
  84.           While (Variable 'a')
  85.              [ Write (Plus (Variable 'a') (Const 1)),
  86.                Read 'a'
  87.              ]
  88.         ]
  89.  
  90. prog6 = [ Assign 't' (Const 0),
  91.           Assign 'n' (Const 0),
  92.           Read 'a',
  93.           While (Variable 'a')
  94.              [ Assign 't' (Plus (Variable 't') (Variable 'a')),
  95.                Assign 'n' (Plus (Variable 'n') (Const 1)),
  96.                Read 'a'
  97.              ],
  98.           Write (Variable 't'),
  99.           Write (Variable 'n')
  100.         ]
  101.  
  102. test = interpret prog6 ([1..10] ++ [0])
  103.  
  104. ------------------------------------------------------------------------------
  105.