ambdown.str 2.28 KB
Newer Older
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
module ambdown
imports

  lib
  AsFix2-Syntax

signature
  constructors
    amb : List(Term) -> Term
    appl : Term * Term -> Term

strategies

  merge = rec x(
              ([], [])
	    ; ![]
	    <+ {l1, l2:
	         ?([l1], [l2])
	       ; ![<conc> ([l1], l2)]
	       }
	    <+ {l1, l2, l1s, l2s:
	         ?([l1|l1s], [l2|l2s])
	       ; <conc> ([<conc> ([l1], l2)], <x> (l1s, l2s))
	       })

  myzip = rec x(
              []
	    <+   [id]
	       ; {l:
	           [  map(![<id>])
		    ; ?l]
		 ; !l
                 }
	    <+ {l, ls:
	         ?[l|ls]
	       ; <x> ls
	       ; <merge> (l, <id>)
	       })

  only-one(s) = rec x([s|id] < [id|map(not(s))] + [id|x])

  putdown =   amb(map(?appl(pr,_)))
            ; amb(map({e: ?appl(_,e); !e })
	    ; myzip
	    ; map(uniq)
	    ; map({e: ?[e]; !e} <+ !amb(<id>)); ?ambs)
            ; !ambs
            ; only-one(amb(not(map(appl(prod(id,cf(opt(layout)),id),id)))))
	    ; !appl(pr, ambs)

  delete-last-layout =
              rec x(
                []
             <+ ([appl(prod(id,cf(opt(layout)),id),id),
                  appl(prod([],cf(opt(id)),id), id)]
               ; [appl(prod(![], id, id), ![]), id])
             <+ [id|x])

  delete-misplaced-layout =
              alltd(amb(map(try(appl(prod(at-last(cf(opt(id))), id, id), id)
                              ; delete-last-layout))))

  empty-layout = appl(prod([],cf(opt(layout)),no-attrs),[])

  clean-layout = amb(filter(not(empty-layout)))
               ; ?amb([l])
               ; !l

  replace-each-layout =
               rec x(
                   []
                <+ (try({l, ls, m, ms:
                       ?[l|ls]
                     ; !ls
                     ; ?[m|ms]
                     ; !m
                     ; amb(map(appl(prod(id, cf(opt(layout)), id), id)))
                     ; <delete-misplaced-layout> l => l'
                     ; <clean-layout> m => m'
                     ; ![l'|[m'|ms]] })
                   ; [id|x]))

  replace-layout = appl(id, one(amb(map(appl(prod(id,
                                                  cf(opt(layout)),
                                                  id), id))))
                          ; replace-each-layout)

  ambdown =   iowrap(topdown(repeat(putdown))
                   ; topdown(try(replace-layout)))