Pcomp'08 Problem M (... 4 years later)

m.sml

structure M =
struct
    open MParser

    fun pp (Int i) = Int.toString i
      | pp (Var n) = n
    and plist [h] = pp h
      | plist t = String.concatWith ":" (map pp t)

    fun put e k (v : exp list) = (k,v) :: e
    fun get e k = case List.find (fn (k',v) => k = k') e of SOME (k,v) => v

    fun calc Plus n m = (Int (n+m))
      | calc Minus n m = (Int (n-m))
      | calc Times n m = (Int (n*m))
      | calc Divide n m = (Int (n div m))
   
    fun eval1 env ((Var n)::t) = (get env n) @ t
      | eval1 env ((UOpr (opr,[]))::t) = t
      | eval1 env ((UOpr (opr,[Int i]))::t) = (Int i) :: t
      | eval1 env ((UOpr (opr,(Int i)::(Int j)::t))::t') = (UOpr (opr,(calc opr i j)::t)) :: t'
      | eval1 env ((UOpr (opr,(Int i)::t)::t')) = (UOpr (opr,(Int i)::(eval1 env t))) :: t'
      | eval1 env ((UOpr (opr,l))::t) = (UOpr (opr, eval1 env l)) :: t
      | eval1 env ((BOpr ([],opr,[]))::t) = t
      | eval1 env ((BOpr ([Int i],opr,[Int j]))::t) = (calc opr i j) :: t
      | eval1 env ((BOpr ((Int i)::t1,opr,[Int j]))::t) = (calc opr i j) :: (BOpr (t1,opr,[Int j])) :: t
      | eval1 env ((BOpr ([Int i],opr,(Int j)::t2))::t) = (calc opr i j) :: (BOpr ([Int i],opr,t2)) :: t
      | eval1 env ((BOpr ((Int i)::t1,opr,(Int j)::t2))::t) = (calc opr i j) :: (BOpr (t1,opr,t2)) :: t
      | eval1 env ((BOpr (t1,opr,t2))::t) = (BOpr (eval1 env t1,opr,eval1 env t2)) :: t
      | eval1 env ((Slice (e,NONE,SOME j))::t) = takeUntil env j e @ t
      | eval1 env ((Slice (e,SOME i,NONE))::t) = drop env i e @ t
      | eval1 env ((Slice (e,SOME i,SOME j))::t) = (drop env i (takeUntil env j e)) @ t
      | eval1 env x = x

    and takeUntil env _ [] = []
      | takeUntil env 0 _ = []
      | takeUntil env n ((Int i)::t) = (Int i) :: (takeUntil env (n-1) t)
      | takeUntil env n e = takeUntil env n (eval1 env e)
    
    and drop env _ [] = [] : exp list
      | drop env 0 l = l
      | drop env n ((Int i)::t) = drop env (n-1) t
      | drop env n l = drop env n (eval1 env l)

    and evalstm env (Print e) = (print (plist (takeUntil env 15 e) ^ "\n"); env)
      | evalstm env (Assign (n,e)) = put env n e

    fun main env =
        case TextIO.inputLine TextIO.stdIn of
             NONE => []
           | SOME "#\n" => []
           | SOME l => main (evalstm env (kupeg_start l))
end
val _ = M.main []

mparse.peg

%name MParser
%start stm
datatype opr = Times | Divide | Plus | Minus
datatype exp = Print of exp list
             | UOpr of opr * exp list
             | BOpr of exp list * opr * exp list
             | Slice of exp list * int option * int option
             | Assign of string * exp list
             | Int of int
             | Var of string

%nonterm sp of string
%nonterm _ of string
%nonterm res of string
%nonterm name of string
%nonterm res of string
%nonterm num of int
%nonterm lexp of exp list
%nonterm exp of exp list
%nonterm term of exp list
%nonterm slice of exp list
%nonterm sliceexp of (int option * int option)
%nonterm factor of exp list
%nonterm stm of exp

%%
sp <- " " / "\n" / "\t".
_  <- sp _ / .

res     <- "+" / "-" / "/" / "*" / "(" / ")" / "[" / "]" / ":" / "=".

name    <- !res !sp !digit char.

num     <- !res !sp d:digit e:((!res !sp digit)*) -> (valOf(Int.fromString (String.concat ($d :: ($e))))).

lexp    <- e:exp _":"_ l:lexp -> (($e) @ ($l))
         / e:exp -> ($e).

exp     <- t:term _"+"_ e:lexp -> ([BOpr ($t,Plus,$e)])
         / t:term _"-"_ e:lexp -> ([BOpr ($t,Minus,$e)])
         / t:term -> ($t).

term    <- f:slice _"*"_ e:lexp -> ([BOpr ($f,Times,$e)])
         / f:slice _"/"_ e:lexp -> ([BOpr ($f,Divide,$e)])
         / slice.

slice   <- f:factor _"["_ s:sliceexp _"]" -> ((fn (a,b) => [Slice($f,a,b)]) ($s))
         / factor.

sliceexp <- n1:num _":"_ n2:num ->  ((SOME ($n1), SOME($n2)))
         / ":"_ n2: num        ->  ((NONE, SOME($n2)))
         / n1:num _":"         ->  ((SOME ($n1),NONE)).

factor  <- _"("_ e:lexp _")"_ ->    ($e)
         / n:num             ->    ([Int($n)])
         / n:name            ->    ([Var($n)])
         / _"+"_ e:lexp       ->    ([UOpr(Plus,$e)])
         / _"-"_ e:lexp       ->    ([UOpr(Minus,$e)])
         / _"*"_ e:lexp       ->    ([UOpr(Times,$e)])
         / _"/"_ e:lexp       ->    ([UOpr(Divide,$e)]).

stm     <- "print" _ e:lexp -> (Print ($e))
         / n:name _ "=" _ e:lexp -> (Assign ($n,$e)).