├── .gitignore ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── Makefile ├── README.md ├── _CoqProject ├── test-suite ├── Makefile ├── TestPrintf.v ├── TestScanf.v ├── _CoqProject └── demo.v └── theories ├── Digits.v ├── Flags.v ├── Format.v ├── FormatNotations.v ├── FormatParser.v ├── Justify.v ├── Printf.v └── Scanf.v /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.vo 3 | *.glob 4 | *.aux 5 | Makefile.coq 6 | Makefile.coq.conf 7 | .coqdeps.d 8 | .Makefile.coq.d 9 | .envrc 10 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Next 2 | 3 | - Add notations for format strings (`Format.t`) 4 | - `sprintf` and `sscanf` now take a format string of type `Format.t` instead of `string` 5 | - No longer compatible with 8.8 and 8.9 6 | 7 | # 1.0.1 8 | 9 | - Add `sscanf` 10 | - Compatibility with Coq 8.8, 8.10, 8.11 11 | 12 | # 1.0.0 13 | 14 | - Release on OPAM 15 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | All contributions welcome including bug reports, feature requests, and pull requests. 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Gregory Malecha 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: Makefile.coq 2 | $(MAKE) -f Makefile.coq 3 | 4 | test: all 5 | $(MAKE) -C test-suite 6 | 7 | install: all 8 | $(MAKE) -f Makefile.coq install 9 | 10 | Makefile.coq: _CoqProject 11 | coq_makefile -f _CoqProject -o Makefile.coq 12 | 13 | clean: Makefile.coq 14 | $(MAKE) -C test-suite clean 15 | $(MAKE) -f Makefile.coq cleanall 16 | rm -f Makefile.coq 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cop-printf 2 | 3 | Implementation of `sprintf` and `sscanf` for Coq 4 | 5 | ## Example 6 | 7 | ```Coq 8 | Require Import Coq.Strings.String. 9 | Require Import Printf.Printf. 10 | Require Import Printf.Scanf. 11 | 12 | Eval compute in (sprintf "%b" 1234). 13 | (* "10011010010" : string *) 14 | 15 | Eval compute in (sscanf "%d %d" (fun n1 n2 s => Some (n1, n2, s)) "12 34 56"). 16 | (* Some (12, 34, " 56") : option (nat * nat * string) *) 17 | ``` 18 | 19 | ## Summary 20 | 21 | `sprintf` expects a format string as its first argument, plus one argument 22 | for every format specifier (`%d`, `%s`, etc.) in that string (there may be 23 | none), and produces a `string`. 24 | 25 | `sscanf` expects a format string as its first argument, a continuation 26 | as its second argument, and a string to parse as its third argument. 27 | The continuation takes one argument for every format specifier in the format 28 | string, plus one more for the remaining string after reaching the end of the 29 | format string, and produces an `option` result. 30 | 31 | ```Coq 32 | sprintf "%d %d" : nat -> nat -> string 33 | sscanf "%d %d" : (nat -> nat -> string -> option R) -> string -> option R 34 | (* For any type R *) 35 | ``` 36 | 37 | ## Format specifiers 38 | 39 | The syntax of format specifiers is given by this regular expression: 40 | 41 | ``` 42 | %(-|+| |#|0)^* (\d+) (N?) (s|c|b|o|d|x|X|Zd) 43 | ``` 44 | 45 | which corresponds to this structure: 46 | 47 | ``` 48 | %[flags] [width] [type] specifier 49 | ``` 50 | 51 | ## Flags 52 | 53 | | Flags | Description | 54 | |-------|-----------------------------------------------------------------------------| 55 | | `-` | Left justify | 56 | | `+` | Precede nonnegative numbers with a plus sign (only for `nat`, `N`, `Z`) | 57 | | *(space)* | Space if no sign precedes | 58 | | `#` | With specifier `o`, `x`, `X`, precede with `0`, `0x`, `0X` respectively for values different than zero | 59 | | `0` | Pad with 0's instead of space | 60 | 61 | These flags are ignored by `sscanf`. 62 | 63 | ## Width 64 | 65 | The width modifier `(\d+)` gives: 66 | 67 | - for `sprintf`, the minimum number of characters to be printed (this enables padding); 68 | - for `sscanf`, the maximum number of characters to be read for this specifier. 69 | 70 | ## Type 71 | 72 | The type modifier `(N?)` affects the specifiers `b`, `o`, `d`, `x`, `X` to use the 73 | type `N` instead of the default `nat`. 74 | 75 | ## Specifiers 76 | 77 | | Specifier | Description | Types | 78 | |-----------|------------------------|------------| 79 | | `s` | string | `string` | 80 | | `c` | character | `ascii` | 81 | | `b` | binary | `nat`, `N` | 82 | | `o` | octal | `nat`, `N` | 83 | | `d` | decimal | `nat`, `N` | 84 | | `x` | hexadecimal lower case | `nat`, `N` | 85 | | `X` | hexadecimal upper case | `nat`, `N` | 86 | | `Zd` | signed decimal | `Z` | 87 | 88 | The special sequence `%%` encodes a literal `%`. 89 | 90 | When used with `scanf`, a whitespace character in a format string will match 91 | any number of consecutive whitespace characters. 92 | 93 | ## Resources 94 | 95 | Reference: http://www.cplusplus.com/reference/cstdio/printf 96 | 97 | ## Project structure 98 | 99 | Under `theories/`. 100 | 101 | ### External modules 102 | 103 | - `FormatNotations.v`: Notations for format strings 104 | - `Printf.v` 105 | - `Scanf.v` 106 | 107 | ### Internal modules 108 | 109 | - `Digits.v`: Print numbers as strings 110 | - `Flags.v`: Definition of flags 111 | - `Justify.v`: Justification and padding 112 | - `Format.v`: Definition of format strings 113 | - `FormatParser.v`: Parse and print format string notation 114 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q theories Printf 2 | 3 | theories/Flags.v 4 | theories/Digits.v 5 | theories/Format.v 6 | theories/FormatParser.v 7 | theories/FormatNotations.v 8 | theories/Justify.v 9 | theories/Printf.v 10 | theories/Scanf.v 11 | -------------------------------------------------------------------------------- /test-suite/Makefile: -------------------------------------------------------------------------------- 1 | all: Makefile.coq 2 | $(MAKE) -f Makefile.coq 3 | 4 | Makefile.coq: _CoqProject 5 | coq_makefile -f _CoqProject -o Makefile.coq 6 | 7 | clean: 8 | if [ -e Makefile.coq ] ; then $(MAKE) -f Makefile.coq cleanall ; fi 9 | rm -f Makefile.coq 10 | -------------------------------------------------------------------------------- /test-suite/TestPrintf.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Strings.Ascii. 2 | Require Import Coq.Strings.String. 3 | Require Import Coq.NArith.NArith. 4 | Require Import Coq.ZArith.ZArith. 5 | Require Import Printf.Digits. 6 | Require Import Printf.Printf. 7 | 8 | Local Open Scope string_scope. 9 | 10 | Example test_hex_1234: (hex_string 1234) = "4d2". 11 | Proof. 12 | unfold hex_string. 13 | reflexivity. 14 | Qed. 15 | 16 | Example test_4: (hex_string 4) = "4". 17 | Proof. 18 | unfold hex_string. 19 | reflexivity. 20 | Qed. 21 | 22 | Example test_1234_hex_upper: (hex_string_upper 1234) = "4D2". 23 | Proof. 24 | unfold hex_string. 25 | reflexivity. 26 | Qed. 27 | 28 | Example test_1234_octal: (octal_string 1234) = "2322". 29 | Proof. 30 | unfold hex_string. 31 | reflexivity. 32 | Qed. 33 | 34 | Goal sprintf "Hello, %s!" "world" = "Hello, world!". 35 | Proof. 36 | reflexivity. 37 | Qed. 38 | 39 | Goal sprintf "%d, %d, %d, ..." 1 2 3 = "1, 2, 3, ...". 40 | Proof. 41 | reflexivity. 42 | Qed. 43 | 44 | Goal sprintf "%d%%" 100 = "100%". 45 | Proof. 46 | reflexivity. 47 | Qed. 48 | 49 | Goal sprintf "%c" "x"%char = "x". 50 | Proof. 51 | reflexivity. 52 | Qed. 53 | 54 | Goal sprintf "%o" 1234 = "2322". 55 | Proof. 56 | reflexivity. 57 | Qed. 58 | 59 | Goal sprintf "%x" 1234 = "4d2". 60 | Proof. 61 | reflexivity. 62 | Qed. 63 | 64 | Goal sprintf "%X" 1234 = "4D2". 65 | Proof. 66 | reflexivity. 67 | Qed. 68 | 69 | Goal sprintf "%b" 1234 = "10011010010". 70 | Proof. 71 | reflexivity. 72 | Qed. 73 | 74 | Goal sprintf "%Nd" 1234%N = "1234". 75 | Proof. 76 | reflexivity. 77 | Qed. 78 | 79 | Goal sprintf "%NX" 1234%N = "4D2". 80 | Proof. 81 | reflexivity. 82 | Qed. 83 | 84 | Goal sprintf "%Nx" 1234%N = "4d2". 85 | Proof. 86 | reflexivity. 87 | Qed. 88 | 89 | Goal sprintf "%Zd" 1234%Z = "1234". 90 | Proof. 91 | reflexivity. 92 | Qed. 93 | 94 | Goal sprintf "%Zd" (-1234)%Z = "-1234". 95 | Proof. 96 | reflexivity. 97 | Qed. 98 | 99 | Goal sprintf "%+Zd" 1234%Z = "+1234". 100 | Proof. 101 | reflexivity. 102 | Qed. 103 | 104 | Goal (sprintf "%o, %x, %X, %b, ..." 1234 1234 1234 1234) = "2322, 4d2, 4D2, 10011010010, ...". 105 | Proof. 106 | reflexivity. 107 | Qed. 108 | 109 | Goal (sprintf "%4X" 1234) = " 4D2". 110 | Proof. 111 | reflexivity. 112 | Qed. 113 | 114 | Goal (sprintf "%05X" 1234) = "004D2". 115 | Proof. 116 | reflexivity. 117 | Qed. 118 | 119 | Goal sprintf "%-4X" 1234 = "4D2 ". 120 | Proof. 121 | reflexivity. 122 | Qed. 123 | 124 | Goal sprintf "%-05X" 1234 = "4D200". 125 | Proof. 126 | reflexivity. 127 | Qed. 128 | 129 | Goal sprintf "% d" 1234 = " 1234". 130 | Proof. 131 | reflexivity. 132 | Qed. 133 | 134 | Goal sprintf "%+d" 1234 = "+1234". 135 | Proof. 136 | reflexivity. 137 | Qed. 138 | 139 | Goal sprintf "%-#05X" 1234 = "0X4D2". 140 | Proof. 141 | reflexivity. 142 | Qed. 143 | 144 | Goal sprintf "%-#05X" 0 = "00000". 145 | Proof. 146 | reflexivity. 147 | Qed. 148 | 149 | Goal sprintf "%-#05x" 1234 = "0x4d2". 150 | Proof. 151 | reflexivity. 152 | Qed. 153 | -------------------------------------------------------------------------------- /test-suite/TestScanf.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Strings.Ascii. 2 | Require Import Coq.Strings.String. 3 | Require Import Coq.NArith.NArith. 4 | Require Import Coq.ZArith.ZArith. 5 | Require Import Printf.Scanf. 6 | 7 | Local Open Scope string_scope. 8 | 9 | Definition ret {A B : Type} (a : A) (_ : B) : option A := Some a. 10 | 11 | Goal sscanf "Hello, %s" ret "Hello, world!" = Some "world!". 12 | Proof. 13 | reflexivity. 14 | Qed. 15 | 16 | Goal sscanf "%d, %d, %d, ..." (fun a b c _ => Some (a, b, c)) "1, 2, 3, ..." 17 | = Some (1, 2, 3). 18 | Proof. 19 | reflexivity. 20 | Qed. 21 | 22 | Goal sscanf "%d%%" ret "100%" = Some 100. 23 | Proof. 24 | reflexivity. 25 | Qed. 26 | 27 | Goal sscanf "%c" ret "x" = Some "x"%char. 28 | Proof. 29 | reflexivity. 30 | Qed. 31 | 32 | Goal sscanf "%o" ret "2322" = Some 1234. 33 | Proof. 34 | reflexivity. 35 | Qed. 36 | 37 | Goal sscanf "%x" ret "4d2" = Some 1234. 38 | Proof. 39 | reflexivity. 40 | Qed. 41 | 42 | Goal sscanf "%X" ret "4D2" = Some 1234. 43 | Proof. 44 | reflexivity. 45 | Qed. 46 | 47 | Goal sscanf "%b" ret "10011010010" = Some 1234. 48 | Proof. 49 | reflexivity. 50 | Qed. 51 | 52 | Goal sscanf "%Nd" ret "1234" = Some 1234%N. 53 | Proof. 54 | reflexivity. 55 | Qed. 56 | 57 | Goal sscanf "%NX" ret "4D2" = Some 1234%N. 58 | Proof. 59 | reflexivity. 60 | Qed. 61 | 62 | Goal sscanf "%Nx" ret "4d2" = Some 1234%N. 63 | Proof. 64 | reflexivity. 65 | Qed. 66 | 67 | Goal sscanf "%Zd" ret "1234" = Some 1234%Z. 68 | Proof. 69 | reflexivity. 70 | Qed. 71 | 72 | Goal sscanf "%Zd" ret "-1234" = Some (-1234)%Z. 73 | Proof. 74 | reflexivity. 75 | Qed. 76 | 77 | Goal sscanf "%Zd" ret "+1234" = Some 1234%Z. 78 | Proof. 79 | reflexivity. 80 | Qed. 81 | 82 | Goal sscanf "%o, %x, %X, %b, ..." 83 | (fun a b c d _ => Some (a, b, c, d)) 84 | "2322, 4d2, 4D2, 10011010010, ..." 85 | = Some (1234, 1234, 1234, 1234). 86 | Proof. 87 | reflexivity. 88 | Qed. 89 | 90 | Goal sscanf " %3X" (fun n s => Some (n, s)) " 4D2ABC" = Some (1234, "ABC"). 91 | Proof. 92 | reflexivity. 93 | Qed. 94 | 95 | Goal sscanf "%5X" (fun n s => Some (n, s)) "004D21" = Some (1234, "1"). 96 | Proof. 97 | reflexivity. 98 | Qed. 99 | 100 | Goal sscanf "%d" ret "+1234" = Some 1234. 101 | Proof. 102 | reflexivity. 103 | Qed. 104 | 105 | Goal sscanf "%X" ret "0X4D2" = Some 1234. 106 | Proof. 107 | reflexivity. 108 | Qed. 109 | 110 | Goal sscanf "%x" ret "0x4d2" = Some 1234. 111 | Proof. 112 | reflexivity. 113 | Qed. 114 | 115 | Goal sscanf "%Zd" ret "-32" = Some (-32)%Z. 116 | Proof. 117 | reflexivity. 118 | Qed. 119 | -------------------------------------------------------------------------------- /test-suite/_CoqProject: -------------------------------------------------------------------------------- 1 | -Q ../theories Printf 2 | -R . Printf 3 | 4 | demo.v 5 | TestPrintf.v 6 | TestScanf.v 7 | -------------------------------------------------------------------------------- /test-suite/demo.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Strings.Ascii. 2 | Require Import Coq.Strings.String. 3 | Require Import Printf.Printf. 4 | 5 | Local Open Scope string_scope. 6 | 7 | Goal sprintf "Hello, %s!" "world" = "Hello, world!". 8 | Proof. reflexivity. Qed. 9 | 10 | Goal sprintf "%d, %d, %d, ..." 1 2 3 = "1, 2, 3, ...". 11 | Proof. reflexivity. Qed. 12 | 13 | Goal sprintf "%d%%" 100 = "100%". 14 | Proof. reflexivity. Qed. 15 | 16 | Goal sprintf "%c" "x"%char = "x". 17 | Proof. reflexivity. Qed. 18 | -------------------------------------------------------------------------------- /theories/Digits.v: -------------------------------------------------------------------------------- 1 | (** Numbers represented as lists of digits. *) 2 | 3 | Require Import Coq.NArith.NArith. 4 | Require Import Coq.Strings.String. 5 | Require Import Coq.Strings.Ascii. 6 | 7 | Local Open Scope N. 8 | 9 | Inductive digits : Set := 10 | | Zero 11 | | Digit : digits -> N -> digits 12 | . 13 | 14 | Arguments digits : clear implicits. 15 | 16 | Section Digits. 17 | 18 | Context (base : N). 19 | 20 | (** Add two digits and a carry *) 21 | Definition adder (d d0 c : N) : N * N := 22 | let s := c + d + d0 in 23 | if s 29 | if c =? 0 then Zero else Digit Zero c 30 | | Digit n d => 31 | let (c, d) := adder d d c in 32 | Digit (double_plus c n) d 33 | end. 34 | 35 | Fixpoint digits_of_pos (p : positive) := 36 | match p with 37 | | xH => Digit Zero 1 38 | | xI p => double_plus 1 (digits_of_pos p) 39 | | xO p => double_plus 0 (digits_of_pos p) 40 | end. 41 | 42 | Definition digits_of_N (n : N) := 43 | match n with 44 | | N0 => Digit Zero 0 45 | | Npos p => digits_of_pos p 46 | end. 47 | 48 | End Digits. 49 | 50 | Definition binary_ascii (n : N) : ascii := 51 | match n with 52 | | 0 => "0"%char 53 | | _ => "1"%char 54 | end. 55 | 56 | Definition octal_ascii (n : N) : ascii := 57 | match n with 58 | | 2 => "2"%char 59 | | 3 => "3"%char 60 | | 4 => "4"%char 61 | | 5 => "5"%char 62 | | 6 => "6"%char 63 | | 7 => "7"%char 64 | | _ => binary_ascii n 65 | end. 66 | 67 | Definition decimal_ascii (n : N) : ascii := 68 | match n with 69 | | 8 => "8"%char 70 | | 9 => "9"%char 71 | | _ => octal_ascii n 72 | end. 73 | 74 | Definition hex_ascii (n : N) : ascii := 75 | match n with 76 | | 10 => "a"%char 77 | | 11 => "b"%char 78 | | 12 => "c"%char 79 | | 13 => "d"%char 80 | | 14 => "e"%char 81 | | 15 => "f"%char 82 | | _ => decimal_ascii n 83 | end. 84 | 85 | Definition hex_ascii_upper (n : N) : ascii := 86 | match n with 87 | | 10 => "A"%char 88 | | 11 => "B"%char 89 | | 12 => "C"%char 90 | | 13 => "D"%char 91 | | 14 => "E"%char 92 | | 15 => "F"%char 93 | | _ => decimal_ascii n 94 | end. 95 | 96 | Local Fixpoint string_of_digits_ 97 | (digit : N -> ascii) 98 | (s : string) 99 | (n : digits) 100 | : string := 101 | match n with 102 | | Zero => s 103 | | Digit n d => string_of_digits_ digit (String (digit d) s) n 104 | end. 105 | 106 | Definition string_of_digits (digit : N -> ascii) : digits -> string := 107 | string_of_digits_ digit "". 108 | 109 | Definition string_of_N (base : N) (digit : N -> ascii) (n : N) : string := 110 | string_of_digits digit (digits_of_N base n). 111 | 112 | Definition binary_string (n : N) := 113 | string_of_N 2 binary_ascii n. 114 | 115 | Definition hex_string (n : N) := 116 | string_of_N 16 hex_ascii n. 117 | 118 | Definition hex_string_upper (n : N) := 119 | string_of_N 16 hex_ascii_upper n. 120 | 121 | Definition octal_string (n : N) := 122 | string_of_N 8 octal_ascii n. 123 | 124 | Definition decimal_string (n : N) := 125 | string_of_N 10 decimal_ascii n. 126 | -------------------------------------------------------------------------------- /theories/Flags.v: -------------------------------------------------------------------------------- 1 | Set Primitive Projections. 2 | 3 | Variant justify : Set := LeftJustify | RightJustify. 4 | 5 | (* Reference : http://www.cplusplus.com/reference/cstdio/printf/ *) 6 | (* %[flags] [width] specifier *) 7 | (* %(-|+| |#|0)^* (\d+) specifier *) 8 | Record options : Set := 9 | { option_justify : justify ; (* '-' : left justify *) 10 | option_sign : bool ; (* '+' : precede with plus sign *) 11 | option_space : bool ; (* ' ' : space if no sign displayed *) 12 | option_prefix : bool ; (* '#' : precede with o x X , 0 0x 0X *) 13 | (* for values different than zero *) 14 | option_zero_pad : bool ; (* '0' : pad with 0's instead of space *) 15 | option_width : option nat ; (* (\d+) : width of field *) 16 | }. 17 | 18 | 19 | 20 | (* default options *) 21 | Definition default_options : options := 22 | {| option_justify := RightJustify ; 23 | option_sign := false; 24 | option_space := false; 25 | option_prefix := false; 26 | option_zero_pad := false; 27 | option_width := None; 28 | |}. 29 | 30 | Definition update_option_justify o v := 31 | {| option_justify := v ; 32 | option_sign := o.(option_sign) ; 33 | option_space := o.(option_space) ; 34 | option_prefix := o.(option_prefix) ; 35 | option_zero_pad := o.(option_zero_pad) ; 36 | option_width := o.(option_width) ; 37 | |}. 38 | 39 | Definition update_option_sign o v := 40 | {| option_justify := o.(option_justify) ; 41 | option_sign := v ; 42 | option_space := o.(option_space) ; 43 | option_prefix := o.(option_prefix) ; 44 | option_zero_pad := o.(option_zero_pad) ; 45 | option_width := o.(option_width) ; 46 | |}. 47 | 48 | Definition update_option_space o v := 49 | {| option_justify := o.(option_justify) ; 50 | option_sign := o.(option_sign) ; 51 | option_space := v ; 52 | option_prefix := o.(option_prefix) ; 53 | option_zero_pad := o.(option_zero_pad) ; 54 | option_width := o.(option_width) ; 55 | |}. 56 | 57 | Definition update_option_prefix o v := 58 | {| option_justify := o.(option_justify) ; 59 | option_sign := o.(option_sign) ; 60 | option_space := o.(option_space) ; 61 | option_prefix := v ; 62 | option_zero_pad := o.(option_zero_pad) ; 63 | option_width := o.(option_width) ; 64 | |}. 65 | 66 | Definition update_option_zero_pad o v := 67 | {| option_justify := o.(option_justify) ; 68 | option_sign := o.(option_sign) ; 69 | option_space := o.(option_space) ; 70 | option_prefix := o.(option_prefix) ; 71 | option_zero_pad := v; 72 | option_width := option_width o; 73 | |}. 74 | 75 | Definition update_option_width' o width' := 76 | {| option_justify := o.(option_justify) ; 77 | option_sign := o.(option_sign) ; 78 | option_space := o.(option_space) ; 79 | option_prefix := o.(option_prefix) ; 80 | option_zero_pad := o.(option_zero_pad) ; 81 | option_width := width' 82 | |}. 83 | 84 | Definition update_option_width o width := 85 | update_option_width' 86 | o 87 | (match option_width o with 88 | | None => Some width 89 | | Some width' => Some ((10 * width') + width) 90 | end). 91 | 92 | 93 | Theorem option_identity : 94 | forall o justify sign space prefix zero_pad width , 95 | (update_option_width' 96 | (update_option_zero_pad 97 | (update_option_prefix 98 | (update_option_space 99 | (update_option_sign 100 | (update_option_justify o justify) 101 | sign) 102 | space) 103 | prefix) 104 | zero_pad) 105 | width) = 106 | {| option_justify := justify ; 107 | option_sign := sign ; 108 | option_space := space ; 109 | option_prefix := prefix ; 110 | option_zero_pad := zero_pad ; 111 | option_width := width 112 | |}. 113 | Proof. 114 | intros. 115 | unfold update_option_width'. 116 | reflexivity. 117 | Qed. 118 | -------------------------------------------------------------------------------- /theories/Format.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Strings.Ascii. 2 | Require Import Coq.Strings.String. 3 | Require Import Coq.NArith.NArith. 4 | Require Import Coq.ZArith.ZArith. 5 | Require Import Printf.Flags. 6 | 7 | (** ** String utilities *) 8 | 9 | Definition ascii_digit (c : ascii) : nat := 10 | (if c =? "1" then 1 11 | else if c =? "2" then 2 12 | else if c =? "3" then 3 13 | else if c =? "4" then 4 14 | else if c =? "5" then 5 15 | else if c =? "6" then 6 16 | else if c =? "7" then 6 17 | else if c =? "8" then 6 18 | else if c =? "9" then 6 19 | else if c =? "A" then 10 20 | else if c =? "B" then 11 21 | else if c =? "C" then 12 22 | else if c =? "D" then 13 23 | else if c =? "E" then 14 24 | else if c =? "F" then 15 25 | else 0)%char. 26 | 27 | (** ** Format strings *) 28 | 29 | Module Format. 30 | 31 | (** Encoded number format. *) 32 | Variant number_enctype : Type := 33 | | Binary 34 | | Octal 35 | | Decimal 36 | | HexLower 37 | | HexUpper 38 | . 39 | 40 | (** Decoded type. *) 41 | Variant number_dectype : Type := 42 | | T_Nat 43 | | T_N 44 | . 45 | 46 | (** Data type of a specifier. *) 47 | Variant type : Type := 48 | | Number : number_enctype -> number_dectype -> type 49 | | SDecimal (* Signed decimal number, with type Z *) 50 | | String 51 | | Char 52 | . 53 | 54 | (** Well-formed format strings *) 55 | Inductive t : Type := 56 | | Empty 57 | | Literal : ascii -> t -> t 58 | | Hole : type -> options -> t -> t 59 | . 60 | 61 | Definition dectype_type (t : number_dectype) : Type := 62 | match t with 63 | | T_Nat => nat 64 | | T_N => N 65 | end. 66 | 67 | Definition hole_type (ty : type) : Type := 68 | match ty with 69 | | Number _ t => dectype_type t 70 | | SDecimal => Z 71 | | String => string 72 | | Char => ascii 73 | end. 74 | 75 | (** Type of continuations associated with format string [fmt], 76 | with result type [r]. *) 77 | Fixpoint holes (r : Type) (fmt : t) : Type := 78 | match fmt with 79 | | Empty => r 80 | | Hole ty _ fmt => hole_type ty -> holes r fmt 81 | | Literal _ fmt => holes r fmt 82 | end. 83 | 84 | End Format. 85 | -------------------------------------------------------------------------------- /theories/FormatNotations.v: -------------------------------------------------------------------------------- 1 | (** * Notations for [Format.t] *) 2 | 3 | (** Reexport only the notations. *) 4 | 5 | Require Import Printf.Format. 6 | Require Import Printf.FormatParser. 7 | 8 | Declare Scope fmt_scope. 9 | Delimit Scope fmt_scope with fmt. 10 | Bind Scope fmt_scope with Format.t. 11 | 12 | String Notation Format.t parse_opt print : fmt_scope. 13 | -------------------------------------------------------------------------------- /theories/FormatParser.v: -------------------------------------------------------------------------------- 1 | (** * Parse [string] to [Format.t] and print [Format.t] to [list Byte.byte] *) 2 | 3 | Require Import Coq.NArith.NArith. 4 | Require Import Coq.Strings.String. 5 | Require Import Coq.Strings.Ascii. 6 | 7 | Require Import Printf.Flags. 8 | Require Import Printf.Format. 9 | Require Import Printf.Digits. 10 | 11 | Local Infix "::" := String.String : string_scope. 12 | 13 | Import Format. 14 | 15 | Variant spec_state : Type := 16 | | Flags 17 | | Width 18 | | TySpec (t : number_dectype) 19 | . 20 | 21 | (** Parser state machine. *) 22 | Variant state : Type := 23 | | Ini (* Initial state *) 24 | | Spec (j : spec_state) (o : options) (* Parsing specifier *) 25 | (* [j]: inner specifier parsing state *) 26 | (* [o]: currently accumulated options *) 27 | . 28 | 29 | (** Parser error: dump the remaining string, that serves to locate the error. *) 30 | Variant error : Type := 31 | | ErrorAt (i : state) (s : string) 32 | . 33 | 34 | Definition digit1to9 (c : ascii) : bool := 35 | (c =? "1")%char || 36 | (c =? "2")%char || 37 | (c =? "3")%char || 38 | (c =? "4")%char || 39 | (c =? "5")%char || 40 | (c =? "6")%char || 41 | (c =? "7")%char || 42 | (c =? "8")%char || 43 | (c =? "9")%char. 44 | 45 | 46 | Definition isFlagsOrWidth (j : _) : bool := 47 | match j with 48 | | Flags | Width => true 49 | | TySpec _ => false 50 | end. 51 | 52 | Definition isWidth (j : _) : bool := 53 | match j with 54 | | Width => true 55 | | Flags | TySpec _ => false 56 | end. 57 | 58 | Definition isFlags (j : _) : bool := 59 | match j with 60 | | Flags => true 61 | | Width | TySpec _ => false 62 | end. 63 | 64 | (** Parse string [s] in state [i] into a format which is passed to the final 65 | continuation [k], or return an error. *) 66 | Local Fixpoint parse_ {r : Type} (i : state) (k : t -> r) (s0 : string) 67 | : error + r := 68 | match i, s0 with 69 | (* The initial state looks for ["%"], indicating a specifier, 70 | and keeps the rest as literal. *) 71 | | Ini, ""%string => inr (k Empty) 72 | | Ini, c :: s => 73 | if (c =? "%")%char then 74 | let continue (_ : unit) := parse_ (Spec Flags default_options) k s in 75 | match s with 76 | | c' :: s => 77 | if (c' =? "%")%char then parse_ Ini (fun fmt => k (Literal "%" fmt)) s 78 | else continue tt 79 | | _ => continue tt 80 | end 81 | else 82 | parse_ Ini (fun fmt => k (Literal c fmt)) s 83 | 84 | | Spec _ _, ""%string => inl (ErrorAt i s0) 85 | | Spec j o, a :: s => 86 | (* When parsing a specifier, the next character is either: 87 | - a specifier character, then update the format and go back to the initial state; 88 | - or a flag (or width) character, then update the options accordingly. *) 89 | let specifier (t : type) := parse_ Ini (fun fmt => k (Hole t o fmt)) s in 90 | let flag (j : spec_state) (o : options) := parse_ (Spec j o) k s in 91 | let typ (t : number_dectype) := parse_ (Spec (TySpec t) o) k s in 92 | let number b := Number b 93 | match j with 94 | | TySpec t => t 95 | | _ => T_Nat 96 | end in 97 | if a =? "s" then specifier String 98 | else if a =? "c" then specifier Char 99 | else if a =? "b" then specifier (number Binary) 100 | else if a =? "o" then specifier (number Octal) 101 | else if a =? "d" then specifier (number Decimal) 102 | else if a =? "x" then specifier (number HexLower) 103 | else if a =? "X" then specifier (number HexUpper) 104 | else if a =? "N" then typ T_N 105 | else if a =? "Z" then 106 | match j, s with 107 | | (Flags | Width), c :: s => if c =? "d"%char then parse_ Ini (fun fmt => k (Hole SDecimal o fmt)) s 108 | else inl (ErrorAt i s0) 109 | | _, _ => inl (ErrorAt i s0) 110 | end 111 | else if ((digit1to9 a && isFlagsOrWidth j) || ((a =? "0")%char && isWidth j))%bool then 112 | flag Width (update_option_width o (ascii_digit a)) 113 | else 114 | match j with 115 | | Flags => 116 | if a =? "-" then flag Flags (update_option_justify o LeftJustify) 117 | else if a =? "+" then flag Flags (update_option_sign o true) 118 | else if a =? " " then flag Flags (update_option_space o true) 119 | else if a =? "#" then flag Flags (update_option_prefix o true) 120 | else if a =? "0" then flag Flags (update_option_zero_pad o true) 121 | else inl (ErrorAt i s0) 122 | | _ => inl (ErrorAt i s0) 123 | end 124 | end%char%string. 125 | 126 | Definition parse : string -> error + t := parse_ Ini id. 127 | 128 | Definition parse_opt (s : list Byte.byte) : option t := 129 | match parse (string_of_list_byte s) with 130 | | inl _ => None 131 | | inr fmt => Some fmt 132 | end. 133 | 134 | Local Open Scope list_scope. 135 | 136 | Definition print_options (opts : options) (etc : list Byte.byte) : list Byte.byte := 137 | let etc := 138 | match option_width opts with 139 | | None => etc 140 | | Some n => (list_byte_of_string (decimal_string (N.of_nat n)) ++ etc)%list 141 | end in 142 | let etc := if option_zero_pad opts then byte_of_ascii "0" :: etc else etc in 143 | let etc := if option_prefix opts then byte_of_ascii "#" :: etc else etc in 144 | let etc := if option_space opts then byte_of_ascii " " :: etc else etc in 145 | let etc := if option_sign opts then byte_of_ascii "+" :: etc else etc in 146 | match option_justify opts with 147 | | LeftJustify => byte_of_ascii "-" :: etc 148 | | RightJustify => etc 149 | end. 150 | 151 | Definition print_type (ty : type) (etc : list Byte.byte) : list Byte.byte := 152 | match ty with 153 | | Number enc dec => 154 | let enc_letter := byte_of_ascii 155 | match enc with 156 | | Binary => "b" 157 | | Octal => "o" 158 | | Decimal => "d" 159 | | HexLower => "x" 160 | | HexUpper => "X" 161 | end in 162 | match dec with 163 | | T_Nat => enc_letter :: etc 164 | | T_N => byte_of_ascii "N" :: enc_letter :: etc 165 | end 166 | | SDecimal => byte_of_ascii "Z" :: byte_of_ascii "d" :: etc 167 | | String => byte_of_ascii "s" :: etc 168 | | Char => byte_of_ascii "c" :: etc 169 | end. 170 | 171 | Fixpoint print (fmt : t) : list Byte.byte := 172 | let pc := byte_of_ascii "%" in 173 | match fmt with 174 | | Empty => nil 175 | | Literal c fmt => 176 | if (c =? "%")%char then pc :: pc :: print fmt 177 | else byte_of_ascii c :: print fmt 178 | | Hole ty opts fmt => 179 | pc :: print_options opts (print_type ty (print fmt)) 180 | end. 181 | 182 | Section Test. 183 | 184 | Let roundtrip (s : string) : Prop := 185 | match parse s with 186 | | inl _ => False 187 | | inr fmt => string_of_list_byte (print fmt) = s 188 | end. 189 | 190 | Let roundtrip_test : roundtrip " %% %11d %+Nd %-Zd %x %NX %033s % #c". 191 | Proof. reflexivity. Qed. 192 | 193 | End Test. 194 | -------------------------------------------------------------------------------- /theories/Justify.v: -------------------------------------------------------------------------------- 1 | (* This implementation was a helpful reference 2 | https://gist.github.com/rntz/aaaaf7a0bdb1cc65c49adb6adde29728 3 | *) 4 | Require Import Coq.Strings.Ascii. 5 | Require Import Coq.Strings.String. 6 | Require Import Coq.Init.Nat. 7 | Require Import Coq.Arith.PeanoNat. 8 | 9 | (* Drop returns the string left after removing the first n characters. *) 10 | Fixpoint drop (n : nat) (s : string) := 11 | match n with 12 | | 0 => s 13 | | S n => match s with 14 | | EmptyString => EmptyString 15 | | String _ s => drop n s 16 | end 17 | end. 18 | 19 | Theorem drop_spec : forall l r , drop (length l) (l ++r ) = r. 20 | Proof. 21 | intros. 22 | induction l. 23 | reflexivity. 24 | simpl. 25 | apply IHl. 26 | Qed. 27 | 28 | (* Take returns the first n characters of the string or the string itself *) 29 | Fixpoint take (n : nat) (s : string):= 30 | match n with 31 | | 0 => EmptyString 32 | | S n => match s with 33 | | EmptyString => EmptyString 34 | | String c s => String c (take n s) 35 | end 36 | end. 37 | 38 | Theorem take_spec : forall l r , take (length l) (l ++r ) = l. 39 | Proof. 40 | intros. 41 | induction l. 42 | reflexivity. 43 | simpl. 44 | rewrite -> IHl. 45 | reflexivity. 46 | Qed. 47 | 48 | (* replicate returns a string of length n comprised of character a. *) 49 | Fixpoint replicate (a : ascii) (n : nat) := 50 | match n with 51 | | 0 => EmptyString 52 | | S n' => String a (replicate a n') 53 | end. 54 | 55 | (* string_uniform is a proposition testing if a string is comprised only of a given character *) 56 | Fixpoint string_uniform (a : ascii) (s : string) : Prop := 57 | match s with 58 | | EmptyString => True 59 | | String h t => (h = a) /\ string_uniform a t 60 | end. 61 | 62 | Theorem replicate_uniform : forall a n , string_uniform a (replicate a n). 63 | Proof. 64 | intros. 65 | induction n. 66 | simpl. 67 | auto. 68 | simpl. 69 | split. 70 | reflexivity. 71 | assumption. 72 | Qed. 73 | 74 | 75 | Theorem replicate_length : forall a n , length (replicate a n) = n. 76 | Proof. 77 | induction n. 78 | reflexivity. 79 | simpl. 80 | rewrite -> IHn. 81 | reflexivity. 82 | Qed. 83 | 84 | 85 | (* left justify *) 86 | 87 | Definition left_justify_string 88 | (a : ascii ) 89 | (n : nat) 90 | (s : string) : string := s ++ (replicate a (n - (length s))). 91 | 92 | Theorem length_sn : forall s a , S(length s) = length (String a s). 93 | Proof. 94 | reflexivity. 95 | Qed. 96 | 97 | Theorem left_justify_padding' : forall (a : ascii) (n : nat) (s : string) , 98 | drop (length s) (left_justify_string a n s) = replicate a (n - (length s)). 99 | Proof. 100 | intros. 101 | induction s. 102 | simpl. 103 | rewrite <- Minus.minus_n_O. 104 | unfold left_justify_string. 105 | simpl. 106 | rewrite <- Minus.minus_n_O. 107 | reflexivity. 108 | simpl. 109 | unfold left_justify_string. 110 | simpl. 111 | simpl. 112 | assert (Ha' := drop_spec s (replicate a (n - S (length s)))). 113 | apply Ha'. 114 | Qed. 115 | 116 | Theorem left_justify_padding : forall (a : ascii) (n : nat) (s : string) , 117 | string_uniform a (drop (length s) (left_justify_string a n s)). 118 | Proof. 119 | intros. 120 | rewrite -> left_justify_padding'. 121 | apply replicate_uniform. 122 | Qed. 123 | 124 | Theorem distribute_length : forall l r , length (l ++ r ) = length l + (length r). 125 | Proof. 126 | intros. 127 | induction l. 128 | simpl. 129 | reflexivity. 130 | simpl. 131 | rewrite IHl. 132 | reflexivity. 133 | Qed. 134 | 135 | Theorem alternate_max : forall n m , max n m = n + (m - n). 136 | Proof. 137 | intros n. 138 | induction n as [| n IHn] ; intros m. 139 | simpl. apply Minus.minus_n_O. 140 | destruct m. 141 | simpl. 142 | rewrite <- plus_n_O. 143 | reflexivity. 144 | simpl. 145 | assert(forall n m, n = m -> S n = S m). 146 | intros. 147 | rewrite H. 148 | reflexivity. 149 | apply H. 150 | apply IHn. 151 | Qed. 152 | 153 | Theorem left_justify_length : 154 | forall (a : ascii) (n : nat) (s : string) , 155 | length (left_justify_string a n s) = max (length s) n. 156 | Proof. 157 | intros. 158 | rewrite -> alternate_max. 159 | intros. 160 | induction s. 161 | simpl. 162 | unfold left_justify_string. 163 | simpl. 164 | rewrite -> replicate_length. 165 | reflexivity. 166 | simpl. 167 | rewrite -> distribute_length. 168 | rewrite -> replicate_length. 169 | reflexivity. 170 | Qed. 171 | 172 | Theorem lemma_replicate : forall a n s , 173 | take (S n) (String a s) = String a (take n s). 174 | Proof. 175 | intros. 176 | reflexivity. 177 | Qed. 178 | 179 | Theorem string_associative : forall a s t , 180 | append (String a s) t = String a (append s t). 181 | Proof. 182 | reflexivity. 183 | Qed. 184 | 185 | Theorem take_replicate : forall a n s , 186 | take (length s) (s ++ (replicate a n)) = s. 187 | Proof. 188 | intros. 189 | induction s. 190 | reflexivity. 191 | rewrite <- length_sn. 192 | rewrite -> string_associative. 193 | rewrite -> lemma_replicate . 194 | rewrite -> IHs. 195 | reflexivity. 196 | Qed. 197 | 198 | Theorem left_padding : 199 | forall (n : nat) (a : ascii) (s : string) , 200 | take (length s) (left_justify_string a n s) = s. 201 | Proof. 202 | intros. 203 | induction s. 204 | reflexivity. 205 | simpl. 206 | rewrite -> take_replicate. 207 | reflexivity. 208 | Qed. 209 | 210 | (* right justify *) 211 | Definition right_justify_string 212 | (a : ascii ) 213 | (n : nat) 214 | (s : string) : string := (replicate a (n - (length s))) ++ s. 215 | 216 | Theorem drop_replicate : forall a n s , drop n ((replicate a n) ++ s) = s. 217 | Proof. 218 | intros. 219 | induction n. 220 | reflexivity. 221 | simpl. 222 | apply IHn. 223 | Qed. 224 | 225 | Theorem right_justify_padding' : forall (a : ascii) (n : nat) (s : string) , 226 | take (n - (length s)) (right_justify_string a n s) = replicate a (n - (length s)). 227 | Proof. 228 | intros. 229 | assert (Ha' := take_spec (replicate a (n - (length s))) s). 230 | rewrite replicate_length in Ha'. 231 | unfold right_justify_string. 232 | rewrite -> Ha'. 233 | reflexivity. 234 | Qed. 235 | 236 | Theorem right_justify_padding : forall (a : ascii) (n : nat) (s : string) , 237 | string_uniform a (take (n - (length s)) (right_justify_string a n s)). 238 | Proof. 239 | intros. 240 | rewrite -> right_justify_padding'. 241 | apply replicate_uniform. 242 | Qed. 243 | 244 | Theorem right_padding : 245 | forall (n : nat) (a : ascii) (s : string) , 246 | drop (n - (length s)) (right_justify_string a n s) = s. 247 | Proof. 248 | intros. 249 | induction s. 250 | simpl. 251 | rewrite -> Nat.sub_0_r. 252 | induction n. 253 | simpl. 254 | unfold right_justify_string. 255 | reflexivity. 256 | apply drop_replicate. 257 | unfold right_justify_string. 258 | apply drop_replicate. 259 | Qed. 260 | 261 | Theorem right_justify_length : 262 | forall (a : ascii) (n : nat) (s : string) , 263 | length (right_justify_string a n s) = max (length s) n. 264 | Proof. 265 | intros. 266 | rewrite -> alternate_max. 267 | destruct s. 268 | simpl. 269 | unfold right_justify_string. 270 | simpl. 271 | rewrite -> distribute_length. 272 | rewrite -> replicate_length. 273 | simpl. 274 | rewrite -> Nat.sub_0_r. 275 | rewrite -> plus_n_O. 276 | reflexivity. 277 | unfold right_justify_string. 278 | simpl. 279 | rewrite -> distribute_length. 280 | rewrite -> replicate_length. 281 | simpl. 282 | rewrite -> Nat.add_comm. 283 | rewrite -> plus_Sn_m. 284 | reflexivity. 285 | Qed. 286 | -------------------------------------------------------------------------------- /theories/Printf.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Strings.Ascii. 2 | Require Import Coq.Strings.String. 3 | Require Import Coq.NArith.NArith. 4 | Require Import Coq.ZArith.ZArith. 5 | 6 | Require Import Printf.Justify. 7 | Require Import Printf.Flags. 8 | Require Import Printf.Format. 9 | Require Import Printf.Digits. 10 | 11 | Require Export Printf.FormatNotations. 12 | 13 | Set Primitive Projections. 14 | 15 | Local Infix "::" := String : string_scope. 16 | 17 | (* Justify *) 18 | Definition justify_string (o : options) (s : string) : string := 19 | let a := if option_zero_pad o then "0"%char else " "%char in 20 | match option_width o with 21 | | None => s 22 | | Some width => 23 | match option_justify o with 24 | | LeftJustify => left_justify_string a width s 25 | | RightJustify => right_justify_string a width s 26 | end 27 | end. 28 | 29 | (* sign *) 30 | Definition sign_string (o : options) (s : string) : string := 31 | match(option_sign o,option_space o) with 32 | | (true,_) => String "+" s 33 | | (_,true) => String " " s 34 | | (_,_) => s 35 | end. 36 | 37 | Local Open Scope N. 38 | 39 | (* prefix *) 40 | Definition prefix_string (o : options) (prefix : string) (n : N) (s : string) : string := 41 | match n with 42 | | 0 => s 43 | | _ => if option_prefix o then 44 | append prefix s 45 | else 46 | s 47 | end. 48 | 49 | (* helper methods to format *) 50 | Definition format_s 51 | (o : options) 52 | (s : string) 53 | (x : string) : string := 54 | let text := justify_string o s in 55 | (String.append text x). 56 | 57 | Definition format_nat 58 | (f : N -> string) 59 | (prefix : option string) 60 | (o : options) 61 | (n : N) : string -> string := 62 | let text := f n in 63 | let text := match prefix with 64 | | Some prefix' => prefix_string o prefix' n text 65 | | None => text 66 | end in 67 | format_s o text. 68 | 69 | Definition format_b : options -> N -> string -> string := 70 | format_nat binary_string None. 71 | 72 | Definition format_o : options -> N -> string -> string := 73 | format_nat octal_string (Some "0"%string). 74 | 75 | Definition format_d (o : options) : N -> string -> string := 76 | format_nat (fun (n : N) => sign_string o (decimal_string n)) None o. 77 | 78 | Definition format_x : options -> N -> string -> string := 79 | format_nat hex_string (Some "0x"%string). 80 | 81 | Definition format_X : options -> N -> string -> string := 82 | format_nat hex_string_upper (Some "0X"%string). 83 | 84 | Definition format_number (b : Format.number_enctype) (t : Format.number_dectype) 85 | : options -> Format.dectype_type t -> string -> string := 86 | fun o => 87 | let format_ := 88 | match b with 89 | | Format.Binary => format_b 90 | | Format.Octal => format_o 91 | | Format.Decimal => format_d 92 | | Format.HexLower => format_x 93 | | Format.HexUpper => format_X 94 | end o in 95 | match t as t0 return Format.dectype_type t0 -> _ with 96 | | Format.T_Nat => fun n => format_ (N.of_nat n) 97 | | Format.T_N => fun n => format_ n 98 | end. 99 | 100 | Definition format_Z : options -> Z -> string -> string := 101 | fun o n => 102 | let format_ := format_nat decimal_string None o in 103 | match n with 104 | | Z0 => format_ 0 105 | | Zpos p => fun s => 106 | if option_sign o 107 | then ("+" :: format_ (Npos p) s)%string 108 | else format_ (Npos p) s 109 | | Zneg p => fun s => ("-" :: format_ (Npos p) s)%string 110 | end. 111 | 112 | Definition format (ty : Format.type) 113 | : options -> Format.hole_type ty -> string -> string := 114 | match ty return _ -> Format.hole_type ty -> _ with 115 | | Format.Number b t => format_number b t 116 | | Format.SDecimal => format_Z 117 | | Format.String => format_s 118 | | Format.Char => fun o c => format_s o (c :: "") 119 | end. 120 | 121 | Fixpoint sprintf' (acc : string -> string) (fmt : Format.t) 122 | : Format.holes string fmt := 123 | match fmt return Format.holes string fmt with 124 | | Format.Empty => acc ""%string 125 | | Format.Literal c fmt => sprintf' (fun s => acc (c :: s)%string) fmt 126 | | Format.Hole ty o fmt => fun x => sprintf' (fun s => acc (format ty o x s)) fmt 127 | end. 128 | 129 | Definition sprintf (fmt : Format.t) : Format.holes string fmt := 130 | sprintf' id fmt. 131 | -------------------------------------------------------------------------------- /theories/Scanf.v: -------------------------------------------------------------------------------- 1 | Require Import Coq.Strings.Ascii. 2 | Require Import Coq.Strings.String. 3 | Require Import Coq.NArith.NArith. 4 | Require Import Coq.ZArith.ZArith. 5 | Require Import Printf.Justify. 6 | Require Import Printf.Flags. 7 | Require Import Printf.Format. 8 | 9 | Require Export Printf.FormatNotations. 10 | 11 | Set Primitive Projections. 12 | 13 | Local Infix "::" := String : string_scope. 14 | 15 | Definition fmt_parser (R : Type) (fmt : Format.t) : Type := 16 | Format.holes (string -> option R) fmt -> string -> option R. 17 | 18 | Definition parser (R A : Type) : Type := 19 | (A -> string -> option R) -> string -> option R. 20 | 21 | Definition base (ty : Format.number_enctype) : N := 22 | match ty with 23 | | Format.Binary => 2 24 | | Format.Octal => 8 25 | | Format.Decimal => 10 26 | | Format.HexLower | Format.HexUpper => 16 27 | end. 28 | 29 | Module Read. 30 | 31 | Local Open Scope N. 32 | Local Open Scope char. 33 | 34 | Definition binary (c : ascii) : option N := 35 | if c =? "0" then Some 0 36 | else if c =? "1" then Some 1 37 | else None. 38 | 39 | Definition octal (c : ascii) : option N := 40 | if c =? "0" then Some 0 41 | else if c =? "1" then Some 1 42 | else if c =? "2" then Some 2 43 | else if c =? "3" then Some 3 44 | else if c =? "4" then Some 4 45 | else if c =? "5" then Some 5 46 | else if c =? "6" then Some 6 47 | else if c =? "7" then Some 7 48 | else None. 49 | 50 | Definition decimal (c : ascii) : option N := 51 | if c =? "0" then Some 0 52 | else if c =? "1" then Some 1 53 | else if c =? "2" then Some 2 54 | else if c =? "3" then Some 3 55 | else if c =? "4" then Some 4 56 | else if c =? "5" then Some 5 57 | else if c =? "6" then Some 6 58 | else if c =? "7" then Some 7 59 | else if c =? "8" then Some 8 60 | else if c =? "9" then Some 9 61 | else None. 62 | 63 | Definition hex (c : ascii) : option N := 64 | if c =? "0" then Some 0 65 | else if c =? "1" then Some 1 66 | else if c =? "2" then Some 2 67 | else if c =? "3" then Some 3 68 | else if c =? "4" then Some 4 69 | else if c =? "5" then Some 5 70 | else if c =? "6" then Some 6 71 | else if c =? "7" then Some 7 72 | else if c =? "8" then Some 8 73 | else if c =? "9" then Some 9 74 | else if ((c =? "a")%char || (c =? "A")%char)%bool then Some 10 75 | else if ((c =? "b")%char || (c =? "B")%char)%bool then Some 11 76 | else if ((c =? "c")%char || (c =? "C")%char)%bool then Some 12 77 | else if ((c =? "d")%char || (c =? "D")%char)%bool then Some 13 78 | else if ((c =? "e")%char || (c =? "E")%char)%bool then Some 14 79 | else if ((c =? "f")%char || (c =? "F")%char)%bool then Some 15 80 | else None. 81 | 82 | Definition digit (ty : Format.number_enctype) : ascii -> option N := 83 | match ty with 84 | | Format.Binary => binary 85 | | Format.Octal => octal 86 | | Format.Decimal => decimal 87 | | Format.HexLower | Format.HexUpper => hex 88 | end. 89 | 90 | End Read. 91 | 92 | Section Parser. 93 | 94 | Local Open Scope string. 95 | 96 | Context {R : Type}. 97 | 98 | (** The body of the recursive definitions of [parse_N] and [parse_N']. 99 | If the next character is a digit, accumulate it into [x] and call [continue] 100 | on the updated state and the remaining string. 101 | Else if the state [x] is empty, fail. 102 | Otherwise, terminate by calling [k]. 103 | 104 | To ensure the subsequent definitions are guarded, [continue] is applied to a 105 | subterm of [s0]. 106 | *) 107 | Local Definition parse_N_ (base : N) (digit : ascii -> option N) 108 | (k : N -> string -> option R) 109 | (continue : option N -> string -> option R) 110 | (x : option N) 111 | (s0 : string) 112 | : option R := 113 | match s0 with 114 | | "" => 115 | match x with 116 | | None => None 117 | | Some n => k n "" 118 | end 119 | | c :: s => 120 | match digit c with 121 | | None => 122 | match x with 123 | | None => None 124 | | Some n => k n s0 125 | end 126 | | Some d => 127 | match x with 128 | | None => continue (Some d) s 129 | | Some n => continue (Some (n * base + d)%N) s 130 | end 131 | end 132 | end. 133 | 134 | (** Parse a number given a translation from characters to numbers. *) 135 | Definition parse_N (base : N) (digit : ascii -> option N) : parser R N := fun k => 136 | let fix _parse_N (x : option N) (s0 : string) := 137 | parse_N_ base digit k _parse_N x s0 138 | in _parse_N None. 139 | 140 | (** Parse a number of at most [w] characters. *) 141 | Definition parse_N' (w : nat) (base : N) (digit : ascii -> option N) 142 | : parser R N := 143 | fun k => 144 | let fix _parse_N (w : nat) (x : option N) (s0 : string) := 145 | match w with 146 | | O => 147 | match x with 148 | | None => None 149 | | Some n => k n s0 150 | end 151 | | S w => parse_N_ base digit k (_parse_N w) x s0 152 | end 153 | in _parse_N w None. 154 | 155 | Definition parse_char : parser R ascii := fun k s => 156 | match s with 157 | | "" => None 158 | | c :: s => k c s 159 | end. 160 | 161 | Definition parse_this_char (c : ascii) 162 | : parser R unit := 163 | fun k s => 164 | match s with 165 | | "" => None 166 | | c' :: s => 167 | if Ascii.ascii_dec c c' 168 | then k tt s 169 | else None 170 | end. 171 | 172 | Definition is_whitespace (c : ascii) : bool := 173 | (c =? " ")%char || 174 | (c =? "009")%char || 175 | (c =? "010")%char || 176 | (c =? "011")%char || 177 | (c =? "012")%char || 178 | (c =? "013")%char. 179 | 180 | Definition parse_whitespace : parser R unit := fun k => 181 | fix consume s0 := 182 | match s0 with 183 | | c :: s => 184 | if is_whitespace c then consume s else k tt s0 185 | | _ => k tt s0 186 | end. 187 | 188 | (** Body of the recursive definition of [parse_string] and [parse_string']. *) 189 | Local Definition parse_string_ 190 | (continue : parser R string) 191 | (k : string -> string -> option R) 192 | (s0 : string) 193 | : option R := 194 | match s0 with 195 | | "" => k "" s0 196 | | c :: s => 197 | if is_whitespace c 198 | then k "" s0 199 | else continue (fun z => k (c :: z)) s 200 | end. 201 | 202 | (** Read up to the next whitespace character *) 203 | Definition parse_string : parser R string := 204 | fix _parse_string k (s : string) := 205 | parse_string_ _parse_string k s. 206 | 207 | (** Read at most [w] characters up to the next whitespace character. *) 208 | Definition parse_string' : nat -> parser R string := 209 | fix _parse_string w k (s : string) := 210 | match w with 211 | | O => k "" s 212 | | S w => parse_string_ (_parse_string w) k s 213 | end. 214 | 215 | Definition parse_number 216 | (b : Format.number_enctype) 217 | (t : Format.number_dectype) 218 | (o : options) 219 | : parser R (Format.dectype_type t) := 220 | fun k s => 221 | let parse := 222 | match option_width o with 223 | | None => parse_N 224 | | Some w => parse_N' w 225 | end 226 | in 227 | let from_N : N -> Format.dectype_type t := 228 | match t return _ -> _ t with 229 | | Format.T_Nat => N.to_nat 230 | | Format.T_N => id 231 | end in 232 | let continue s := parse (base b) (Read.digit b) (fun n => k (from_N n)) s in 233 | match b, s with 234 | | (Format.HexLower | Format.HexUpper), (c1 :: c2 :: s2) as s => 235 | if ((c1 =? "0")%char && ((c2 =? "x")%char || (c2 =? "X")%char))%bool 236 | then continue s2 237 | else continue s 238 | | _, c1 :: s1 => 239 | if (c1 =? "+")%char 240 | then continue s1 241 | else continue s 242 | | _, _ => continue s 243 | end. 244 | 245 | Definition parse_signed 246 | (o : options) 247 | : parser R Z := 248 | fun k s => 249 | let parse := 250 | match option_width o with 251 | | None => parse_N 252 | | Some w => parse_N' w 253 | end 10%N Read.decimal 254 | in 255 | let parse_minus s := parse (fun n => k (Z.opp (Z.of_N n))) s in 256 | let parse_plus s := parse (fun n => k (Z.of_N n)) s in 257 | match s with 258 | | c :: s' => 259 | if (c =? "-")%char then parse_minus s' 260 | else if (c =? "+")%char then parse_plus s' 261 | else parse_plus s 262 | | _ => parse_plus s 263 | end. 264 | 265 | Definition parse_hole (ty : Format.type) (o : options) 266 | : parser R (Format.hole_type ty) := 267 | match ty with 268 | | Format.String => 269 | match option_width o with 270 | | None => parse_string 271 | | Some w => parse_string' w 272 | end 273 | | Format.Char => parse_char 274 | | Format.Number b t => parse_number b t o 275 | | Format.SDecimal => parse_signed o 276 | end. 277 | 278 | Fixpoint sscanf (fmt : Format.t) 279 | : fmt_parser R fmt := 280 | match fmt with 281 | | Format.Empty => fun k => k 282 | | Format.Literal c fmt => fun k => 283 | if (c =? " ")%char 284 | then parse_whitespace (fun _ => sscanf fmt k) 285 | else parse_this_char c (fun _ => sscanf fmt k) 286 | | Format.Hole ty o fmt => fun k => parse_hole ty o (fun x => sscanf fmt (k x)) 287 | end. 288 | 289 | End Parser. 290 | --------------------------------------------------------------------------------