ulam -- self-describing hoon data structures

ulam.hoon

=>
|%
+$  ulam
  $~  [%coin *coin]
  ::  leaves
  ::
  $%  [%coin =coin]                            ::  atom, noun, or compound coin
      [%path =pith]                            ::  hoon path syntax
      [%page =mark noun=*]                     ::  %foo|bar, bar is coin blob
  ::
  ::  containers
  ::
      [%list p=(list ulam)]                ::  [item, item, item]
      [%map p=((mop ulam ulam) lte-ulam)]  ::  {key: value, key: value}
  ==
::
++  lte-ulam
  |=  [a=ulam b=ulam]
  ^-  ?
  ?.  =(-.a -.b)  (aor -.a -.b)
  ?-  -.a
    %coin  ?>(?=(%coin -.b) (lte-coin coin.a coin.b))
    %path  ?>(?=(%path -.b) (lte-pith pith.a pith.b))
    %page  ?>(?=(%page -.b) (lte-page +.a +.b))
    %list  ?>(?=(%list -.b) (lte-ulam-list p.a p.b))
    %map   ?>(?=(%map -.b) (lte-ulam-map p.a p.b))
  ==
::
++  lte-coin
  |=  [a=coin b=coin]
  ^-  ?
  ?.  =(-.a -.b)  (aor -.a -.b)
  ?-  -.a
    %$     ?>(?=(%$ -.b) (lte-dime p.a p.b))
    %many  ?>(?=(%many -.b) (lte-coin-many p.a p.b))
    %blob  ?>(?=(%blob -.b) (lte-noun p.a p.b))
  ==
::
++  lte-dime
  |=  [a=dime b=dime]
  ^-  ?
  ?.  =(p.a p.b)  
    (aor -.a -.b)
  ?+  p.a  (lte q.a q.b)
    %rd             (lte:rd q.a q.b)
    %rh             (lte:rh q.a q.b)
    %rq             (lte:rq q.a q.b)
    %rs             (lte:rs q.a q.b)
    %s              !=(--1 (cmp:si q.a q.b))
    ?(%t %ta %tas)  (aor q.a q.b)
  ==
::
++  lte-coin-many
  |=  [a=(list coin) b=(list coin)]
  ^-  ?
  ?~  a  &
  ?~  b  |
  ?.  =(i.a i.b)
    (lte-coin i.a i.b)
  $(a t.a, b t.b)
::
++  lte-noun
  |=  [a=* b=*]
  ^-  ?
  (aor a b)
::
++  lte-pith
  |=  [a=pith b=pith]
  ^-  ?
  ?~  a  &
  ?~  b  |
  ?.  =(i.a i.b)
    %+  lte-dime
      ?^(i.a i.a [%tas i.a])
    ?^(i.b i.b [%tas i.b])
  $(a t.a, b t.b)
::
++  lte-ulam-list
  |=  [a=(list ulam) b=(list ulam)]
  ^-  ?
  ?~  a  &
  ?~  b  |
  ?.  =(i.a i.b)
    (lte-ulam i.a i.b)
  $(a t.a, b t.b)
::
++  lte-ulam-map
  |=  [a=((mop ulam ulam) lte-ulam) b=((mop ulam ulam) lte-ulam)]
  ^-  ?
  (gor a b)  ::  no natural ordering for maps; use mug
::
++  lte-page
  |=  [a=page b=page]
  ^-  ?
  ?.  =(p.a p.b)
    (aor p.a p.b)
  (lte-noun q.a q.b)
--
|%
++  parser
  =<  apex
  |%
  ++  apex
    %+  knee  *ulam  |.  ~+
    ;~  pose
      (ifix [;~(plug sel gay) ;~(plug gay ser)] (stag %list parse-list))
      (ifix [;~(plug kel gay) ;~(plug gay ker)] (stag %map parse-pairs))
      (ifix [soq soq] :(stag %coin %$ %t sym))
      (stag %coin ;~(less sym nuck:so))
      parse-path
      parse-page
    ==
  ::
  ++  parse-list
    %+  knee  *(list ulam)  |.  ~+
    (most ;~(plug com gaw) apex)
  ::
  ++  parse-pairs
    %+  cook
      =|  m=((mop ulam ulam) lte-ulam)
      |=  a=(list [ulam ulam])
      ^+  m
      (gas:((on ulam ulam) lte-ulam) m a)
    %+  knee  *(list [ulam ulam])  |.  ~+
    (most ;~(plug com gaw) ;~(plug apex ;~(pfix ;~(plug col gaw) apex)))
  ::
  ++  parse-path
    %+  cook
      |=  =hoon
      ^-  ulam
      [%path !<(pith (slap !>(~) hoon))]
    reed:vast
  ::
  ++  parse-page
    %+  cook
      |=  [=term =coin]
      ^-  ulam
      =/  =noun  ?>(?=(%blob -.coin) p.coin)
      [%page term noun]
    ;~(plug ;~(pfix cen sym) ;~(pfix bar nuck:so))
  --
++  exs  [ex1 ex2 ex3 ex5 ex6 ex7 ex8 ex9 example-full]
++  ex1
  =-  (need (rush - parser))
  '~zod'
++  ex2
  =-  (need (rush - parser))
  '0x0'
++  ex3
  =-  (need (rush - parser))
  '\'foo\''
++  ex5
  =-  ?^  (rush - parser)  !!  ~
  'foo'
++  ex6
  =-  (need (rush - parser))
  '{0 1}'
++  ex7
  =-  (need (rush - parser))
  '%mime|~09jq3e9gm4u0eurr6f05'
++  ex8
  =-  (need (rush - parser))
  '[0x0, 0x0]'
++  ex9
  =-  (need (rush - parser))
  '{0x0: 0x0, 0x1: 0x1}'
++  example-full
  =-  (need (rush - parser))
  '''
  {
    ~zod: 'foo',
    ~nec: [0x0, 'foo'],
    ~nus: [0x0, 'foo', {~2023.7.12: ~bus}],
    ~bud: /foo/3/~2000.1.1,
    ~wes: {
      'foo': 0x0,
      'bar': %mime|~09jq3e9gm4u0eurr6f05,
      ['foo', 'bar']: 3.000,
      {~zod: 3}: 4
    }
  }
  '''
++  example-json
  '''
  {
    "~zod": "'foo'",
    "~nec": ["0x0", "'foo'"],
    "~nus": ["0x0", "'foo'", {"~2023.7.12": "~bus"}],
    "~bud": "/foo/3/~2000.1.1",
    "~wes": {
      "'foo'": "0x0",
      "'bar'": "%mime|~09jq3e9gm4u0eurr6f05",
      "['foo', 'bar']": "3.000",
      "{~zod: 3}": "4"
    }
  }
  '''
--