gage unwinding stable

This commit is contained in:
Anton Dyudin 2015-05-26 13:56:21 -07:00
parent cab4b671a6
commit c2641a464a
4 changed files with 46 additions and 28 deletions

View File

@ -149,7 +149,7 @@
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
== ::
++ sign ::
$% [%made p=@uvH q=(each gage tang)] ::
$% [%made p=@uvH q=gage] ::
[%unto p=cuft] ::
== ::
-- ::
@ -227,7 +227,7 @@
(ifix [sel ser] (stag %tu (most ace dp-source)))
==
::
++ dp-goal :: ++goal
++ dp-goal :: ++goal
%+ cook |=(a=goal a)
;~ pose
;~ plug
@ -627,13 +627,12 @@
[& %$ "> "]
::
++ he-made :: result from ford
|= [way=wire dep=@uvH reg=(each gage tang)]
|= [way=wire dep=@uvH reg=gage]
^+ +>
?> ?=(^ poy)
=< he-pine
?- -.reg
%& ?> ?=(@ p.p.reg)
%. p.reg
%& %. p.reg
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
[%hand ~] dy-hand:dye
@ -642,6 +641,7 @@
[%edit ~] dy-made-edit:dye
==
%| (he-diff(poy ~) %tan p.reg)
%tabl !!
==
::
++ he-unto :: result from behn
@ -742,7 +742,7 @@
he-abet:(~(he-type he [ost ~] (~(got by hoc) ost)) act)
::
++ made
|= [then dep=@uvH reg=(each gage tang)]
|= [then dep=@uvH reg=gage]
he-abet:(~(he-made he [[ost ~] (~(got by hoc) ost)]) way dep reg)
::
++ unto

View File

@ -119,7 +119,7 @@
(ably (take-mere:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ made-kiln ::
|= [then @uvH (each gage tang)]
|= [then @uvH gage]
(ably (take-made:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ init-helm ::

View File

@ -765,7 +765,7 @@
:- ((hard path) q.q.pax)
?. ?=(%mime p.mim)
~
`((hard mime) q:(slot 3 q.mim))
`((hard mime) q.q.mim)
==
==
::

View File

@ -57,8 +57,6 @@
$% [%talk-command command:talk] ::
[%hood-merge hood-merge] ::
== ::
++ tage :: %tabl gage
,[[%tabl p=(list (pair marc marc))] q=vase] ::
++ move (pair bone card) :: user-level move
--
|_ moz=(list move)
@ -89,7 +87,7 @@
abet:abet:(mere:(take way) are)
::
++ take-made ::
|= [way=wire dep=@uvH reg=(each gage tang)]
|= [way=wire dep=@uvH reg=gage]
abet:abet:(made:(take way) dep reg)
::
++ take-coup-fancy ::
@ -117,22 +115,42 @@
~| %kiln-work-fail
!!
::
++ gage-to-tage ::
|= res=gage
^- tage
?@ p.res
~|(%bad-marc !!)
res
++ ford-fail
|= tan=tang
~| %ford-fail
|-
?~ tan !!
~> %mean.|.(i.tan) :: interpolate into stack trace
$(tan t.tan)
::
++ tage-to-cages ::
|= tab=tage
^- (list (pair cage cage))
?~ p.tab
~
:_ $(p.tab t.p.tab, q.tab (slot 3 q.tab))
~| %strange-gage
:- [?^(p.i.p.tab !! p.i.p.tab) (slot 4 q.tab)]
[?^(q.i.p.tab !! q.i.p.tab) (slot 5 q.tab)]
++ unwrap-tang
|* res=(each ,* tang)
?: ?=(%& -.res)
p.res
(ford-fail p.res)
::
++ gage-to-cages
|= gag=gage ^- (list (pair cage cage))
(unwrap-tang (gage-to-tage gag))
::
++ gage-to-tage
|= gag=gage
^- (each (list (pair cage cage)) tang)
?. ?=(%tabl -.gag)
(mule |.(`~`(ford-fail >%strange-gage< ~)))
=< ?+(. [%& .] [@ *] .)
|- ^- ?((list ,[cage cage]) (each ,~ tang))
?~ p.gag ~
=* hed i.p.gag
?- -.p.hed
%tabl (mule |.(`~`(ford-fail >%strange-gage< ~)))
%| (mule |.(`~`(ford-fail p.p.hed)))
%& ?- -.q.hed
%tabl (mule |.(`~`(ford-fail >%strange-gage< ~)))
%| (mule |.(`~`(ford-fail p.q.hed)))
%& =+ $(p.gag t.p.gag)
?+(- [[p.p p.q]:hed -] [@ *] -)
== ==
::
++ perform ::
^+ .
@ -260,13 +278,13 @@
==
::
++ made
|= [dep=@uvH reg=(each gage tang)]
|= [dep=@uvH reg=gage]
^+ +>
?: ?=(%| -.reg)
=+ "failed to mash"
lose:(spam leaf/- p.reg)
=+ ^- can=(list (pair path (unit miso)))
%+ turn (tage-to-cages (gage-to-tage p.reg))
%+ turn (gage-to-cages reg)
|= [pax=cage dif=cage]
^- (pair path (unit miso))
?. ?=(%path p.pax)