(* © Magne Haveraaen, 2000-01-24: Kan fritt brukes av registrerte deltakere på kurset I222. use "loop-2.sml"; *) (* Abstract syntax of Loop, Figure 2.1 *) (* very simple, direct translation *) datatype Letter = La | Lb | Lc | Ld | Le | Lf | Lg | Lh | Li | Lj | Lk | Ll | Lm | Ln | Lo | Lp | Lq | Lr | Ls | Lt | Lu | Lv | Lw | Lx | Ly | Lz ; datatype Ident = Id0 of Letter | Id1 of Ident * Letter; datatype Literal = L0 | L1 | L2 of Literal | L3 of Literal; datatype IExp = Constant of Literal | Variable of Ident | Sum of IExp * IExp | Prod of IExp * IExp; datatype BExp = Eql of IExp * IExp | Less of IExp * IExp | Not of BExp | And of BExp * BExp; datatype Imp = Skip | Put of IExp | Get of Ident | Asg of Ident * IExp | Seq of Imp * Imp | If of BExp * Imp * Imp | Loop of IExp * Imp; datatype Prog = Program of Imp; (* general help functions *) (* List processing *) val rec reverse = (* reverse a list = rev *) fn nil => nil | c::s => reverse s @ [c]; val rec foldp = (* folding a list ~ foldr *) fn f => fn e::nil => e | e::s => f (e, foldp f s) ; (* Tuple processing *) val fst = fn (a,b) => a; val snd = fn (a,b) => b; (* Iterating a function *) val rec iterate = fn 0 => (fn f => fn e => e) | n => (fn f => fn e => iterate (n-1) f (f e)); (* Syntax processing help functions *) (* Lexeme recognition *) val rec lexLiteral = (* extracts a Literal from s *) fn (lit, #"0"::s) => lexLiteral(lit^"0",s) | (lit, #"1"::s) => lexLiteral(lit^"1",s) | (lit, s) => (lit, s); val rec lexIdent = (* extracts an Ident from s *) fn (lit, c::s) => if (#"a" <= c) andalso (c <= #"z") then lexIdent (lit^ str c, s) else (lit, c::s) | (lit, s) => (lit, s); val rec lex = (* group characters into lexemes *) fn #" "::s => lex s | #":"::(#"="::s) => ":=":: lex s | #";"::s => ";":: lex s | #"("::s => "(":: lex s | #")"::s => ")":: lex s | #"+"::s => "+":: lex s | #"*"::s => "*":: lex s | #"="::s => "=":: lex s | #"<"::s => "<":: lex s | #"0"::s => let val (l,r) = lexLiteral ("0", s) in l:: lex r end | #"1"::s => let val (l,r) = lexLiteral ("1", s) in l:: lex r end | c::s => if #"a" <= c andalso c <= #"z" then let val (l,r) = lexIdent (str c, s) in l:: lex r end else "€":: lex s | nil => nil; (* Semantic help definitions *) (* Store *) type Store = Ident -> int; val h0 : Store = (* empty store: all 0's *) fn x => 0; val insert = (* insert/updates an identifier in the store *) fn h => fn (x, v) => fn y => if y = x then v else h y; (* IO *) type Input = int list; type Output = int list; (* State *) type State = Input * Store * Output; val store = (* extracts store from state *) fn (lin, h, lout) => h; val initstate = (* initial state from inputsequence I *) fn I => (I, h0, nil); val result = (* extracts output result from state *) fn (lin, h, lout) => lout; (* Semantics *) (* 2.4.1 Literals, fig. 2.5 *) val rec AA = fn L0 => 0 | L1 => 1 | L2 x => 2 * AA x | L3 x => 2 * AA x + 1; (* 2.4.2 Integer expressions, fig. 2.6 *) val rec VV = fn Constant lit => (fn h => AA lit) | Variable id => (fn h => h(id)) | Sum(e1, e2) => (fn h => ((VV e1 h) + (VV e2 h))) | Prod(e1, e2) => (fn h => ((VV e1 h) * (VV e2 h))); (* 2.4.3 Boolean expressions, fig. 2.7 *) val rec BB = fn Eql(e1, e2) => (fn h => ((VV e1 h) = (VV e2 h))) | Less(e1, e2) => (fn h => ((VV e1 h) < (VV e2 h))) | And(b1, b2) => (fn h => ((BB b1 h) andalso (BB b2 h))) | Not(b) => (fn h => (not (BB b h))); (* 2.4.4 Imperatives, fig. 2.8 *) val rec MM = fn Skip => (fn (inp,h,outp) => (inp,h,outp) ) | Put e => (fn (inp,h,outp) => (inp,h,outp@[VV e h]) ) | Get id => (fn (nil, h,outp) => (nil,insert h (id,0),outp) | (e::inp,h,outp) => (inp,insert h (id,e),outp) ) | Asg(id, e) => (fn (inp,h,outp) => (inp,insert h (id,VV e h),outp) ) | Seq(imp1, imp2) => (fn (inp,h,outp) => MM imp2 (MM imp1 (inp,h,outp)) ) | If(b, imp1, imp2) => (fn (inp,h,outp) => if BB b h then MM imp1 (inp,h,outp) else MM imp2 (inp,h,outp) ) | Loop(e, imp) => (fn (inp,h,outp) => iterate (VV e h) (MM imp) (inp,h,outp) ); (* 2.4.5 Programs, fig. 2.9 *) val PP = fn Program imp => (fn inp => result(MM imp (inp,h0,nil))); (* Parse *) (* Each of the parseXxx routines take a list of strings (as produed by lex) as input, and returns a pair: the production and the remainder of the input *) (* This is a recursive decent parser *) val makeLetter = fn #"a" => La | #"b" => Lb | #"c" => Lc | #"d" => Ld | #"e" => Le | #"f" => Lf | #"g" => Lg | #"h" => Lh | #"i" => Li | #"j" => Lj | #"k" => Lk | #"l" => Ll | #"m" => Lm | #"n" => Ln | #"o" => Lo | #"p" => Lp | #"q" => Lq | #"r" => Lr | #"s" => Ls | #"t" => Lt | #"u" => Lu | #"v" => Lv | #"w" => Lw | #"x" => Lx | #"y" => Ly | #"z" => Lz ; val rec makeIdent = fn c :: nil => Id0 (makeLetter c) | c :: s => Id1 (makeIdent s, makeLetter c); val ParseIdentifier = fn ident::s => (makeIdent (rev(explode ident)),s); val rec makeLiteral = fn #"0" :: nil => L0 | #"1" :: nil => L1 | #"0" :: s => L2 (makeLiteral s) | #"1" :: s => L3 (makeLiteral s); val ParseLiteral = fn lit::s => (makeLiteral (rev(explode lit)),s); val rec makeIExp = fn "(" :: s => let val rec makeIExpPair = fn "(" :: s => let val (e1, oper, (e2, ")":: re)) = let val (e, oper::r) = makeIExp s in (e, oper, makeIExp r) end in if oper = "+" then (Sum(e1,e2), re) else (* if oper = "*" then *) (Prod(e1,e2), re) end; in makeIExpPair ( "(" :: s ) end | c :: s => if hd (explode c) = #"0" orelse hd (explode c) = #"1" then let val (v,r) = ParseLiteral (c::s) in (Constant v,r) end else let val (v,r) = ParseIdentifier (c::s) in (Variable v,r) end; val ParseIExp = fn s => makeIExp s; val rec makeBExp = fn "(" :: ("not" :: s) => (* Not *) let val (b,")"::r) = makeBExp s in (Not b, r) end | "(" :: ("(" :: s) => (* And *) let val (b1, (b2, ")":: re)) = let val (b, "and"::r) = makeBExp ("(" :: s) in (b, makeBExp r) end in (And (b1,b2), re) end | "(" :: (c :: s) => (* Eql, Less *) let val (e1, oper, (e2, ")":: re)) = let val (e, oper::r) = makeIExp (c :: s) in (e, oper, makeIExp r) end in (if oper = "=" then Eql(e1,e2) else Less(e1,e2) , re ) end; val ParseBExp = fn s => makeBExp s; val makeSeq = fn s => foldp Seq s; val rec seqImp = fn makeImp => fn (imp, ";" :: s) => let val (imps,r) = seqImp makeImp (makeImp s); in (imp::imps,r) end | (imp, s) => (imp::nil, s); val rec makeImp = fn "skip" :: s => (Skip,s) | "put" :: s => let val (e,r)=ParseIExp s in (Put e,r) end | "get" :: (c::s) => (Get (fst(ParseIdentifier (c::nil))),s) | "if" :: s => let val (b,"then"::r1) = ParseBExp s; val (ss1,"else"::r2) = seqImp makeImp (makeImp r1); val s1 = makeSeq ss1; val (ss2,"fi"::r3) = seqImp makeImp (makeImp r2); val s2 = makeSeq ss2; in (If (b,s1,s2), r3) end | "loop" :: s => let val (e,"times"::r1) = ParseIExp s; val (ss1,"endloop"::r2) = seqImp makeImp (makeImp r1); val s1 = makeSeq ss1; in (Loop (e,s1),r2) end | c :: (":=" :: s) => let val (e,r) = ParseIExp s; in (Asg (fst (ParseIdentifier (c::nil)),e), r) end; val parseImp = fn s => let val (ss, r) = seqImp makeImp (makeImp s); in (makeSeq ss, r) end; val parseProg = fn "begin" :: s => let val (imp, "end"::r) = parseImp s in (Program imp,r) end; val Parse = fn s => let val (prog, nil) = parseProg (lex (explode s)); in prog end; (* Unparsing *) (* Unparsing the productions *) val UnparseLetter = fn La => "a" | Lb => "b" | Lc => "c" | Ld => "d" | Le => "e" | Lf => "f" | Lg => "g" | Lh => "h" | Li => "i" | Lj => "j" | Lk => "k" | Ll => "l" | Lm => "m" | Ln => "n" | Lo => "o" | Lp => "p" | Lq => "q" | Lr => "r" | Ls => "s" | Lt => "t" | Lu => "u" | Lv => "v" | Lw => "w" | Lx => "x" | Ly => "y" | Lz => "z" ; val rec UnparseIdentifier = fn Id0 x => UnparseLetter x | Id1 (x, l) => UnparseIdentifier x ^ UnparseLetter l; val rec UnparseLiteral = fn L0 => "0" | L1 => "1" | L2 x => UnparseLiteral x ^ "0" | L3 x => UnparseLiteral x ^ "1"; val rec UnparseIExp = fn Constant lit => UnparseLiteral lit | Variable id => UnparseIdentifier id | Sum (e1, e2) => "("^ UnparseIExp(e1) ^" + "^ UnparseIExp(e2) ^")" | Prod(e1, e2) => "("^ UnparseIExp(e1) ^ "*" ^ UnparseIExp(e2) ^")"; val rec UnparseBExp = fn Eql (e1,e2) => "("^ UnparseIExp(e1) ^" = "^ UnparseIExp(e2) ^")" | Less (e1,e2) => "("^ UnparseIExp(e1) ^" < "^ UnparseIExp(e2) ^")" | Not e => "("^ " not "^ UnparseBExp(e) ^")" | And (e1,e2) => "("^UnparseBExp(e1) ^" and "^UnparseBExp(e2)^")"; val rec UnparseImp = fn Skip => "skip" | Put e => "put " ^ UnparseIExp e | Get i => "get " ^ UnparseIdentifier i | Asg (i,e) => (UnparseIdentifier i) ^" := "^ UnparseIExp e | Seq (s1,s2) => UnparseImp s1 ^ "; " ^ UnparseImp s2 | If (b,s1,s2) => "if " ^ UnparseBExp b ^ " then " ^ UnparseImp s1 ^ " else " ^ UnparseImp s2 ^ " fi" | Loop (e,s) => "loop "^ UnparseIExp e ^" times "^ UnparseImp s ^" endloop"; val UnparseProg = fn Program s => "begin "^ UnparseImp s ^" end"; val Unparse = UnparseProg; (* Example code fragments *) val xx = Id1 (Id0 Lx, Lx); val xyz = Id1(Id1 (Id0 Lx, Ly), Lz); val vxx = Variable xx; val l5 = L3 (L2 L1); val l10 = L2 (L3 (L2 L1)); val c5 = Constant l5; val c10 = Constant l10; val exxs10 = Sum (vxx, c10); val exxp5 = Prod (vxx, c5); val exxpr = Prod(exxs10, Sum(c5, exxp5)); (* Example program text *) val prog_2_2_s1 = "get xx"; val prog_2_2_s2 = "loop xx times get q ; y:=(y+q) endloop"; val prog_2_2_s3 = "put y"; val prog_2_2_ss = prog_2_2_s1 ^";"^ prog_2_2_s2 ^";"^ prog_2_2_s3 ; val prog_2_2 = "begin "^prog_2_2_ss^ " end"; (* Check *) val normalform_prog_2_2 = Unparse (Parse (prog_2_2)); normalform_prog_2_2 = Unparse (Parse (normalform_prog_2_2)); val Prog_2 = PP (Parse prog_2_2); (* val it = true : bool *) Prog_2 [3,4,5,2]; (* val it = [11] : int list *) Prog_2 [0,1,2,2,3,33,4]; (* val it = [0] : int list *) Prog_2 [3,1,2,2,3,33,4]; (* val it = [5] : int list *) Prog_2 [33,1,2,2,3,33,4]; (* val it = [45] : int list *) (* Exercises *) val Prog_2_6_2a = PP (Parse "begin put (10+10) end"); Prog_2_6_2a nil; (* val it = [4] : int list *) val Prog_2_6_2b = PP (Parse "begin get x; get y; put (x+y) end"); Prog_2_6_2b [2,3]; (* val it = [5] : int list *) val prog_2_6_3_s1 = "get n"; val prog_2_6_3_s2 = "f := 1; i:= 0"; val prog_2_6_3_s3 = "loop n times i := (i+1); f := (f*i) endloop"; val prog_2_6_3_s4 = "put f"; val prog_2_6_3 = "begin " ^ prog_2_6_3_s1 ^ "; " ^ prog_2_6_3_s2 ^ "; " ^ prog_2_6_3_s3 ^ "; " ^ prog_2_6_3_s4 ^ " end"; val Prog_2_6_3 = PP (Parse prog_2_6_3); Prog_2_6_3 [3]; (* val it = [6] : int list *) Prog_2_6_3 [0]; (* val it = [1] : int list *) Prog_2_6_3 [10]; (* val it = [3628800] : int list *) Prog_2_6_3[12]; (* val it = [479001600] : int list *) Prog_2_6_3[13]; (* *) (* uncaught exception overflow *) (* raised at: *)