@@ -65,16 +65,78 @@ type clause struct {
6565
6666func compileClause (head Term , body Term , env * Env ) (clause , error ) {
6767 var c clause
68+ var goals []Term
69+
70+ head , goals = desugar (head , goals )
71+ body , goals = desugar (body , goals )
72+
73+ if body != nil {
74+ goals = append (goals , body )
75+ }
76+ if len (goals ) > 0 {
77+ body = seq (atomComma , goals ... )
78+ }
79+
6880 c .compileHead (head , env )
81+
6982 if body != nil {
7083 if err := c .compileBody (body , env ); err != nil {
7184 return c , typeError (validTypeCallable , body , env )
7285 }
7386 }
74- c .bytecode = append (c .bytecode , instruction {opcode : OpExit })
87+
88+ c .emit (instruction {opcode : OpExit })
7589 return c , nil
7690}
7791
92+ func desugar (term Term , acc []Term ) (Term , []Term ) {
93+ switch t := term .(type ) {
94+ case charList , codeList :
95+ return t , acc
96+ case list :
97+ l := make (list , len (t ))
98+ for i , e := range t {
99+ l [i ], acc = desugar (e , acc )
100+ }
101+ return l , acc
102+ case * partial :
103+ c , acc := desugar (t .Compound , acc )
104+ tail , acc := desugar (* t .tail , acc )
105+ return & partial {
106+ Compound : c .(Compound ),
107+ tail : & tail ,
108+ }, acc
109+ case Compound :
110+ if t .Functor () == atomSpecialDot && t .Arity () == 2 {
111+ tempV := NewVariable ()
112+ lhs , acc := desugar (t .Arg (0 ), acc )
113+ rhs , acc := desugar (t .Arg (1 ), acc )
114+
115+ return tempV , append (acc , atomDot .Apply (lhs , rhs , tempV ))
116+ }
117+
118+ c := compound {
119+ functor : t .Functor (),
120+ args : make ([]Term , t .Arity ()),
121+ }
122+ for i := 0 ; i < t .Arity (); i ++ {
123+ c .args [i ], acc = desugar (t .Arg (i ), acc )
124+ }
125+
126+ if _ , ok := t .(Dict ); ok {
127+ return & dict {c }, acc
128+ }
129+
130+ return & c , acc
131+ default :
132+ return t , acc
133+ }
134+ }
135+
136+ func (c * clause ) emit (i instruction ) {
137+ c .bytecode = append (c .bytecode , i )
138+ }
139+
78140func (c * clause ) compileHead (head Term , env * Env ) {
79141 switch head := env .Resolve (head ).(type ) {
80142 case Atom :
@@ -88,7 +150,7 @@ func (c *clause) compileHead(head Term, env *Env) {
88150}
89151
90152func (c * clause ) compileBody (body Term , env * Env ) error {
91- c .bytecode = append ( c . bytecode , instruction {opcode : OpEnter })
153+ c .emit ( instruction {opcode : OpEnter })
92154 iter := seqIterator {Seq : body , Env : env }
93155 for iter .Next () {
94156 if err := c .compilePred (iter .Current (), env ); err != nil {
@@ -107,16 +169,16 @@ func (c *clause) compilePred(p Term, env *Env) error {
107169 case Atom :
108170 switch p {
109171 case atomCut :
110- c .bytecode = append ( c . bytecode , instruction {opcode : OpCut })
172+ c .emit ( instruction {opcode : OpCut })
111173 return nil
112174 }
113- c .bytecode = append ( c . bytecode , instruction {opcode : OpCall , operand : procedureIndicator {name : p , arity : 0 }})
175+ c .emit ( instruction {opcode : OpCall , operand : procedureIndicator {name : p , arity : 0 }})
114176 return nil
115177 case Compound :
116178 for i := 0 ; i < p .Arity (); i ++ {
117179 c .compileBodyArg (p .Arg (i ), env )
118180 }
119- c .bytecode = append ( c . bytecode , instruction {opcode : OpCall , operand : procedureIndicator {name : p .Functor (), arity : Integer (p .Arity ())}})
181+ c .emit ( instruction {opcode : OpCall , operand : procedureIndicator {name : p .Functor (), arity : Integer (p .Arity ())}})
120182 return nil
121183 default :
122184 return errNotCallable
@@ -126,67 +188,84 @@ func (c *clause) compilePred(p Term, env *Env) error {
126188func (c * clause ) compileHeadArg (a Term , env * Env ) {
127189 switch a := env .Resolve (a ).(type ) {
128190 case Variable :
129- c .bytecode = append ( c . bytecode , instruction {opcode : OpGetVar , operand : c .varOffset (a )})
191+ c .emit ( instruction {opcode : OpGetVar , operand : c .varOffset (a )})
130192 case charList , codeList : // Treat them as if they're atomic.
131- c .bytecode = append ( c . bytecode , instruction {opcode : OpGetConst , operand : a })
193+ c .emit ( instruction {opcode : OpGetConst , operand : a })
132194 case list :
133- c .bytecode = append ( c . bytecode , instruction {opcode : OpGetList , operand : Integer (len (a ))})
195+ c .emit ( instruction {opcode : OpGetList , operand : Integer (len (a ))})
134196 for _ , arg := range a {
135197 c .compileHeadArg (arg , env )
136198 }
137- c .bytecode = append ( c . bytecode , instruction {opcode : OpPop })
199+ c .emit ( instruction {opcode : OpPop })
138200 case * partial :
139201 prefix := a .Compound .(list )
140- c .bytecode = append ( c . bytecode , instruction {opcode : OpGetPartial , operand : Integer (len (prefix ))})
202+ c .emit ( instruction {opcode : OpGetPartial , operand : Integer (len (prefix ))})
141203 c .compileHeadArg (* a .tail , env )
142204 for _ , arg := range prefix {
143205 c .compileHeadArg (arg , env )
144206 }
145- c .bytecode = append ( c . bytecode , instruction {opcode : OpPop })
207+ c .emit ( instruction {opcode : OpPop })
146208 case Compound :
147- c .bytecode = append (c .bytecode , instruction {opcode : OpGetFunctor , operand : procedureIndicator {name : a .Functor (), arity : Integer (a .Arity ())}})
209+ switch a .(type ) {
210+ case Dict :
211+ c .emit (instruction {opcode : OpGetDict , operand : Integer (a .Arity ())})
212+ default :
213+ c .emit (instruction {opcode : OpGetFunctor , operand : procedureIndicator {name : a .Functor (), arity : Integer (a .Arity ())}})
214+ }
215+
148216 for i := 0 ; i < a .Arity (); i ++ {
149217 c .compileHeadArg (a .Arg (i ), env )
150218 }
151- c .bytecode = append ( c . bytecode , instruction {opcode : OpPop })
219+ c .emit ( instruction {opcode : OpPop })
152220 default :
153- c .bytecode = append ( c . bytecode , instruction {opcode : OpGetConst , operand : a })
221+ c .emit ( instruction {opcode : OpGetConst , operand : a })
154222 }
155223}
156224
157225func (c * clause ) compileBodyArg (a Term , env * Env ) {
158226 switch a := env .Resolve (a ).(type ) {
159227 case Variable :
160- c .bytecode = append ( c . bytecode , instruction {opcode : OpPutVar , operand : c .varOffset (a )})
228+ c .emit ( instruction {opcode : OpPutVar , operand : c .varOffset (a )})
161229 case charList , codeList : // Treat them as if they're atomic.
162- c .bytecode = append ( c . bytecode , instruction {opcode : OpPutConst , operand : a })
230+ c .emit ( instruction {opcode : OpPutConst , operand : a })
163231 case list :
164- c .bytecode = append ( c . bytecode , instruction {opcode : OpPutList , operand : Integer (len (a ))})
232+ c .emit ( instruction {opcode : OpPutList , operand : Integer (len (a ))})
165233 for _ , arg := range a {
166234 c .compileBodyArg (arg , env )
167235 }
168- c .bytecode = append (c .bytecode , instruction {opcode : OpPop })
236+ c .emit (instruction {opcode : OpPop })
237+ case Dict :
238+ c .emit (instruction {opcode : OpPutDict , operand : Integer (a .Arity ())})
239+ for i := 0 ; i < a .Arity (); i ++ {
240+ c .compileBodyArg (a .Arg (i ), env )
241+ }
242+ c .emit (instruction {opcode : OpPop })
169243 case * partial :
170244 var l int
171245 iter := ListIterator {List : a .Compound }
172246 for iter .Next () {
173247 l ++
174248 }
175- c .bytecode = append ( c . bytecode , instruction {opcode : OpPutPartial , operand : Integer (l )})
249+ c .emit ( instruction {opcode : OpPutPartial , operand : Integer (l )})
176250 c .compileBodyArg (* a .tail , env )
177251 iter = ListIterator {List : a .Compound }
178252 for iter .Next () {
179253 c .compileBodyArg (iter .Current (), env )
180254 }
181- c .bytecode = append ( c . bytecode , instruction {opcode : OpPop })
255+ c .emit ( instruction {opcode : OpPop })
182256 case Compound :
183- c .bytecode = append (c .bytecode , instruction {opcode : OpPutFunctor , operand : procedureIndicator {name : a .Functor (), arity : Integer (a .Arity ())}})
257+ switch a .(type ) {
258+ case Dict :
259+ c .emit (instruction {opcode : OpPutDict , operand : Integer (a .Arity ())})
260+ default :
261+ c .emit (instruction {opcode : OpPutFunctor , operand : procedureIndicator {name : a .Functor (), arity : Integer (a .Arity ())}})
262+ }
184263 for i := 0 ; i < a .Arity (); i ++ {
185264 c .compileBodyArg (a .Arg (i ), env )
186265 }
187- c .bytecode = append ( c . bytecode , instruction {opcode : OpPop })
266+ c .emit ( instruction {opcode : OpPop })
188267 default :
189- c .bytecode = append ( c . bytecode , instruction {opcode : OpPutConst , operand : a })
268+ c .emit ( instruction {opcode : OpPutConst , operand : a })
190269 }
191270}
192271
0 commit comments