Return to parse.sml CVS log

Up to [Research Unix] / researchv10dc / cmd / sml / doc / examples / spread

Annotation of researchv10dc/cmd/sml/doc/examples/spread/parse.sml, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.