result.mlish (3917B)
1 #lang s-exp "../../mlish.rkt" 2 (require "../rackunit-typechecking.rkt" "../../mlish-do.rkt") 3 4 (define-type (Result A B) 5 (Ok A) 6 (Error B)) 7 8 (define (ok [a : A] → (Result A B)) 9 (Ok a)) 10 (define (error [b : B] → (Result A B)) 11 (Error b)) 12 13 (provide-type Result) 14 (provide ok) 15 (provide error) 16 17 (check-type ok : (→/test A (Result A B))) 18 (check-type error : (→/test B (Result A B))) 19 (check-type (inst ok Int String) : (→ Int (Result Int String))) 20 (check-type (inst error String Int) : (→ String (Result Int String))) 21 22 (check-type 23 (list (Ok 3) (Error "abject failure") (Ok 4)) 24 : (List (Result Int String)) 25 -> (list (Ok 3) (Error "abject failure") (Ok 4))) 26 27 (define (result-bind [a : (Result A Er)] [f : (→ A (Result B Er))] 28 → (Result B Er)) 29 (match a with 30 [Ok v -> (f v)] 31 [Error er -> (Error er)])) 32 33 (provide result-bind) 34 35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 37 ;; read-tree, a function that parses a tree and uses the result monad. 38 39 (require "trees.mlish") 40 41 ;; Parsing 42 in base 10: (rev-list->int 10 (list 2 4) 1 0) yields 42. 42 (define (rev-list->int [base : Int] [rev-list : (List Int)] [place : Int] [accum : Int] → Int) 43 (cond 44 [(isnil rev-list) accum] 45 [else (rev-list->int base 46 (tail rev-list) 47 (* base place) 48 (+ accum (* place (head rev-list))))])) 49 50 (define (digit? [c : Char] → Bool) 51 (or (equal? c #\0) 52 (equal? c #\1) 53 (equal? c #\2) 54 (equal? c #\3) 55 (equal? c #\4) 56 (equal? c #\5) 57 (equal? c #\6) 58 (equal? c #\7) 59 (equal? c #\8) 60 (equal? c #\9))) 61 62 (define (digit->int [c : Char] → Int) 63 (string->number (string c))) 64 65 (define-type-alias (Read-Result A) (Result (× A (List Char)) String)) 66 67 (define (read-int [str : (List Char)] [accum : (List Int)] → (Read-Result Int)) 68 (cond 69 [(isnil str) 70 (cond [(isnil accum) (error "expected an int, given nothing")] 71 [else (ok (tup (rev-list->int 10 accum 1 0) str))])] 72 [(digit? (head str)) 73 (read-int (tail str) (cons (digit->int (head str)) accum))] 74 [else 75 (ok (tup (rev-list->int 10 accum 1 0) str))])) 76 77 (define (read-tree [str : (List Char)] → (Read-Result (Tree Int))) 78 (cond 79 [(isnil str) 80 (error "expected a tree of integers, given nothing")] 81 [(equal? (head str) #\( ) 82 (let ([do-ok (inst ok Unit String)] 83 [do-error (inst error String Unit)]) 84 (do result-bind 85 [tree1+str <- (read-tree (tail str))] 86 [(cond [(equal? (head (proj tree1+str 1)) #\space) 87 (do-ok (void))] 88 [else (do-error "expected a space")])] 89 [int+str <- (read-int (tail (proj tree1+str 1)) nil)] 90 [(cond [(equal? (head (proj int+str 1)) #\space) 91 (do-ok (void))] 92 [else (do-error "expected a space")])] 93 [tree2+str <- (read-tree (tail (proj int+str 1)))] 94 [(cond [(equal? (head (proj tree2+str 1)) #\) ) 95 (do-ok (void))] 96 [else (do-error "expected a `)`")])] 97 (ok 98 (tup (Node (proj tree1+str 0) 99 (proj int+str 0) 100 (proj tree2+str 0)) 101 (tail (proj tree2+str 1))))))] 102 [(digit? (head str)) 103 (do result-bind 104 [int+str <- (read-int str nil)] 105 (ok 106 (tup (Leaf (proj int+str 0)) 107 (proj int+str 1))))] 108 [else 109 (error "expected either a `(` or a digit")])) 110 111 (check-type 112 (read-tree (string->list "42")) 113 : (Read-Result (Tree Int)) 114 -> (ok 115 (tup (Leaf 42) nil))) 116 117 (check-type 118 (read-tree (string->list "x")) 119 : (Read-Result (Tree Int)) 120 -> (error 121 "expected either a `(` or a digit")) 122 123 (check-type 124 (read-tree (string->list "(42 43 (44 45 46))")) 125 : (Read-Result (Tree Int)) 126 -> (ok 127 (tup (Node (Leaf 42) 43 (Node (Leaf 44) 45 (Leaf 46))) nil))) 128 129