1 theory Calc

     2 imports Main

     3 begin

     4 

     5 

     6 section {* A Simple Calculator *}

     7 

     8 text {*

     9 

    10 Task: Write a calculator which behaves as follows:

    11 

    12   calc "ADD 1 2"   = 3

    13 

    14   calc "SUM 1 2 3"   = 6

    15 

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

    17 

    18 *}

    19 

    20 

    21 

    22 

    23 

    24 

    25 subsection {* A Parser Primer *}

    26 

    27 

    28 (*  'a -> 'b  *)

    29 

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

    31 

    32 

    33 

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

    35 

    36 

    37 

    38 (*  FAIL  *)

    39 

    40 (*  MORE  *)

    41 

    42 (*  ABORT *)

    43 

    44 

    45 

    46 

    47 

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

    49 

    50 

    51 

    52 ML {*

    53 datatype token =

    54   Keyword of string |

    55   Number of int |

    56   Variable of string |

    57   Space |

    58   End

    59 *}

    60 

    61 

    62 ML {* Scan.many1 *}

    63 ML {*

    64 val keyword = Scan.many1 Symbol.is_ascii_upper

    65 *}

    66 

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

    68 

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

    70 

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

    72 

    73 

    74 

    75 ML {*

    76 val keyword = Scan.many1 Symbol.is_ascii_upper >>

    77   (Keyword o implode)

    78 *}

    79 

    80 ML {* op >> *}

    81 

    82 

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

    84 

    85 

    86 

    87 ML {*

    88 val variable = Scan.many1 Symbol.is_ascii_lower >>

    89   (Variable o implode)

    90 

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

    92 *}

    93 

    94 

    95 

    96 ML {*

    97 fun int_of d = ord d - ord "0"

    98 

    99 fun join_digits ds =

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

   101 

   102 val number = Scan.many1 Symbol.is_ascii_digit >>

   103   (Number o join_digits)

   104 *}

   105 

   106 

   107 

   108 ML {*

   109 val tokens = Scan.bulk

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

   111 *}

   112 

   113 ML {* op || *}

   114 

   115 ML {* Scan.bulk *}

   116 

   117 

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

   119 

   120 

   121 

   122 ML {*

   123 fun lex str =

   124   explode str

   125   |> these o Scan.read Symbol.stopper tokens

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

   127 *}

   128 

   129 ML {* Scan.read *}

   130 

   131 

   132 ML {* lex "ADD 1 2" *}

   133 

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

   135 

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

   137 

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

   139 

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

   141 

   142 

   143 

   144 

   145 

   146 subsection {* Lexer: Error Handling *}

   147 

   148 ML {* Scan.!! *}

   149 

   150 

   151 ML {*

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

   153 

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

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

   156 

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

   158 *}

   159 

   160 

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

   162 

   163 ML {*

   164 let

   165   fun lex1 str =

   166     explode str

   167     |> Scan.read Symbol.stopper tokens

   168 in

   169   lex1 "ADD (ADD 1 2) 3"

   170 end

   171 *}

   172 ML {*

   173 let

   174   fun lex2 str =

   175     explode str

   176     |> tokens

   177 in

   178   lex2 "ADD 1 2"

   179 end

   180 *}

   181 

   182 

   183 

   184 ML {*

   185 fun lex str =

   186   Source.of_string str

   187   |> Source.source Symbol.stopper tokens NONE

   188   |> Source.exhaust

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

   190 *}

   191 

   192 ML {* lex "ADD 1 2" *}

   193 

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

   195 

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

   197 

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

   199 

   200 ML {* lex "Add 1 2" *}

   201 

   202 

   203 

   204 

   205 

   206 subsection {* Calculator: Basic Expressions *}

   207 

   208 

   209 

   210 ML {*

   211 fun keyword name = Scan.one

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

   213 *}

   214 

   215 ML {*

   216 val number = Scan.some

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

   218 *}

   219 

   220 ML {*

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

   222 *}

   223 

   224 ML {*

   225 fun expr st =

   226  (number ||

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

   228   keyword "SUM" |-- 

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

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

   231 *}

   232 

   233 ML {*

   234 val f1 = op  --

   235 val f2 = op |--

   236 val f3 = op  --|

   237 *}

   238 

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

   240 

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

   242 

   243 

   244 

   245 ML {*

   246 fun calc str = 

   247   lex str @ [End]

   248   |> expr --| stop

   249   |> fst

   250 *}

   251 

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

   253 

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

   255 

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

   257 

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

   259 

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

   261 

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

   263 

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

   265 

   266 

   267 

   268 

   269 

   270 subsection {* Calculator: Error Handling *}

   271 

   272 ML {*

   273 fun string_of_token (Keyword s) = s

   274   | string_of_token (Variable s) = s

   275   | string_of_token (Number n) = string_of_int n

   276   | string_of_token _ = "end"

   277 

   278 fun bad_token (xs, _) =

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

   280 

   281 fun calc str =

   282   lex str @ [End]

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

   284   |> fst

   285 *}

   286 

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

   288 

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

   290 

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

   292 

   293 

   294 

   295 ML {*

   296 fun append_token msg xs =

   297   msg ^ quote (string_of_token (hd xs))

   298 

   299 val expr' =

   300   expr ||

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

   302     "ADD, or SUM, instead of "))

   303 

   304 val stop' =

   305   stop ||

   306   Scan.fail_with (append_token "Unexpected token ")

   307 *}

   308 

   309 ML {*

   310 fun calc str =

   311   lex str @ [End]

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

   313   |> fst

   314 *}

   315 

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

   317 

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

   319 

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

   321 

   322 

   323 

   324 

   325 

   326 subsection {* Calculator: Expressions with Variables *}

   327 

   328 ML {*

   329 fun keyword name = Scan.lift (Scan.one

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

   331 

   332 fun number st = Scan.lift (Scan.some

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

   334 

   335 fun stop st = Scan.lift (Scan.one 

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

   337 *}

   338 

   339 ML {* Scan.lift *}

   340 

   341 

   342 

   343 ML {*

   344 val variable = Scan.some

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

   346 *}

   347 

   348 

   349 

   350 ML {*

   351 fun lookup env v =

   352   (case Symtab.lookup env v of

   353     SOME i => i

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

   355 *}

   356 

   357 

   358 

   359 ML {*

   360 fun expr st =

   361  (number ||

   362 

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

   364 

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

   366     keyword "IN" :|--

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

   368 

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

   370   keyword "SUM" |-- 

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

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

   373 *}

   374 

   375 ML {* Scan.peek *}

   376 

   377 ML {* op :|-- *}

   378 

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

   380 

   381 

   382 

   383 ML {*

   384 fun calc str =

   385   lex str @ [End]

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

   387   |> fst

   388 *}

   389 

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

   391 

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

   393 

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

   395 

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

   397 

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

   399 

   400 

   401 

   402 

   403 

   404 subsection {* Possible extensions *}

   405 

   406 text {*

   407 Errors with source positions:

   408 

   409   see Pure/General/source_pos.ML

   410 *}

   411 

   412 end