/usr/share/racket/pkgs/datalog/pretty.rkt is in racket-common 6.7-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | #lang racket/base
(require racket/match
racket/list
racket/contract
"private/pprint.rkt"
"ast.rkt")
(define format-datum
(match-lambda
[(predicate-sym _ s)
(format-datum s)]
[(? symbol? s)
(text (symbol->string s))]
[(? string? s)
(text (format "~S" s))]
[(? number? s)
(text (format "~S" s))]
[x
(text (format "~v" x))]))
(define (format-variable v)
(format-datum (variable-sym v)))
(define (format-constant c)
(format-datum (constant-value c)))
(define format-term
(match-lambda
[(? variable? t)
(format-variable t)]
[(? constant? t)
(format-constant t)]))
(define (format-literal l)
(match l
[(struct literal (_ pred (list)))
(format-datum pred)]
[(struct literal (_ '= (list a b)))
(h-append (format-term a) space (text "=") space (format-term b))]
[(struct literal (_ pred terms))
(h-append (format-datum pred)
lparen
(v-concat/s (apply-infix ", " (map format-term terms)))
rparen)]))
(define format-external
(match-lambda
[(external _ pred-sym pred args anss)
(h-append (format-datum pred-sym)
lparen
(v-concat/s (apply-infix ", " (map format-term args)))
rparen
(text " = ")
lparen
(v-concat/s (apply-infix ", " (map format-term anss)))
rparen)]))
(define format-question
(match-lambda
[(? literal? l)
(format-literal l)]
[(? external? e)
(format-external e)]))
(define (format-questions ls)
(v-concat
(map (lambda (l)
(h-append (format-question l) dot))
ls)))
(define (format-clause c)
(if (empty? (clause-body c))
(format-literal (clause-head c))
(nest 4
(v-concat/s
(list* (h-append (format-literal (clause-head c)) space (text ":-") space)
(apply-infix ", " (map format-literal (clause-body c))))))))
(define (format-assertion a)
(h-append (format-clause (assertion-clause a))
dot))
(define (format-retraction r)
(h-append (format-clause (retraction-clause r))
(char #\~)))
(define (format-query q)
(h-append (format-question (query-question q))
(char #\?)))
(define (format-statement s)
(cond
[(assertion? s) (format-assertion s)]
[(retraction? s) (format-retraction s)]
[(query? s) (format-query s)]))
(define (format-program p)
(v-concat (map format-statement p)))
(provide/contract
[format-datum (datum/c . -> . doc?)]
[format-variable (variable? . -> . doc?)]
[format-constant (constant? . -> . doc?)]
[format-term (term/c . -> . doc?)]
[format-literal (literal? . -> . doc?)]
[format-questions ((listof question/c) . -> . doc?)]
[format-clause (clause? . -> . doc?)]
[format-assertion (assertion? . -> . doc?)]
[format-retraction (retraction? . -> . doc?)]
[format-query (query? . -> . doc?)]
[format-statement (statement/c . -> . doc?)]
[format-program (program/c . -> . doc?)])
|