summaryrefslogtreecommitdiff
path: root/src/Obs/Syntax.idr
blob: 4a7ee0ca19d94999c22cd99033ff38d3af13116e (plain)
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
||| Raw syntax for terms. This is before eliminating names.
module Obs.Syntax

import Obs.Sort
import Text.Bounded
import Text.PrettyPrint.Prettyprinter

%default total

-- Definition ------------------------------------------------------------------

public export
data Syntax : Type where
  Var    : WithBounds String -> Syntax
  -- Sorts
  Sort   : Bounds -> Sort -> Syntax
  -- Dependent Products
  Pi     : Bounds -> WithBounds String -> Syntax -> Syntax -> Syntax
  Lambda : Bounds -> WithBounds String -> Syntax -> Syntax
  App    : Syntax -> Syntax -> Syntax
  -- True
  Top    : Bounds -> Syntax
  Point  : Bounds -> Syntax
  -- False
  Bottom : Bounds -> Syntax
  Absurd : Bounds -> Syntax -> Syntax -> Syntax

public export
record Definition where
  constructor MkDefinition
  bounds : Bounds -- of the name
  name   : String
  ty     : Syntax
  tm     : Syntax

-- Pretty Print ----------------------------------------------------------------

export
Pretty Syntax where
  prettyPrec d (Var var) = pretty var.val
  prettyPrec d (Sort _ s) = prettyPrec d s
  prettyPrec d (Pi _ var a b) =
    parenthesise (d > Open) $
    group $
    parens (pretty var.val <++> colon <+> softline <+> prettyPrec Open a) <++>
    pretty "->" <+> softline <+>
    prettyPrec Open b
  prettyPrec d (Lambda _ var t) =
    parenthesise (d > Open) $
    group $
    backslash <+> pretty var.val <++>
    pretty "=>" <+> softline <+>
    prettyPrec Open t
  prettyPrec d (App t u) =
    parenthesise (d >= App) $
    group $
    fillSep [prettyPrec Open t, prettyPrec App u]
  prettyPrec d (Top _) = pretty "()"
  prettyPrec d (Point _) = pretty "*"
  prettyPrec d (Bottom _) = pretty "Void"
  prettyPrec d (Absurd _ a t) =
    parenthesise (d >= App) $
    group $
    fillSep [pretty "absurd", prettyPrec App a, prettyPrec App t]

export
Pretty Definition where
  pretty def = group $
    pretty def.name <++> colon <+> softline <+> pretty def.ty <+> hardline <+>
    pretty def.name <++> equals <+> softline <+> pretty def.tm