125 lines
3.9 KiB
Standard ML
125 lines
3.9 KiB
Standard ML
datatype re
|
|
= Chr of int
|
|
| Cat of re * re
|
|
| Alt of re * re
|
|
| Star of re
|
|
|
|
(* accept : re -> int list -> (int list -> bool) -> bool *)
|
|
(* accept_star : re -> int list -> (int list -> bool) -> bool *)
|
|
fun accept (Chr c) (x::xs) k
|
|
= (c=x) andalso (k xs)
|
|
| accept (Cat (r1,r2)) l k
|
|
(* = accept r1 l (fn xs => *)
|
|
(* accept r2 xs (fn ys => k ys)) *)
|
|
= accept r1 l (fn xs => accept r2 xs k)
|
|
| accept (Alt (r1,r2)) l k
|
|
(* = (accept r1 l (fn xs => k xs)) orelse *)
|
|
(* (accept r2 l (fn xs => k xs)) *)
|
|
= (accept r1 l k) orelse (accept r2 l k)
|
|
| accept (Star r1) l k = accept_star r1 l k
|
|
| accept _ _ _ = false
|
|
and accept_star r l k
|
|
= (k l) orelse (accept r l (fn xs => accept_star r xs k))
|
|
|
|
(* match : re -> int list -> bool *)
|
|
fun match r l = accept r l (fn xs => xs=nil)
|
|
|
|
datatype kont
|
|
(* (fn xs => xs=nil) *)
|
|
= KNil
|
|
(* (fn xs => accept r2 xs k) *)
|
|
| KAcc of re * kont
|
|
(* (fn xs => accept_star r xs k) *)
|
|
| KStar of re * int list * kont
|
|
|
|
(* acceptDef: re -> int list -> kont -> bool *)
|
|
fun acceptDef (Chr c) (x::xs) k
|
|
= (c=x) andalso (k xs)
|
|
| acceptDef (Cat (r1,r2)) l k
|
|
= acceptDef r l (KAcc (r2, k))
|
|
| acceptDef (Alt (r1,r2)) l k
|
|
= (acceptDef r1 l k) orelse (acceptDef r2 l k)
|
|
| acceptDef (Star r1) l k = accept_starDef r1 l k
|
|
and apply KNil l = l=nil
|
|
| apply (KAcc (r,k)) l = acceptDef r l k
|
|
| apply (KStar (r,ll,k)) l = accept_starDef r ll k
|
|
and accept_starDef r l k = acceptDef r l KNil
|
|
|
|
(* (* datatype kont *) *)
|
|
(* (* = KNil (* (fn xs => xs=nil) *) *) *)
|
|
(* (* | Kont of kont (* (fn xs => k xs) *) *) *)
|
|
(* (* (* (fn xs => accept r2 xs (fn ys => k ys)) *) *) *)
|
|
(* (* | KNst of re * kont *) *)
|
|
|
|
(* val re0 = Cat (Chr 0, Cat (Chr 0, Cat (Chr 1, Chr 1))) *)
|
|
(* val rv0t = accept re0 [0,0,1,1] (fn xs=>xs=nil) (* true : bool *) *)
|
|
(* val rv0f = accept re0 [0,0,1] (fn xs=>xs=nil) (* false : bool *) *)
|
|
|
|
(* (* match re0 [0,0,1,1]; *) *)
|
|
(* (* val it = true : bool *) *)
|
|
(* (* - match re0 [0,0,1]; *) *)
|
|
(* (* val it = false : bool *) *)
|
|
|
|
|
|
|
|
|
|
(*****************************************************************)
|
|
|
|
(* (* walk : int list -> (int list -> bool) -> bool *) *)
|
|
(* fun walk (0::xs, k) *)
|
|
(* = walk (xs, fn (1::ys) => k ys *)
|
|
(* | _ => false) *)
|
|
(* | walk (xs, k) = k xs *)
|
|
(* (* Base case: xs == nil *) *)
|
|
(* (* Father... Is it over..? No king rules forever son.. *) *)
|
|
|
|
(* (* go : int list -> bool *) *)
|
|
(* fun go xs = walk (xs, fn l => l = nil) *)
|
|
(* (* go [1,2,3]; *) *)
|
|
(* (* val it = false : bool *) *)
|
|
(* (* - go [0,0,0,1,1,1]; *) *)
|
|
(* (* val it = true : bool *) *)
|
|
|
|
(* (* *) *)
|
|
(* (* Function as argument => [fn] usages. *) *)
|
|
(* (* So there are two of them. *) *)
|
|
(* (* *) *)
|
|
|
|
(* datatype kont *)
|
|
(* = KId *)
|
|
(* | KWalk of kont *)
|
|
|
|
(* (* apply: kont * int list -> bool *) *)
|
|
(* fun apply (KId, xs) = xs=nil *)
|
|
(* | apply (KWalk k, 1::xs) = apply (k, xs) *)
|
|
(* | apply (KWalk _, _) = false *)
|
|
|
|
(* (* walkDef : int list -> kont -> bool *) *)
|
|
(* fun walkDef (0::xs) k = walkDef xs (KWalk k) *)
|
|
(* | walkDef xs k = apply (k, xs) *)
|
|
|
|
(* fun goDef xs = walkDef xs KId *)
|
|
(* (* - goDef [0,0,1,1]; *) *)
|
|
(* (* val it = true : bool *) *)
|
|
(* (* - goDef [0,0,1]; *) *)
|
|
(* (* val it = false : bool *) *)
|
|
|
|
(* (*********************** Peano arithmetic **************************************) *)
|
|
|
|
(* (* apply: int * int list -> bool *) *)
|
|
(* fun applyP (0, xs) = xs=nil *)
|
|
(* | applyP (k, 1::xs) = applyP (k-1, xs) *)
|
|
(* | applyP _ = false *)
|
|
|
|
(* (* walkDef : int list -> int -> bool *) *)
|
|
(* fun walkDefP (0::xs) k = walkDefP xs (k+1) *)
|
|
(* | walkDefP xs k = applyP (k, xs) *)
|
|
|
|
(* fun goDefP xs = walkDefP xs 0 *)
|
|
(* (* - goDefP [1,1,0]; *) *)
|
|
(* (* val it = false : bool *) *)
|
|
(* (* - goDefP [0,0,1,1]; *) *)
|
|
(* (* val it = true : bool *) *)
|
|
(* (* - goDefP [0,0,0,1,1,1]; *) *)
|
|
(* (* val it = true : bool *) *)
|