Skip to content
Adam Bliss edited this page Oct 25, 2013 · 1 revision

Implementation

++  al 
  =+  [nag=`*`& gom=`axis`1]
  |_  sec=tile
  ::::
  ++  blah  ^~  [%dtsg %$ 0]
  ++  home  |=(gen=gene ^-(gene ?:(=(1 gom) gen [%tsgr [~ gom] gen])))
  ::::
  ++  bunt
    |-  ^-  gene
    ?-    sec
        [^ *]
      [$(sec p.sec) $(sec q.sec)]
    ::
        [%base *]
      ?-  p.sec
        [%atom *]  [%dtpt p.p.sec 0]
        %noun      [%dttr [%dtsg %$ 0] [[%dtsg %$ 0] [%dtsg %$ 1]]]
        %cell      =+(nec=$(sec [%base %noun]) [nec nec])
        %bean      [%dtts [%dtsg %$ 0] [%dtsg %$ 0]]
        %null      [%dtsg %n %$]
      ==
    ::
        [%bark *]
      [%ktts p.sec $(sec q.sec)]
    ::
        [%bush *]
      [%wtcl [%bcts %bean] $(sec p.sec) $(sec q.sec)]
    :: 
        [%fern *]
      |-  ^-  gene
      ?@  t.p.sec
        ^$(sec i.p.sec)
      [%wtcl [%bcts %bean] ^$(sec i.p.sec) $(p.sec t.p.sec)]
    ::
        [%herb *]
      (home [%tsgl [%cnbc %$] p.sec])
    ::
        [%kelp *]
      |-  ^-  gene
      ?@  t.p.sec
        ^$(sec i.p.sec)
      [%wtcl [%bcts %bean] ^$(sec i.p.sec) $(p.sec t.p.sec)]
    ::
        [%leaf *]
      [%dtsg p.sec q.sec]
    ::
        [%reed *]
      [%wtcl [%bcts %bean] $(sec p.sec) $(sec q.sec)]
    ::
        [%weed *] 
      (home p.sec)
    ==
  ++  clam  ^-(gene [%brts [%bcts %noun] %sgls 0 (whip(gom 7) 6)])
  ++  whip
    |=  axe=axis
    =+  ^=  tun
        |=  noy=_|+(* *gene)
        ^-  gene
        ?@  nag
          =+  luz=[%cnts [[~ 1] ~] [[~ axe] bunt(sec [%base %cell])] ~]
          ?:  =(& nag)
            [%tsgr [%wtpt [~ axe] luz [~ 1]] (noy [& &])]
          [%tsgr luz (noy [& &])]
        (noy nag)
    ^-  gene
    ?-    sec 
        [^ *]
      %-  tun  |=  gon=*  =>  .(nag gon)  ^-  gene
      :-  ^$(sec -.sec, nag -.nag, axe (peg axe 2))
      ^$(sec +.sec, nag +.nag, axe (peg axe 3))
    ::
        [%base *]
      ?-    p.sec
          [%atom *] 
        =+  buv=bunt
        |-  ^-  gene
        ?@  nag
          ?:(=(& nag) [%wtpt [~ axe] $(nag |) buv] [%ktls buv [~ axe]])
        buv
      ::
          %noun
        [%kthp [%bcts %noun] [~ axe]]
      ::
          %cell   
        =+  buv=bunt
        |-  ^-  gene
        ?@  nag 
          ?:(=(& nag) [%wtpt [~ axe] buv $(nag [& &])] buv)
        [%ktls buv [~ axe]]
      ::
          %bean
        :^    %wtcl
            [%dtts [%dtsg %$ |] [~ axe]] 
          [%dtsg %f |]
        [%dtsg %f &]
      ::
          %null 
        bunt  
      ==
    ::
        [%bark *]
      [%ktts p.sec $(sec q.sec)]
    ::
        [%bush *]
      ?-  nag
        &  [%wtpt [~ axe] $(sec p.sec, nag |) $(sec q.sec, nag [& &])]
        |  $(sec p.sec)
        ^  $(sec q.sec)
        *  !!
      ==
    :: 
        [%fern *]
      |-  ^-  gene
      ?@  t.p.sec
        ^$(sec i.p.sec)
      :+  %tsls
        ^$(sec i.p.sec)
      =>  .(axe (peg 3 axe), gom (peg 3 gom))
      :^    %wtcl
          [%dtts [~ axe] [~ 2]]
        [~ 2]
      $(i.p.sec i.t.p.sec, t.p.sec t.t.p.sec)
    ::
        [%herb *]
      [%cnhp (home p.sec) [~ axe] ~]
    ::
        [%kelp *]
      %-  tun  |=  gon=*  =>  .(nag gon)  
      |-  ^-  gene
      ?@  t.p.sec
        :-  [%dtsg +.p.i.p.sec] 
        ^^$(axe (peg axe 3), sec q.i.p.sec, nag &)
      :^    %wtcl
          [%dtts [~ (peg axe 2)] [%dtsg +.p.i.p.sec]]
        :-  [%dtsg +.p.i.p.sec] 
        ^^$(axe (peg axe 3), sec q.i.p.sec, nag &)
      $(i.p.sec i.t.p.sec, t.p.sec t.t.p.sec)
    ::
        [%leaf *]
      [%dtsg p.sec q.sec]
    ::
        [%reed *]
      %-  tun  |=  gon=*  =>  .(nag gon)  ^-  gene
      ?@  -.nag
        ?:  =(& -.nag)
          [%wtpt [~ (peg axe 2)] ^$(sec q.sec) ^$(sec p.sec)]
        ^$(sec q.sec)
      ^$(sec p.sec)
    ::
        [%weed *] 
      =+  hom=(home p.sec)
      ~|  [%weed-made hom]
      hom 
      :: (home p.sec)
    ==
  -- 

Comments



Parts of this document are generated automatically. Edits within the comments section will be preserved.

Clone this wiki locally