theory Calc

imports Main

begin

section {* A Simple Calculator *}

text {*

Task: Write a calculator which behaves as follows:

  calc "ADD 1 2"   = 3

  calc "SUM 1 2 3"   = 6

  cal "LET x 3 IN ADD x 1"   = 4

*}

subsection {* A Parser Primer *}

(*  'a -> 'b  *)

(*  'a -> 'b * 'c  *)

(*  string list -> 'a * string list  *)

(*  FAIL  *)

(*  MORE  *)

(*  ABORT *)

subsection {* Lexer: From a String to a Token List *}

ML {*

datatype token =

  Keyword of string |

  Number of int |

  Variable of string |

  Space |

  End

*}

ML {* Scan.many1 *}

ML {*

val keyword = Scan.many1 Symbol.is_ascii_upper

*}

ML {* keyword (explode "AND 1 2") *}

ML {* try keyword (explode "AND") *}

ML {* try keyword (explode " AND") *}

ML {*

val keyword = Scan.many1 Symbol.is_ascii_upper >>

  (Keyword o implode)

*}

ML {* op >> *}

ML {* keyword (explode "AND 1 2") *}

ML {*

val variable = Scan.many1 Symbol.is_ascii_lower >>

  (Variable o implode)

val space = Scan.many1 Symbol.is_ascii_blank >> K Space

*}

ML {*

fun int_of d = ord d - ord "0"

fun join_digits ds =

  fold (fn d => fn i => 10 * i + int_of d) ds 0

val number = Scan.many1 Symbol.is_ascii_digit >>

  (Number o join_digits)

*}

ML {*

val tokens = Scan.bulk

  (keyword || variable || number || space)

*}

ML {* op || *}

ML {* Scan.bulk *}

ML {* tokens (explode "ADD 1 2") *}

ML {*

fun lex str =

  explode str

  |> these o Scan.read Symbol.stopper tokens

  |> filter_out (fn Space => true | _ => false)

*}

ML {* Scan.read *}

ML {* lex "ADD 1 2" *}

ML {* lex "SUM 1 2 3" *}

ML {* lex "LET x 3 IN ADD x 1" *}

ML {* lex "ADD 1 (ADD 2 3)" *}

ML {* tokens (explode "ADD (ADD 1 2) 3") *}

subsection {* Lexer: Error Handling *}

ML {* Scan.!! *}

ML {*

val token = keyword || variable || number || space

fun bad_input s = "Unexpected symbol: " ^ quote s

fun lex_err (xs, _) = bad_input (hd xs)

val tokens = Scan.!! lex_err (Scan.bulk token)

*}

ML {* tokens (explode "ADD (ADD 1 2) 3") *}

ML {*

let

  fun lex1 str =

    explode str

    |> Scan.read Symbol.stopper tokens

in

  lex1 "ADD (ADD 1 2) 3"

end

*}

ML {*

let

  fun lex2 str =

    explode str

    |> tokens

in

  lex2 "ADD 1 2"

end

*}

ML {*

fun lex str =

  Source.of_string str

  |> Source.source Symbol.stopper tokens NONE

  |> Source.exhaust

  |> filter_out (fn Space => true | _ => false)

*}

ML {* lex "ADD 1 2" *}

ML {* lex "SUM 1 2 3" *}

ML {* lex "LET x 3 IN ADD x 1" *}

ML {* try lex "ADD 1 (ADD 2 3" *}

ML {* lex "Add 1 2" *}

subsection {* Calculator: Basic Expressions *}

ML {*

fun keyword name = Scan.one

  (fn Keyword n => n = name | _ => false)

*}

ML {*

val number = Scan.some

  (fn Number n => SOME n | _ => NONE)

*}

ML {*

val stop = Scan.one (fn t => t = End)

*}

ML {*

fun expr st =

 (number ||

  keyword "ADD" |-- expr -- expr >> (op +) ||

  keyword "SUM" |-- 

    Scan.unless stop (Scan.repeat expr) >>

      (fn is => fold (curry (op +)) is 0)) st

*}

ML {*

val f1 = op  --

val f2 = op |--

val f3 = op  --|

*}

ML {* expr (lex "ADD 1 2" @ [End]) *}

ML {* expr (lex "SUM 1 2 3" @ [End]) *}

ML {*

fun calc str = 

  lex str @ [End]

  |> expr --| stop

  |> fst

*}

ML {* calc "ADD 1 2" *}

ML {* calc "SUM 1 2 3" *}

ML {* calc "ADD 1 ADD 2 3" *}

ML {* calc "ADD 1 SUM 2 3 4" *}

ML {* calc "SUM ADD 1 2 3" *}

ML {* try calc "ADD SUM 1 2 3" *}

ML {* try calc "ADD 1 2 3" *}

subsection {* Calculator: Error Handling *}

ML {*

fun string_of_token (Keyword s) = s

  | string_of_token (Variable s) = s

  | string_of_token (Number n) = string_of_int n

  | string_of_token _ = "end"

fun bad_token (xs, _) =

  "Unexpected token: " ^ quote (string_of_token (hd xs))

fun calc str =

  lex str @ [End]

  |> Scan.error (expr --| Scan.!! bad_token stop)

  |> fst

*}

ML {* try calc "ADD 1 2 3" *}

ML {* try calc "ADD SUM 1 2 3" *}

ML {* try calc "Add 0 0" *}

ML {*

fun append_token msg xs =

  msg ^ quote (string_of_token (hd xs))

val expr' =

  expr ||

  Scan.fail_with (append_token ("Expected number, " ^

    "ADD, or SUM, instead of "))

val stop' =

  stop ||

  Scan.fail_with (append_token "Unexpected token ")

*}

ML {*

fun calc str =

  lex str @ [End]

  |> Scan.catch (expr' --| stop')

  |> fst

*}

ML {* try calc "ADD 0 0 1" *}

ML {* try calc "Add 0 0" *}

ML {* try calc "ADD SUM 1 2 3" *}

subsection {* Calculator: Expressions with Variables *}

ML {*

fun keyword name = Scan.lift (Scan.one

  (fn Keyword n => n = name | _ => false))

fun number st = Scan.lift (Scan.some

  (fn Number n => SOME n | _ => NONE)) st

fun stop st = Scan.lift (Scan.one 

  (fn t => t = End orelse t = Keyword "IN")) st

*}

ML {* Scan.lift *}

ML {*

val variable = Scan.some

  (fn Variable n => SOME n | _ => NONE)

*}

ML {*

fun lookup env v =

  (case Symtab.lookup env v of

    SOME i => i

  | _ => error ("Unbound variable " ^ quote v))

*}

ML {*

fun expr st =

 (number ||

  Scan.peek (fn env => variable >> lookup env) ||

  keyword "LET" |-- Scan.lift variable -- expr --|

    keyword "IN" :|--

      (fn b => apfst (Symtab.update b) #> expr) ||

  keyword "ADD" |-- expr -- expr >> (op +) ||

  keyword "SUM" |-- 

    Scan.unless stop (Scan.repeat expr) >>

      (fn is => fold (curry (op +)) is 0)) st

*}

ML {* Scan.peek *}

ML {* op :|-- *}

ML {* expr (Symtab.empty, lex "LET x 1 IN x") *}

ML {*

fun calc str =

  lex str @ [End]

  |> Scan.pass Symtab.empty (expr --| stop)

  |> fst

*}

ML {* calc "ADD 1 2" *}

ML {* calc "ADD 1 ADD 2 3" *}

ML {* calc "SUM 1 2 3" *}

ML {* calc "LET x 3 IN ADD x 1" *}

ML {* calc "LET x SUM 1 1 1 IN ADD x 7" *}

subsection {* Possible extensions *}

text {*

Errors with source positions:

  see Pure/General/source_pos.ML

*}

end