stau.space
Image Unit Processing Interface.
INFO: This is a mirror from GitHub.
github.com/sona-tau/iupi
1#lang plait
2
3(require "utilities.rkt")
4(require "types.rkt")
5
6;----- Parser 'a applicative -----;
7; The following applicative implementations for (Parser 'a) were taken
8; from the prelude implementation of haskell at:
9; https://hackage.haskell.org/package/base-4.19.1.0/docs/src/GHC.Base.html
10; Creates a parser that parses (x) regardless of input
11(define (pure [x : 'a]) : (Parser 'a)
12 (λ (input)
13 (ok (pair input x))))
14
15;----- Parser Combinators -----;
16; Creates a parser that runs the entire list of parsers through an input and
17; returns an (ok) variant if any of them succeed
18(define (or/p [ps : (Listof (Parser 'a))]) : (Parser 'a)
19 (λ (input)
20 (let ([res1 ((first ps) input)])
21 (foldr alt res1 (map (λ (p) (p input)) (rest ps))))))
22
23; Creates a parser out of two parsers that will sequence them.
24(define (seq/p [p1 : (Parser 'a)] [p2 : (Parser 'b)]) : (Parser ('a * 'b))
25 (λ (input) (do (p1 input)
26 (λ (res1) (do (p2 (fst res1))
27 (λ (res2) (return (fst res2) (pair (snd res1) (snd res2)))))))))
28
29; Creates a parser that parses either (p1) or (p2)
30(define (alt/p [p1 : (Parser 'a)] [p2 : (Parser 'a)]) : (Parser 'a)
31 (λ (input) (alt (p1 input) (p2 input))))
32
33; Creates a parser that will parse the input 0 or more times. Like using "*" in
34; a RegEx.
35(define (many/p [p : (Parser 'a)]) : (Parser (Listof 'a))
36 (alt/p (many1/p p) (pure '())))
37
38; Creates a parser that parses the input 1 or more times. Like using "+" in a
39; RegEx.
40(define (many1/p [p : (Parser 'a)]) : (Parser (Listof 'a))
41 (λ (input) (type-case (ParseResult 'a) (p input)
42 [(ok first) (type-case (ParseResult (Listof 'a)) ((many/p p) (fst first))
43 [(ok rest) (ok (pair (fst rest) (append (list (snd first)) (snd rest))))]
44 [(err) (err)])]
45 [(err) (err)])))
46
47; Creates a parser out of two parsers that sequentially applies them. But will
48; only return the result of the first parser with the rest of the input from the
49; second parser.
50(define (left/p [l : (Parser 'a)] [r : (Parser 'b)]) : (Parser 'a)
51 (λ (input) (do (l input)
52 (λ (result1) (do (r (fst result1))
53 (λ (result2) (return (fst result2) (snd result1))))))))
54
55; Creates a parser out of two parsers that sequentially applies them. But will
56; only return the result of the second parser.
57(define (right/p [l : (Parser 'a)] [r : (Parser 'b)]) : (Parser 'b)
58 (λ (input) (do (l input)
59 (λ (result1) (do (r (fst result1))
60 (λ (result2) (ok result2)))))))