intro_patterns.v 5.47 KB
Newer Older
Robbert Krebbers's avatar
Robbert Krebbers committed
1 2 3 4 5 6
From iris.prelude Require Export strings.

Inductive intro_pat :=
  | IName : string  intro_pat
  | IAnom : intro_pat
  | IAnomPure : intro_pat
7
  | IDrop : intro_pat
Robbert Krebbers's avatar
Robbert Krebbers committed
8
  | IFrame : intro_pat
Robbert Krebbers's avatar
Robbert Krebbers committed
9 10 11
  | IPersistent : intro_pat  intro_pat
  | IList : list (list intro_pat)  intro_pat
  | ISimpl : intro_pat
Robbert Krebbers's avatar
Robbert Krebbers committed
12
  | IAlways : intro_pat
13 14
  | INext : intro_pat
  | IClear : list string  intro_pat.
Robbert Krebbers's avatar
Robbert Krebbers committed
15 16 17 18 19 20

Module intro_pat.
Inductive token :=
  | TName : string  token
  | TAnom : token
  | TAnomPure : token
21
  | TDrop : token
Robbert Krebbers's avatar
Robbert Krebbers committed
22
  | TFrame : token
Robbert Krebbers's avatar
Robbert Krebbers committed
23 24 25 26 27 28 29 30
  | TPersistent : token
  | TBar : token
  | TBracketL : token
  | TBracketR : token
  | TAmp : token
  | TParenL : token
  | TParenR : token
  | TSimpl : token
Robbert Krebbers's avatar
Robbert Krebbers committed
31
  | TAlways : token
32 33 34
  | TNext : token
  | TClearL : token
  | TClearR : token.
Robbert Krebbers's avatar
Robbert Krebbers committed
35 36 37 38 39 40 41 42 43

Fixpoint cons_name (kn : string) (k : list token) : list token :=
  match kn with "" => k | _ => TName (string_rev kn) :: k end.
Fixpoint tokenize_go (s : string) (k : list token) (kn : string) : list token :=
  match s with
  | "" => rev (cons_name kn k)
  | String " " s => tokenize_go s (cons_name kn k) ""
  | String "?" s => tokenize_go s (TAnom :: cons_name kn k) ""
  | String "%" s => tokenize_go s (TAnomPure :: cons_name kn k) ""
44
  | String "_" s => tokenize_go s (TDrop :: cons_name kn k) ""
Robbert Krebbers's avatar
Robbert Krebbers committed
45
  | String "$" s => tokenize_go s (TFrame :: cons_name kn k) ""
Robbert Krebbers's avatar
Robbert Krebbers committed
46 47 48 49 50 51 52 53
  | String "#" s => tokenize_go s (TPersistent :: cons_name kn k) ""
  | String "[" s => tokenize_go s (TBracketL :: cons_name kn k) ""
  | String "]" s => tokenize_go s (TBracketR :: cons_name kn k) ""
  | String "|" s => tokenize_go s (TBar :: cons_name kn k) ""
  | String "(" s => tokenize_go s (TParenL :: cons_name kn k) ""
  | String ")" s => tokenize_go s (TParenR :: cons_name kn k) ""
  | String "&" s => tokenize_go s (TAmp :: cons_name kn k) ""
  | String "!" s => tokenize_go s (TAlways :: cons_name kn k) ""
Robbert Krebbers's avatar
Robbert Krebbers committed
54
  | String ">" s => tokenize_go s (TNext :: cons_name kn k) ""
55 56
  | String "{" s => tokenize_go s (TClearL :: cons_name kn k) ""
  | String "}" s => tokenize_go s (TClearR :: cons_name kn k) ""
Robbert Krebbers's avatar
Robbert Krebbers committed
57 58 59 60 61 62 63 64 65 66 67
  | String "/" (String "=" s) => tokenize_go s (TSimpl :: cons_name kn k) ""
  | String a s => tokenize_go s k (String a kn)
  end.
Definition tokenize (s : string) : list token := tokenize_go s [] "".

Inductive stack_item :=
  | SPat : intro_pat  stack_item
  | SPersistent : stack_item
  | SList : stack_item
  | SConjList : stack_item
  | SBar : stack_item
68 69
  | SAmp : stack_item
  | SClear : stack_item.
Robbert Krebbers's avatar
Robbert Krebbers committed
70 71 72 73 74 75 76 77 78 79
Notation stack := (list stack_item).

Fixpoint close_list (k : stack)
    (ps : list intro_pat) (pss : list (list intro_pat)) : option stack :=
  match k with
  | SList :: k => Some (SPat (IList (ps :: pss)) :: k)
  | SPat pat :: k => close_list k (pat :: ps) pss
  | SPersistent :: k =>
     '(p,ps)  maybe2 (::) ps; close_list k (IPersistent p :: ps) pss
  | SBar :: k => close_list k [] (ps :: pss)
80
  | _ => None
Robbert Krebbers's avatar
Robbert Krebbers committed
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
  end.

Fixpoint big_conj (ps : list intro_pat) : intro_pat :=
  match ps with
  | [] => IList [[]]
  | [p] => IList [[ p ]]
  | [p1;p2] => IList [[ p1 ; p2 ]]
  | p :: ps => IList [[ p ; big_conj ps ]]
  end.

Fixpoint close_conj_list (k : stack)
    (cur : option intro_pat) (ps : list intro_pat) : option stack :=
  match k with
  | SConjList :: k =>
     ps  match cur with
          | None => guard (ps = []); Some [] | Some p => Some (p :: ps)
          end;
     Some (SPat (big_conj ps) :: k)
  | SPat pat :: k => guard (cur = None); close_conj_list k (Some pat) ps
  | SPersistent :: k => p  cur; close_conj_list k (Some (IPersistent p)) ps
  | SAmp :: k => p  cur; close_conj_list k None (p :: ps)
102 103 104 105 106 107 108 109
  | _ => None
  end.

Fixpoint close_clear (k : stack) (ss : list string) : option stack :=
  match k with
  | SPat (IName s) :: k => close_clear k (s :: ss)
  | SClear :: k => Some (SPat (IClear (reverse ss)) :: k)
  | _ => None
Robbert Krebbers's avatar
Robbert Krebbers committed
110 111 112 113 114 115 116 117
  end.

Fixpoint parse_go (ts : list token) (k : stack) : option stack :=
  match ts with
  | [] => Some k
  | TName s :: ts => parse_go ts (SPat (IName s) :: k)
  | TAnom :: ts => parse_go ts (SPat IAnom :: k)
  | TAnomPure :: ts => parse_go ts (SPat IAnomPure :: k)
118
  | TDrop :: ts => parse_go ts (SPat IDrop :: k)
Robbert Krebbers's avatar
Robbert Krebbers committed
119
  | TFrame :: ts => parse_go ts (SPat IFrame :: k)
Robbert Krebbers's avatar
Robbert Krebbers committed
120 121 122 123 124 125 126 127 128
  | TPersistent :: ts => parse_go ts (SPersistent :: k)
  | TBracketL :: ts => parse_go ts (SList :: k)
  | TBar :: ts => parse_go ts (SBar :: k)
  | TBracketR :: ts => close_list k [] [] = parse_go ts
  | TParenL :: ts => parse_go ts (SConjList :: k)
  | TAmp :: ts => parse_go ts (SAmp :: k)
  | TParenR :: ts => close_conj_list k None [] = parse_go ts
  | TSimpl :: ts => parse_go ts (SPat ISimpl :: k)
  | TAlways :: ts => parse_go ts (SPat IAlways :: k)
Robbert Krebbers's avatar
Robbert Krebbers committed
129
  | TNext :: ts => parse_go ts (SPat INext :: k)
130 131
  | TClearL :: ts => parse_go ts (SClear :: k)
  | TClearR :: ts => close_clear k [] = parse_go ts
Robbert Krebbers's avatar
Robbert Krebbers committed
132 133 134 135 136 137 138 139 140 141
  end.
Definition parse (s : string) : option (list intro_pat) :=
  match k  parse_go (tokenize s) [SList]; close_list k [] [] with
  | Some [SPat (IList [ps])] => Some ps
  | _ => None
  end.

Ltac parse s :=
  lazymatch type of s with
  | list intro_pat => s
142 143 144 145 146 147 148 149
  | list string =>
     lazymatch eval vm_compute in (mjoin <$> mapM parse s) with
     | Some ?pats => pats | _ => fail "invalid list intro_pat" s
     end
  | string =>
     lazymatch eval vm_compute in (parse s) with
     | Some ?pats => pats | _ => fail "invalid list intro_pat" s
     end
Robbert Krebbers's avatar
Robbert Krebbers committed
150 151 152 153
  end.
Ltac parse_one s :=
  lazymatch type of s with
  | intro_pat => s
154 155 156 157
  | string =>
     lazymatch eval vm_compute in (parse s) with
     | Some [?pat] => pat | _ => fail "invalid intro_pat" s
     end
Robbert Krebbers's avatar
Robbert Krebbers committed
158 159
  end.
End intro_pat.