--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Nominal/activities/tphols09/IDW/SB-Calc.thy Wed Mar 30 17:27:34 2016 +0100
@@ -0,0 +1,412 @@
+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
\ No newline at end of file