home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / SML⁄NJ 93+ / Documentation / examples / spread / parse.sml < prev    next >
Encoding:
Text File  |  1995-12-30  |  3.2 KB  |  108 lines  |  [TEXT/R*ch]
  1. functor Parse(F : FORMULA) : PARSE = 
  2. struct
  3.   open Array infix 9 sub
  4.  
  5.   structure F = F
  6.   
  7.   exception Syntax of string
  8.  
  9.   datatype token = NUMtok of int 
  10.          | ALPHAtok of string
  11.          | PUNCTtok of string 
  12.          | EOFtok
  13.  
  14.   fun for (i,j) f = if i<=j then (f i; for(i+1,j) f) else ()
  15.   fun forall (a::r) f = (f a; forall r f)
  16.     | forall nil f = ()
  17.  
  18.   datatype class = DIGIT | BLANK | ALPHA | PUNCT | OTHER | EOF
  19.   val class = array(257,OTHER)
  20.   val _ = 
  21.       (for (ord "0", ord "9") (fn s => update(class,s,DIGIT));
  22.        for (ord "a", ord "z") (fn s => update(class,s,ALPHA));
  23.        for (ord "A", ord "Z") (fn s => update(class,s,ALPHA));
  24.        forall [" ","\t","\n"] (fn s => update(class,(ord s),BLANK));
  25.        forall ["(",")","[","]",",","+","-","*","/"]
  26.            (fn s => update(class,(ord s),PUNCT));
  27.        update(class, 256, EOF))
  28.           
  29.   fun parse(str : string) : F.formula =
  30.     let fun gettoken pos = 
  31.         let fun char(p) = ordof(str,p) handle Ord => 256
  32.             fun digit(z,p) = 
  33.             let val c = char p
  34.              in case class sub c 
  35.              of DIGIT => digit(z*10+c-ord("0"), p+1)
  36.               | _ => (p, NUMtok z)
  37.             end
  38.         fun alpha(s,p) =
  39.             let val c = char p
  40.              in case class sub c 
  41.              of ALPHA => alpha(s,p+1)
  42.               | _ => (p, ALPHAtok(substring(str,s,p-s)))
  43.             end
  44.         val c = char pos
  45.          in case class sub c
  46.              of BLANK => gettoken(pos+1)
  47.           | ALPHA => alpha(pos,pos)
  48.           | DIGIT => digit(0,pos)
  49.           | PUNCT => (pos+1, PUNCTtok(chr c))
  50.           | EOF => (pos, EOFtok)
  51.           | _ => raise (Syntax "illegal character")
  52.         end
  53.  
  54.     fun atom (p, NUMtok n)  =  (gettoken p, F.NUM n)
  55.       | atom (p, PUNCTtok "[") =
  56.         (case exp(gettoken p)
  57.           of ((p1, PUNCTtok ","), e1) =>
  58.                (case exp(gettoken p1)
  59.                  of ((p2, PUNCTtok "]"), e2) =>
  60.                       (gettoken p2, F.CELLREF(e1,e2))
  61.                   | _ => raise (Syntax "] expected"))
  62.                | _ => raise (Syntax ", expected"))
  63.           | atom (p, PUNCTtok "(") =
  64.         (case exp(gettoken p)
  65.           of ((p1, PUNCTtok ")"), e1) => (gettoken p1, e1)
  66.                | _ => raise (Syntax ") expected"))
  67.       | atom _ = raise (Syntax "bogus atom")
  68.  
  69.     and term' ((p, PUNCTtok "*"), e1) = 
  70.         let val (s, e2) = atom(gettoken p)
  71.          in term'(s, F.BINOP(Integer.*, e1, e2))
  72.             end
  73.       | term' ((p, PUNCTtok "/"), e1) = 
  74.         let val (s, e2) = atom(gettoken p)
  75.          in term'(s, F.BINOP(Integer.div, e1, e2))
  76.             end
  77.       | term' x = x
  78.  
  79.         and term s = term' (atom s)
  80.  
  81.     and exp' ((p, PUNCTtok "+"), e1) = 
  82.         let val (s, e2) = term(gettoken p)
  83.          in exp'(s, F.BINOP(Integer.+, e1, e2))
  84.             end
  85.       | exp' ((p, PUNCTtok "-"), e1) = 
  86.         let val (s, e2) = term(gettoken p)
  87.          in exp'(s, F.BINOP(Integer.-, e1, e2))
  88.             end
  89.       | exp' x = x
  90.  
  91.     and exp (p, ALPHAtok "if") = 
  92.         (case exp(gettoken p)
  93.           of ((p',ALPHAtok "then"),e1) =>
  94.         (case exp(gettoken p')
  95.               of ((p'', ALPHAtok "else"),e2) =>
  96.              (case exp(gettoken p'')
  97.                of (s,e3) => (s, F.IF(e1,e2,e3)))
  98.            | _ => raise (Syntax "else expected"))
  99.                | _ => raise (Syntax "then expected"))
  100.       | exp s = exp' (term s)
  101.  
  102.      in case exp (gettoken 0)
  103.          of ( (_, EOFtok), e) => e
  104.           | _ => raise (Syntax "garbage at end of formula")
  105.     end
  106.  
  107. end
  108.