Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Shen 6.1

  • Loading branch information...
commit c97b4542a31c37ad2bc7d5834fe9cb7567fb3dff 1 parent 4dc47d5
@hraberg authored
View
521 shen/klambda/declarations.kl
258 additions, 263 deletions not shown
View
70 shen/klambda/load.kl
@@ -15,10 +15,10 @@
For an explication of this license see http://www.lambdassociates.org/News/june11/license.htm which explains this license in full."
-(defun load (V1647)
+(defun load (V1651)
(let Load
(let Start (get-time run)
- (let Result (shen-load-help (value shen-*tc*) (read-file V1647))
+ (let Result (shen-load-help (value shen-*tc*) (read-file V1651))
(let Finish (get-time run)
(let Time (- Finish Start)
(let Message (intoutput "~%run time: ~A secs~%" (@p Time ()))
@@ -29,55 +29,55 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
shen-skip)
loaded)))
-(defun shen-load-help (V1652 V1653)
+(defun shen-load-help (V1656 V1657)
(cond
- ((= false V1652)
+ ((= false V1656)
(map (lambda X (intoutput "~S~%" (@p (shen-eval-without-macros X) ())))
- V1653))
+ V1657))
(true
(let RemoveSynonyms
- (mapcan (lambda V1654 (shen-remove-synonyms V1654)) V1653)
- (let Table (mapcan (lambda V1655 (shen-typetable V1655)) RemoveSynonyms)
- (let Assume (map (lambda V1656 (shen-assumetype V1656)) Table)
+ (mapcan (lambda V1658 (shen-remove-synonyms V1658)) V1657)
+ (let Table (mapcan (lambda V1659 (shen-typetable V1659)) RemoveSynonyms)
+ (let Assume (map (lambda V1660 (shen-assumetype V1660)) Table)
(trap-error
- (map (lambda V1657 (shen-typecheck-and-load V1657)) RemoveSynonyms)
+ (map (lambda V1661 (shen-typecheck-and-load V1661)) RemoveSynonyms)
(lambda E (shen-unwind-types E Table)))))))))
-(defun shen-remove-synonyms (V1658)
+(defun shen-remove-synonyms (V1662)
(cond
- ((and (cons? V1658) (= shen-synonyms-help (hd V1658)))
- (do (eval V1658) ()))
- (true (cons V1658 ()))))
+ ((and (cons? V1662) (= shen-synonyms-help (hd V1662)))
+ (do (eval V1662) ()))
+ (true (cons V1662 ()))))
-(defun shen-typecheck-and-load (V1659)
- (do (nl 1) (shen-typecheck-and-evaluate V1659 (gensym A))))
+(defun shen-typecheck-and-load (V1663)
+ (do (nl 1) (shen-typecheck-and-evaluate V1663 (gensym A))))
-(defun shen-typetable (V1664)
+(defun shen-typetable (V1668)
(cond
- ((and (cons? V1664) (and (= define (hd V1664)) (cons? (tl V1664))))
+ ((and (cons? V1668) (and (= define (hd V1668)) (cons? (tl V1668))))
(let Sig
- (compile (lambda V1665 (shen-<sig+rest> V1665)) (tl (tl V1664)) ())
- (if (= Sig fail!)
- (interror "~A lacks a proper signature.~%" (@p (hd (tl V1664)) ()))
- (cons (cons (hd (tl V1664)) Sig) ()))))
+ (compile (lambda V1669 (shen-<sig+rest> V1669)) (tl (tl V1668)) ())
+ (if (= Sig (fail))
+ (interror "~A lacks a proper signature.~%" (@p (hd (tl V1668)) ()))
+ (cons (cons (hd (tl V1668)) Sig) ()))))
(true ())))
-(defun shen-assumetype (V1666)
- (cond ((cons? V1666) (declare (hd V1666) (tl V1666)))
+(defun shen-assumetype (V1670)
+ (cond ((cons? V1670) (declare (hd V1670) (tl V1670)))
(true (shen-sys-error shen-assumetype))))
-(defun shen-unwind-types (V1671 V1672)
- (cond ((= () V1672) (simple-error (error-to-string V1671)))
- ((and (cons? V1672) (cons? (hd V1672)))
- (do (shen-remtype (hd (hd V1672))) (shen-unwind-types V1671 (tl V1672))))
+(defun shen-unwind-types (V1675 V1676)
+ (cond ((= () V1676) (simple-error (error-to-string V1675)))
+ ((and (cons? V1676) (cons? (hd V1676)))
+ (do (shen-remtype (hd (hd V1676))) (shen-unwind-types V1675 (tl V1676))))
(true (shen-sys-error shen-unwind-types))))
-(defun shen-remtype (V1673)
- (do (set shen-*signedfuncs* (remove V1673 (value shen-*signedfuncs*))) V1673))
+(defun shen-remtype (V1677)
+ (do (set shen-*signedfuncs* (remove V1677 (value shen-*signedfuncs*))) V1677))
-(defun shen-<sig+rest> (V1674)
+(defun shen-<sig+rest> (V1678)
(let Result
- (let Parse_<signature> (shen-<signature> V1674)
+ (let Parse_<signature> (shen-<signature> V1678)
(if (not (= (fail) Parse_<signature>))
(let Parse_<any> (shen-<any> Parse_<signature>)
(if (not (= (fail) Parse_<any>))
@@ -85,10 +85,10 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail)) (fail) Result)))
-(defun write-to-file (V1675 V1676)
+(defun write-to-file (V1679 V1680)
(let AbsPath
- (intmake-string "~A~A" (@p (value *home-directory*) (@p V1675 ())))
+ (intmake-string "~A~A" (@p (value *home-directory*) (@p V1679 ())))
(let Stream (open file AbsPath out)
- (let String (intmake-string "~S~%~%" (@p V1676 ()))
- (let Write (pr String Stream) (let Close (close Stream) V1676))))))
+ (let String (intmake-string "~S~%~%" (@p V1680 ()))
+ (let Write (pr String Stream) (let Close (close Stream) V1680))))))
View
1,592 shen/klambda/prolog.kl
@@ -15,9 +15,9 @@
For an explication of this license see http://www.lambdassociates.org/News/june11/license.htm which explains this license in full."
-(defun shen-<defprolog> (V1164)
+(defun shen-<defprolog> (V1168)
(let Result
- (let Parse_<predicate*> (shen-<predicate*> V1164)
+ (let Parse_<predicate*> (shen-<predicate*> V1168)
(if (not (= (fail) Parse_<predicate*>))
(let Parse_<clauses*> (shen-<clauses*> Parse_<predicate*>)
(if (not (= (fail) Parse_<clauses*>))
@@ -30,42 +30,42 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail)) (fail) Result)))
-(defun shen-prolog-error (V1165 V1166)
+(defun shen-prolog-error (V1169 V1170)
(interror "prolog syntax error in ~A here:~%~% ~A~%"
- (@p V1165 (@p (shen-next-50 50 V1166) ()))))
+ (@p V1169 (@p (shen-next-50 50 V1170) ()))))
-(defun shen-next-50 (V1171 V1172)
- (cond ((= () V1172) "") ((= 0 V1171) "")
- ((cons? V1172)
- (cn (shen-decons-string (hd V1172)) (shen-next-50 (- V1171 1) (tl V1172))))
+(defun shen-next-50 (V1175 V1176)
+ (cond ((= () V1176) "") ((= 0 V1175) "")
+ ((cons? V1176)
+ (cn (shen-decons-string (hd V1176)) (shen-next-50 (- V1175 1) (tl V1176))))
(true (shen-sys-error shen-next-50))))
-(defun shen-decons-string (V1173)
+(defun shen-decons-string (V1177)
(cond
- ((and (cons? V1173)
- (and (= cons (hd V1173))
- (and (cons? (tl V1173))
- (and (cons? (tl (tl V1173))) (= () (tl (tl (tl V1173))))))))
- (intmake-string "~S " (@p (shen-eval-cons V1173) ())))
- (true (intmake-string "~R " (@p V1173 ())))))
-
-(defun shen-insert-predicate (V1174 V1175)
+ ((and (cons? V1177)
+ (and (= cons (hd V1177))
+ (and (cons? (tl V1177))
+ (and (cons? (tl (tl V1177))) (= () (tl (tl (tl V1177))))))))
+ (intmake-string "~S " (@p (shen-eval-cons V1177) ())))
+ (true (intmake-string "~R " (@p V1177 ())))))
+
+(defun shen-insert-predicate (V1178 V1179)
(cond
- ((and (cons? V1175) (and (cons? (tl V1175)) (= () (tl (tl V1175)))))
- (cons (cons V1174 (hd V1175)) (cons :- (tl V1175))))
+ ((and (cons? V1179) (and (cons? (tl V1179)) (= () (tl (tl V1179)))))
+ (cons (cons V1178 (hd V1179)) (cons :- (tl V1179))))
(true (shen-sys-error shen-insert-predicate))))
-(defun shen-<predicate*> (V1176)
+(defun shen-<predicate*> (V1180)
(let Result
- (if (cons? (fst V1176))
- (shen-reassemble (fst (shen-reassemble (tl (fst V1176)) (snd V1176)))
- (hd (fst V1176)))
+ (if (cons? (fst V1180))
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1180)) (snd V1180)))
+ (hd (fst V1180)))
(fail))
(if (= Result (fail)) (fail) Result)))
-(defun shen-<clauses*> (V1177)
+(defun shen-<clauses*> (V1181)
(let Result
- (let Parse_<clause*> (shen-<clause*> V1177)
+ (let Parse_<clause*> (shen-<clause*> V1181)
(if (not (= (fail) Parse_<clause*>))
(let Parse_<clauses*> (shen-<clauses*> Parse_<clause*>)
(if (not (= (fail) Parse_<clauses*>))
@@ -75,15 +75,15 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<e> (<e> V1177)
+ (let Parse_<e> (<e> V1181)
(if (not (= (fail) Parse_<e>))
(shen-reassemble (fst Parse_<e>) (snd Parse_<e>)) (fail)))
(if (= Result (fail)) (fail) Result))
Result)))
-(defun shen-<clause*> (V1178)
+(defun shen-<clause*> (V1182)
(let Result
- (let Parse_<head*> (shen-<head*> V1178)
+ (let Parse_<head*> (shen-<head*> V1182)
(if (not (= (fail) Parse_<head*>))
(if (and (cons? (fst Parse_<head*>)) (= <-- (hd (fst Parse_<head*>))))
(let Parse_<body*>
@@ -100,9 +100,9 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail)) (fail) Result)))
-(defun shen-<head*> (V1179)
+(defun shen-<head*> (V1183)
(let Result
- (let Parse_<term*> (shen-<term*> V1179)
+ (let Parse_<term*> (shen-<term*> V1183)
(if (not (= (fail) Parse_<term*>))
(let Parse_<head*> (shen-<head*> Parse_<term*>)
(if (not (= (fail) Parse_<head*>))
@@ -112,63 +112,63 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<e> (<e> V1179)
+ (let Parse_<e> (<e> V1183)
(if (not (= (fail) Parse_<e>))
(shen-reassemble (fst Parse_<e>) (snd Parse_<e>)) (fail)))
(if (= Result (fail)) (fail) Result))
Result)))
-(defun shen-<term*> (V1180)
+(defun shen-<term*> (V1184)
(let Result
- (if (cons? (fst V1180))
- (shen-reassemble (fst (shen-reassemble (tl (fst V1180)) (snd V1180)))
+ (if (cons? (fst V1184))
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1184)) (snd V1184)))
(if
- (and (not (= <-- (hd (fst V1180))))
- (shen-legitimate-term? (hd (fst V1180))))
- (shen-eval-cons (hd (fst V1180))) (fail)))
+ (and (not (= <-- (hd (fst V1184))))
+ (shen-legitimate-term? (hd (fst V1184))))
+ (shen-eval-cons (hd (fst V1184))) (fail)))
(fail))
(if (= Result (fail)) (fail) Result)))
-(defun shen-legitimate-term? (V1185)
+(defun shen-legitimate-term? (V1189)
(cond
- ((and (cons? V1185)
- (and (= cons (hd V1185))
- (and (cons? (tl V1185))
- (and (cons? (tl (tl V1185))) (= () (tl (tl (tl V1185))))))))
- (and (shen-legitimate-term? (hd (tl V1185)))
- (shen-legitimate-term? (hd (tl (tl V1185))))))
- ((and (cons? V1185)
- (and (= mode (hd V1185))
- (and (cons? (tl V1185))
- (and (cons? (tl (tl V1185)))
- (and (= + (hd (tl (tl V1185)))) (= () (tl (tl (tl V1185)))))))))
- (shen-legitimate-term? (hd (tl V1185))))
- ((and (cons? V1185)
- (and (= mode (hd V1185))
- (and (cons? (tl V1185))
- (and (cons? (tl (tl V1185)))
- (and (= - (hd (tl (tl V1185)))) (= () (tl (tl (tl V1185)))))))))
- (shen-legitimate-term? (hd (tl V1185))))
- ((cons? V1185) false) (true true)))
-
-(defun shen-eval-cons (V1186)
+ ((and (cons? V1189)
+ (and (= cons (hd V1189))
+ (and (cons? (tl V1189))
+ (and (cons? (tl (tl V1189))) (= () (tl (tl (tl V1189))))))))
+ (and (shen-legitimate-term? (hd (tl V1189)))
+ (shen-legitimate-term? (hd (tl (tl V1189))))))
+ ((and (cons? V1189)
+ (and (= mode (hd V1189))
+ (and (cons? (tl V1189))
+ (and (cons? (tl (tl V1189)))
+ (and (= + (hd (tl (tl V1189)))) (= () (tl (tl (tl V1189)))))))))
+ (shen-legitimate-term? (hd (tl V1189))))
+ ((and (cons? V1189)
+ (and (= mode (hd V1189))
+ (and (cons? (tl V1189))
+ (and (cons? (tl (tl V1189)))
+ (and (= - (hd (tl (tl V1189)))) (= () (tl (tl (tl V1189)))))))))
+ (shen-legitimate-term? (hd (tl V1189))))
+ ((cons? V1189) false) (true true)))
+
+(defun shen-eval-cons (V1190)
(cond
- ((and (cons? V1186)
- (and (= cons (hd V1186))
- (and (cons? (tl V1186))
- (and (cons? (tl (tl V1186))) (= () (tl (tl (tl V1186))))))))
- (cons (shen-eval-cons (hd (tl V1186)))
- (shen-eval-cons (hd (tl (tl V1186))))))
- ((and (cons? V1186)
- (and (= mode (hd V1186))
- (and (cons? (tl V1186))
- (and (cons? (tl (tl V1186))) (= () (tl (tl (tl V1186))))))))
- (cons mode (cons (shen-eval-cons (hd (tl V1186))) (tl (tl V1186)))))
- (true V1186)))
-
-(defun shen-<body*> (V1187)
+ ((and (cons? V1190)
+ (and (= cons (hd V1190))
+ (and (cons? (tl V1190))
+ (and (cons? (tl (tl V1190))) (= () (tl (tl (tl V1190))))))))
+ (cons (shen-eval-cons (hd (tl V1190)))
+ (shen-eval-cons (hd (tl (tl V1190))))))
+ ((and (cons? V1190)
+ (and (= mode (hd V1190))
+ (and (cons? (tl V1190))
+ (and (cons? (tl (tl V1190))) (= () (tl (tl (tl V1190))))))))
+ (cons mode (cons (shen-eval-cons (hd (tl V1190))) (tl (tl V1190)))))
+ (true V1190)))
+
+(defun shen-<body*> (V1191)
(let Result
- (let Parse_<literal*> (shen-<literal*> V1187)
+ (let Parse_<literal*> (shen-<literal*> V1191)
(if (not (= (fail) Parse_<literal*>))
(let Parse_<body*> (shen-<body*> Parse_<literal*>)
(if (not (= (fail) Parse_<body*>))
@@ -178,501 +178,501 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<e> (<e> V1187)
+ (let Parse_<e> (<e> V1191)
(if (not (= (fail) Parse_<e>))
(shen-reassemble (fst Parse_<e>) (snd Parse_<e>)) (fail)))
(if (= Result (fail)) (fail) Result))
Result)))
-(defun shen-<literal*> (V1188)
+(defun shen-<literal*> (V1192)
(let Result
- (if (and (cons? (fst V1188)) (= ! (hd (fst V1188))))
- (shen-reassemble (fst (shen-reassemble (tl (fst V1188)) (snd V1188)))
+ (if (and (cons? (fst V1192)) (= ! (hd (fst V1192))))
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1192)) (snd V1192)))
(cons cut (cons Throwcontrol ())))
(fail))
(if (= Result (fail))
(let Result
- (if (cons? (fst V1188))
- (shen-reassemble (fst (shen-reassemble (tl (fst V1188)) (snd V1188)))
- (if (cons? (hd (fst V1188))) (hd (fst V1188)) (fail)))
+ (if (cons? (fst V1192))
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1192)) (snd V1192)))
+ (if (cons? (hd (fst V1192))) (hd (fst V1192)) (fail)))
(fail))
(if (= Result (fail)) (fail) Result))
Result)))
-(defun shen-<end*> (V1189)
+(defun shen-<end*> (V1193)
(let Result
- (if (cons? (fst V1189))
- (shen-reassemble (fst (shen-reassemble (tl (fst V1189)) (snd V1189)))
- (if (= (hd (fst V1189)) ;) shen-skip (fail)))
+ (if (cons? (fst V1193))
+ (shen-reassemble (fst (shen-reassemble (tl (fst V1193)) (snd V1193)))
+ (if (= (hd (fst V1193)) ;) shen-skip (fail)))
(fail))
(if (= Result (fail)) (fail) Result)))
-(defun cut (V1190 V1191 V1192)
- (let Result (thaw V1192) (if (= Result false) V1190 Result)))
+(defun cut (V1194 V1195 V1196)
+ (let Result (thaw V1196) (if (= Result false) V1194 Result)))
-(defun shen-insert_modes (V1193)
+(defun shen-insert_modes (V1197)
(cond
- ((and (cons? V1193)
- (and (= mode (hd V1193))
- (and (cons? (tl V1193))
- (and (cons? (tl (tl V1193))) (= () (tl (tl (tl V1193))))))))
- V1193)
- ((= () V1193) ())
- ((cons? V1193)
- (cons (cons mode (cons (hd V1193) (cons + ())))
- (cons mode (cons (shen-insert_modes (tl V1193)) (cons - ())))))
- (true V1193)))
-
-(defun shen-s-prolog (V1194)
- (map (lambda V1195 (eval V1195)) (shen-prolog->shen V1194)))
-
-(defun shen-prolog->shen (V1196)
- (map (lambda V1197 (shen-compile_prolog_procedure V1197))
+ ((and (cons? V1197)
+ (and (= mode (hd V1197))
+ (and (cons? (tl V1197))
+ (and (cons? (tl (tl V1197))) (= () (tl (tl (tl V1197))))))))
+ V1197)
+ ((= () V1197) ())
+ ((cons? V1197)
+ (cons (cons mode (cons (hd V1197) (cons + ())))
+ (cons mode (cons (shen-insert_modes (tl V1197)) (cons - ())))))
+ (true V1197)))
+
+(defun shen-s-prolog (V1198)
+ (map (lambda V1199 (eval V1199)) (shen-prolog->shen V1198)))
+
+(defun shen-prolog->shen (V1200)
+ (map (lambda V1201 (shen-compile_prolog_procedure V1201))
(shen-group_clauses
- (map (lambda V1198 (shen-s-prolog_clause V1198))
- (mapcan (lambda V1199 (shen-head_abstraction V1199)) V1196)))))
+ (map (lambda V1202 (shen-s-prolog_clause V1202))
+ (mapcan (lambda V1203 (shen-head_abstraction V1203)) V1200)))))
-(defun shen-s-prolog_clause (V1200)
+(defun shen-s-prolog_clause (V1204)
(cond
- ((and (cons? V1200)
- (and (cons? (tl V1200))
- (and (= :- (hd (tl V1200)))
- (and (cons? (tl (tl V1200))) (= () (tl (tl (tl V1200))))))))
- (cons (hd V1200)
+ ((and (cons? V1204)
+ (and (cons? (tl V1204))
+ (and (= :- (hd (tl V1204)))
+ (and (cons? (tl (tl V1204))) (= () (tl (tl (tl V1204))))))))
+ (cons (hd V1204)
(cons :-
(cons
- (map (lambda V1201 (shen-s-prolog_literal V1201)) (hd (tl (tl V1200))))
+ (map (lambda V1205 (shen-s-prolog_literal V1205)) (hd (tl (tl V1204))))
()))))
(true (shen-sys-error shen-s-prolog_clause))))
-(defun shen-head_abstraction (V1202)
+(defun shen-head_abstraction (V1206)
(cond
- ((and (cons? V1202)
- (and (cons? (tl V1202))
- (and (= :- (hd (tl V1202)))
- (and (cons? (tl (tl V1202)))
- (and (= () (tl (tl (tl V1202))))
- (< (shen-complexity_head (hd V1202))
+ ((and (cons? V1206)
+ (and (cons? (tl V1206))
+ (and (= :- (hd (tl V1206)))
+ (and (cons? (tl (tl V1206)))
+ (and (= () (tl (tl (tl V1206))))
+ (< (shen-complexity_head (hd V1206))
(value shen-*maxcomplexity*)))))))
- (cons V1202 ()))
- ((and (cons? V1202)
- (and (cons? (hd V1202))
- (and (cons? (tl V1202))
- (and (= :- (hd (tl V1202)))
- (and (cons? (tl (tl V1202))) (= () (tl (tl (tl V1202)))))))))
- (let Terms (map (lambda Y (gensym V)) (tl (hd V1202)))
- (let XTerms (shen-rcons_form (shen-remove_modes (tl (hd V1202))))
+ (cons V1206 ()))
+ ((and (cons? V1206)
+ (and (cons? (hd V1206))
+ (and (cons? (tl V1206))
+ (and (= :- (hd (tl V1206)))
+ (and (cons? (tl (tl V1206))) (= () (tl (tl (tl V1206)))))))))
+ (let Terms (map (lambda Y (gensym V)) (tl (hd V1206)))
+ (let XTerms (shen-rcons_form (shen-remove_modes (tl (hd V1206))))
(let Literal (cons unify (cons (shen-cons_form Terms) (cons XTerms ())))
(let Clause
- (cons (cons (hd (hd V1202)) Terms)
- (cons :- (cons (cons Literal (hd (tl (tl V1202)))) ())))
+ (cons (cons (hd (hd V1206)) Terms)
+ (cons :- (cons (cons Literal (hd (tl (tl V1206)))) ())))
(cons Clause ()))))))
(true (shen-sys-error shen-head_abstraction))))
-(defun shen-complexity_head (V1207)
+(defun shen-complexity_head (V1211)
(cond
- ((cons? V1207)
- (shen-product (map (lambda V1208 (shen-complexity V1208)) (tl V1207))))
+ ((cons? V1211)
+ (shen-product (map (lambda V1212 (shen-complexity V1212)) (tl V1211))))
(true (shen-sys-error shen-complexity_head))))
-(defun shen-complexity (V1216)
+(defun shen-complexity (V1220)
(cond
- ((and (cons? V1216)
- (and (= mode (hd V1216))
- (and (cons? (tl V1216))
- (and (cons? (hd (tl V1216)))
- (and (= mode (hd (hd (tl V1216))))
- (and (cons? (tl (hd (tl V1216))))
- (and (cons? (tl (tl (hd (tl V1216)))))
- (and (= () (tl (tl (tl (hd (tl V1216))))))
- (and (cons? (tl (tl V1216)))
- (= () (tl (tl (tl V1216)))))))))))))
- (shen-complexity (hd (tl V1216))))
- ((and (cons? V1216)
- (and (= mode (hd V1216))
- (and (cons? (tl V1216))
- (and (cons? (hd (tl V1216)))
- (and (cons? (tl (tl V1216)))
- (and (= + (hd (tl (tl V1216))))
- (= () (tl (tl (tl V1216))))))))))
+ ((and (cons? V1220)
+ (and (= mode (hd V1220))
+ (and (cons? (tl V1220))
+ (and (cons? (hd (tl V1220)))
+ (and (= mode (hd (hd (tl V1220))))
+ (and (cons? (tl (hd (tl V1220))))
+ (and (cons? (tl (tl (hd (tl V1220)))))
+ (and (= () (tl (tl (tl (hd (tl V1220))))))
+ (and (cons? (tl (tl V1220)))
+ (= () (tl (tl (tl V1220)))))))))))))
+ (shen-complexity (hd (tl V1220))))
+ ((and (cons? V1220)
+ (and (= mode (hd V1220))
+ (and (cons? (tl V1220))
+ (and (cons? (hd (tl V1220)))
+ (and (cons? (tl (tl V1220)))
+ (and (= + (hd (tl (tl V1220))))
+ (= () (tl (tl (tl V1220))))))))))
(* 2
(*
- (shen-complexity (cons mode (cons (hd (hd (tl V1216))) (tl (tl V1216)))))
+ (shen-complexity (cons mode (cons (hd (hd (tl V1220))) (tl (tl V1220)))))
(shen-complexity
- (cons mode (cons (tl (hd (tl V1216))) (tl (tl V1216))))))))
- ((and (cons? V1216)
- (and (= mode (hd V1216))
- (and (cons? (tl V1216))
- (and (cons? (hd (tl V1216)))
- (and (cons? (tl (tl V1216)))
- (and (= - (hd (tl (tl V1216))))
- (= () (tl (tl (tl V1216))))))))))
- (* (shen-complexity (cons mode (cons (hd (hd (tl V1216))) (tl (tl V1216)))))
- (shen-complexity (cons mode (cons (tl (hd (tl V1216))) (tl (tl V1216)))))))
- ((and (cons? V1216)
- (and (= mode (hd V1216))
- (and (cons? (tl V1216))
- (and (cons? (tl (tl V1216)))
- (and (= () (tl (tl (tl V1216)))) (variable? (hd (tl V1216))))))))
+ (cons mode (cons (tl (hd (tl V1220))) (tl (tl V1220))))))))
+ ((and (cons? V1220)
+ (and (= mode (hd V1220))
+ (and (cons? (tl V1220))
+ (and (cons? (hd (tl V1220)))
+ (and (cons? (tl (tl V1220)))
+ (and (= - (hd (tl (tl V1220))))
+ (= () (tl (tl (tl V1220))))))))))
+ (* (shen-complexity (cons mode (cons (hd (hd (tl V1220))) (tl (tl V1220)))))
+ (shen-complexity (cons mode (cons (tl (hd (tl V1220))) (tl (tl V1220)))))))
+ ((and (cons? V1220)
+ (and (= mode (hd V1220))
+ (and (cons? (tl V1220))
+ (and (cons? (tl (tl V1220)))
+ (and (= () (tl (tl (tl V1220)))) (variable? (hd (tl V1220))))))))
1)
- ((and (cons? V1216)
- (and (= mode (hd V1216))
- (and (cons? (tl V1216))
- (and (cons? (tl (tl V1216)))
- (and (= + (hd (tl (tl V1216)))) (= () (tl (tl (tl V1216)))))))))
+ ((and (cons? V1220)
+ (and (= mode (hd V1220))
+ (and (cons? (tl V1220))
+ (and (cons? (tl (tl V1220)))
+ (and (= + (hd (tl (tl V1220)))) (= () (tl (tl (tl V1220)))))))))
2)
- ((and (cons? V1216)
- (and (= mode (hd V1216))
- (and (cons? (tl V1216))
- (and (cons? (tl (tl V1216)))
- (and (= - (hd (tl (tl V1216)))) (= () (tl (tl (tl V1216)))))))))
+ ((and (cons? V1220)
+ (and (= mode (hd V1220))
+ (and (cons? (tl V1220))
+ (and (cons? (tl (tl V1220)))
+ (and (= - (hd (tl (tl V1220)))) (= () (tl (tl (tl V1220)))))))))
1)
- (true (shen-complexity (cons mode (cons V1216 (cons + ())))))))
+ (true (shen-complexity (cons mode (cons V1220 (cons + ())))))))
-(defun shen-product (V1217)
- (cond ((= () V1217) 1)
- ((cons? V1217) (* (hd V1217) (shen-product (tl V1217))))
+(defun shen-product (V1221)
+ (cond ((= () V1221) 1)
+ ((cons? V1221) (* (hd V1221) (shen-product (tl V1221))))
(true (shen-sys-error shen-product))))
-(defun shen-s-prolog_literal (V1218)
+(defun shen-s-prolog_literal (V1222)
(cond
- ((and (cons? V1218)
- (and (= is (hd V1218))
- (and (cons? (tl V1218))
- (and (cons? (tl (tl V1218))) (= () (tl (tl (tl V1218))))))))
+ ((and (cons? V1222)
+ (and (= is (hd V1222))
+ (and (cons? (tl V1222))
+ (and (cons? (tl (tl V1222))) (= () (tl (tl (tl V1222))))))))
(cons bind
- (cons (hd (tl V1218))
- (cons (shen-insert_deref (hd (tl (tl V1218)))) ()))))
- ((and (cons? V1218)
- (and (= when (hd V1218))
- (and (cons? (tl V1218)) (= () (tl (tl V1218))))))
- (cons fwhen (cons (shen-insert_deref (hd (tl V1218))) ())))
- ((and (cons? V1218)
- (and (= bind (hd V1218))
- (and (cons? (tl V1218))
- (and (cons? (tl (tl V1218))) (= () (tl (tl (tl V1218))))))))
+ (cons (hd (tl V1222))
+ (cons (shen-insert_deref (hd (tl (tl V1222)))) ()))))
+ ((and (cons? V1222)
+ (and (= when (hd V1222))
+ (and (cons? (tl V1222)) (= () (tl (tl V1222))))))
+ (cons fwhen (cons (shen-insert_deref (hd (tl V1222))) ())))
+ ((and (cons? V1222)
+ (and (= bind (hd V1222))
+ (and (cons? (tl V1222))
+ (and (cons? (tl (tl V1222))) (= () (tl (tl (tl V1222))))))))
(cons bind
- (cons (hd (tl V1218))
- (cons (shen-insert_lazyderef (hd (tl (tl V1218)))) ()))))
- ((and (cons? V1218)
- (and (= fwhen (hd V1218))
- (and (cons? (tl V1218)) (= () (tl (tl V1218))))))
- (cons fwhen (cons (shen-insert_lazyderef (hd (tl V1218))) ())))
- ((cons? V1218)
- (cons (shen-m_prolog_to_s-prolog_predicate (hd V1218)) (tl V1218)))
+ (cons (hd (tl V1222))
+ (cons (shen-insert_lazyderef (hd (tl (tl V1222)))) ()))))
+ ((and (cons? V1222)
+ (and (= fwhen (hd V1222))
+ (and (cons? (tl V1222)) (= () (tl (tl V1222))))))
+ (cons fwhen (cons (shen-insert_lazyderef (hd (tl V1222))) ())))
+ ((cons? V1222)
+ (cons (shen-m_prolog_to_s-prolog_predicate (hd V1222)) (tl V1222)))
(true (shen-sys-error shen-s-prolog_literal))))
-(defun shen-insert_deref (V1219)
- (cond ((variable? V1219) (cons shen-deref (cons V1219 (cons ProcessN ()))))
- ((cons? V1219)
- (cons (shen-insert_deref (hd V1219)) (shen-insert_deref (tl V1219))))
- (true V1219)))
+(defun shen-insert_deref (V1223)
+ (cond ((variable? V1223) (cons shen-deref (cons V1223 (cons ProcessN ()))))
+ ((cons? V1223)
+ (cons (shen-insert_deref (hd V1223)) (shen-insert_deref (tl V1223))))
+ (true V1223)))
-(defun shen-insert_lazyderef (V1220)
+(defun shen-insert_lazyderef (V1224)
(cond
- ((variable? V1220) (cons shen-lazyderef (cons V1220 (cons ProcessN ()))))
- ((cons? V1220)
- (cons (shen-insert_lazyderef (hd V1220))
- (shen-insert_lazyderef (tl V1220))))
- (true V1220)))
-
-(defun shen-m_prolog_to_s-prolog_predicate (V1221)
- (cond ((= = V1221) unify) ((= =! V1221) unify!)
- ((= == V1221) identical) (true V1221)))
-
-(defun shen-group_clauses (V1222)
- (cond ((= () V1222) ())
- ((cons? V1222)
+ ((variable? V1224) (cons shen-lazyderef (cons V1224 (cons ProcessN ()))))
+ ((cons? V1224)
+ (cons (shen-insert_lazyderef (hd V1224))
+ (shen-insert_lazyderef (tl V1224))))
+ (true V1224)))
+
+(defun shen-m_prolog_to_s-prolog_predicate (V1225)
+ (cond ((= = V1225) unify) ((= =! V1225) unify!)
+ ((= == V1225) identical) (true V1225)))
+
+(defun shen-group_clauses (V1226)
+ (cond ((= () V1226) ())
+ ((cons? V1226)
(let Group
- (shen-collect (lambda X (shen-same_predicate? (hd V1222) X)) V1222)
- (let Rest (difference V1222 Group)
+ (shen-collect (lambda X (shen-same_predicate? (hd V1226) X)) V1226)
+ (let Rest (difference V1226 Group)
(cons Group (shen-group_clauses Rest)))))
(true (shen-sys-error shen-group_clauses))))
-(defun shen-collect (V1225 V1226)
- (cond ((= () V1226) ())
- ((cons? V1226)
- (if (V1225 (hd V1226)) (cons (hd V1226) (shen-collect V1225 (tl V1226)))
- (shen-collect V1225 (tl V1226))))
+(defun shen-collect (V1229 V1230)
+ (cond ((= () V1230) ())
+ ((cons? V1230)
+ (if (V1229 (hd V1230)) (cons (hd V1230) (shen-collect V1229 (tl V1230)))
+ (shen-collect V1229 (tl V1230))))
(true (shen-sys-error shen-collect))))
-(defun shen-same_predicate? (V1243 V1244)
+(defun shen-same_predicate? (V1247 V1248)
(cond
- ((and (cons? V1243)
- (and (cons? (hd V1243)) (and (cons? V1244) (cons? (hd V1244)))))
- (= (hd (hd V1243)) (hd (hd V1244))))
+ ((and (cons? V1247)
+ (and (cons? (hd V1247)) (and (cons? V1248) (cons? (hd V1248)))))
+ (= (hd (hd V1247)) (hd (hd V1248))))
(true (shen-sys-error shen-same_predicate?))))
-(defun shen-compile_prolog_procedure (V1245)
- (let F (shen-procedure_name V1245)
- (let Shen (shen-clauses-to-shen F V1245) Shen)))
+(defun shen-compile_prolog_procedure (V1249)
+ (let F (shen-procedure_name V1249)
+ (let Shen (shen-clauses-to-shen F V1249) Shen)))
-(defun shen-procedure_name (V1258)
+(defun shen-procedure_name (V1262)
(cond
- ((and (cons? V1258) (and (cons? (hd V1258)) (cons? (hd (hd V1258)))))
- (hd (hd (hd V1258))))
+ ((and (cons? V1262) (and (cons? (hd V1262)) (cons? (hd (hd V1262)))))
+ (hd (hd (hd V1262))))
(true (shen-sys-error shen-procedure_name))))
-(defun shen-clauses-to-shen (V1259 V1260)
- (let Linear (map (lambda V1261 (shen-linearise-clause V1261)) V1260)
+(defun shen-clauses-to-shen (V1263 V1264)
+ (let Linear (map (lambda V1265 (shen-linearise-clause V1265)) V1264)
(let Arity
- (shen-prolog-aritycheck V1259 (map (lambda V1262 (head V1262)) V1260))
+ (shen-prolog-aritycheck V1263 (map (lambda V1266 (head V1266)) V1264))
(let Parameters (shen-parameters Arity)
(let AUM_instructions (map (lambda X (shen-aum X Parameters)) Linear)
(let Code
(shen-catch-cut
(shen-nest-disjunct
- (map (lambda V1263 (shen-aum_to_shen V1263)) AUM_instructions)))
+ (map (lambda V1267 (shen-aum_to_shen V1267)) AUM_instructions)))
(let ShenDef
(cons define
- (cons V1259
+ (cons V1263
(append Parameters
(append (cons ProcessN (cons Continuation ()))
(cons -> (cons Code ()))))))
ShenDef)))))))
-(defun shen-catch-cut (V1264)
- (cond ((not (shen-occurs? cut V1264)) V1264)
+(defun shen-catch-cut (V1268)
+ (cond ((not (shen-occurs? cut V1268)) V1268)
(true
(cons let
(cons Throwcontrol
(cons (cons shen-catchpoint ())
- (cons (cons shen-cutpoint (cons Throwcontrol (cons V1264 ())))
+ (cons (cons shen-cutpoint (cons Throwcontrol (cons V1268 ())))
())))))))
(defun shen-catchpoint () (set shen-*catch* (+ 1 (value shen-*catch*))))
-(defun shen-cutpoint (V1269 V1270)
- (cond ((= V1270 V1269) false) (true V1270)))
+(defun shen-cutpoint (V1273 V1274)
+ (cond ((= V1274 V1273) false) (true V1274)))
-(defun shen-nest-disjunct (V1272)
- (cond ((and (cons? V1272) (= () (tl V1272))) (hd V1272))
- ((cons? V1272) (shen-lisp-or (hd V1272) (shen-nest-disjunct (tl V1272))))
+(defun shen-nest-disjunct (V1276)
+ (cond ((and (cons? V1276) (= () (tl V1276))) (hd V1276))
+ ((cons? V1276) (shen-lisp-or (hd V1276) (shen-nest-disjunct (tl V1276))))
(true (shen-sys-error shen-nest-disjunct))))
-(defun shen-lisp-or (V1273 V1274)
+(defun shen-lisp-or (V1277 V1278)
(cons let
(cons Case
- (cons V1273
+ (cons V1277
(cons
(cons if
(cons (cons = (cons Case (cons false ())))
- (cons V1274 (cons Case ()))))
+ (cons V1278 (cons Case ()))))
())))))
-(defun shen-prolog-aritycheck (V1277 V1278)
- (cond ((and (cons? V1278) (= () (tl V1278))) (- (length (hd V1278)) 1))
- ((and (cons? V1278) (cons? (tl V1278)))
- (if (= (length (hd V1278)) (length (hd (tl V1278))))
- (shen-prolog-aritycheck V1277 (tl V1278))
+(defun shen-prolog-aritycheck (V1281 V1282)
+ (cond ((and (cons? V1282) (= () (tl V1282))) (- (length (hd V1282)) 1))
+ ((and (cons? V1282) (cons? (tl V1282)))
+ (if (= (length (hd V1282)) (length (hd (tl V1282))))
+ (shen-prolog-aritycheck V1281 (tl V1282))
(interror "arity error in prolog procedure ~A~%"
- (@p (cons V1277 ()) ()))))
+ (@p (cons V1281 ()) ()))))
(true (shen-sys-error shen-prolog-aritycheck))))
-(defun shen-linearise-clause (V1279)
+(defun shen-linearise-clause (V1283)
(cond
- ((and (cons? V1279)
- (and (cons? (tl V1279))
- (and (= :- (hd (tl V1279)))
- (and (cons? (tl (tl V1279))) (= () (tl (tl (tl V1279))))))))
- (let Linear (shen-linearise (cons (hd V1279) (tl (tl V1279))))
+ ((and (cons? V1283)
+ (and (cons? (tl V1283))
+ (and (= :- (hd (tl V1283)))
+ (and (cons? (tl (tl V1283))) (= () (tl (tl (tl V1283))))))))
+ (let Linear (shen-linearise (cons (hd V1283) (tl (tl V1283))))
(shen-clause_form Linear)))
(true (shen-sys-error shen-linearise-clause))))
-(defun shen-clause_form (V1280)
+(defun shen-clause_form (V1284)
(cond
- ((and (cons? V1280) (and (cons? (tl V1280)) (= () (tl (tl V1280)))))
- (cons (shen-explicit_modes (hd V1280))
- (cons :- (cons (shen-cf_help (hd (tl V1280))) ()))))
+ ((and (cons? V1284) (and (cons? (tl V1284)) (= () (tl (tl V1284)))))
+ (cons (shen-explicit_modes (hd V1284))
+ (cons :- (cons (shen-cf_help (hd (tl V1284))) ()))))
(true (shen-sys-error shen-clause_form))))
-(defun shen-explicit_modes (V1281)
+(defun shen-explicit_modes (V1285)
(cond
- ((cons? V1281)
- (cons (hd V1281) (map (lambda V1282 (shen-em_help V1282)) (tl V1281))))
+ ((cons? V1285)
+ (cons (hd V1285) (map (lambda V1286 (shen-em_help V1286)) (tl V1285))))
(true (shen-sys-error shen-explicit_modes))))
-(defun shen-em_help (V1283)
+(defun shen-em_help (V1287)
(cond
- ((and (cons? V1283)
- (and (= mode (hd V1283))
- (and (cons? (tl V1283))
- (and (cons? (tl (tl V1283))) (= () (tl (tl (tl V1283))))))))
- V1283)
- (true (cons mode (cons V1283 (cons + ()))))))
-
-(defun shen-cf_help (V1284)
+ ((and (cons? V1287)
+ (and (= mode (hd V1287))
+ (and (cons? (tl V1287))
+ (and (cons? (tl (tl V1287))) (= () (tl (tl (tl V1287))))))))
+ V1287)
+ (true (cons mode (cons V1287 (cons + ()))))))
+
+(defun shen-cf_help (V1288)
(cond
- ((and (cons? V1284)
- (and (= where (hd V1284))
- (and (cons? (tl V1284))
- (and (cons? (hd (tl V1284)))
- (and (= = (hd (hd (tl V1284))))
- (and (cons? (tl (hd (tl V1284))))
- (and (cons? (tl (tl (hd (tl V1284)))))
- (and (= () (tl (tl (tl (hd (tl V1284))))))
- (and (cons? (tl (tl V1284)))
- (= () (tl (tl (tl V1284)))))))))))))
- (cons (cons (if (value shen-*occurs*) unify! unify) (tl (hd (tl V1284))))
- (shen-cf_help (hd (tl (tl V1284))))))
- (true V1284)))
-
-(defun occurs-check (V1289)
- (cond ((= + V1289) (set shen-*occurs* true))
- ((= - V1289) (set shen-*occurs* false))
+ ((and (cons? V1288)
+ (and (= where (hd V1288))
+ (and (cons? (tl V1288))
+ (and (cons? (hd (tl V1288)))
+ (and (= = (hd (hd (tl V1288))))
+ (and (cons? (tl (hd (tl V1288))))
+ (and (cons? (tl (tl (hd (tl V1288)))))
+ (and (= () (tl (tl (tl (hd (tl V1288))))))
+ (and (cons? (tl (tl V1288)))
+ (= () (tl (tl (tl V1288)))))))))))))
+ (cons (cons (if (value shen-*occurs*) unify! unify) (tl (hd (tl V1288))))
+ (shen-cf_help (hd (tl (tl V1288))))))
+ (true V1288)))
+
+(defun occurs-check (V1293)
+ (cond ((= + V1293) (set shen-*occurs* true))
+ ((= - V1293) (set shen-*occurs* false))
(true (interror "occurs-check expects + or -~%" ()))))
-(defun shen-aum (V1290 V1291)
+(defun shen-aum (V1294 V1295)
(cond
- ((and (cons? V1290)
- (and (cons? (hd V1290))
- (and (cons? (tl V1290))
- (and (= :- (hd (tl V1290)))
- (and (cons? (tl (tl V1290))) (= () (tl (tl (tl V1290)))))))))
+ ((and (cons? V1294)
+ (and (cons? (hd V1294))
+ (and (cons? (tl V1294))
+ (and (= :- (hd (tl V1294)))
+ (and (cons? (tl (tl V1294))) (= () (tl (tl (tl V1294)))))))))
(let MuApplication
(shen-make_mu_application
(cons shen-mu
- (cons (tl (hd V1290))
- (cons (shen-continuation_call (tl (hd V1290)) (hd (tl (tl V1290))))
+ (cons (tl (hd V1294))
+ (cons (shen-continuation_call (tl (hd V1294)) (hd (tl (tl V1294))))
())))
- V1291)
+ V1295)
(shen-mu_reduction MuApplication +)))
(true (shen-sys-error shen-aum))))
-(defun shen-continuation_call (V1292 V1293)
- (let VTerms (cons ProcessN (shen-extract_vars V1292))
- (let VBody (shen-extract_vars V1293)
+(defun shen-continuation_call (V1296 V1297)
+ (let VTerms (cons ProcessN (shen-extract_vars V1296))
+ (let VBody (shen-extract_vars V1297)
(let Free (remove Throwcontrol (difference VBody VTerms))
- (shen-cc_help Free V1293)))))
+ (shen-cc_help Free V1297)))))
-(defun remove (V1294 V1295) (shen-remove-h V1294 V1295 ()))
+(defun remove (V1298 V1299) (shen-remove-h V1298 V1299 ()))
-(defun shen-remove-h (V1298 V1299 V1300)
- (cond ((= () V1299) (reverse V1300))
- ((and (cons? V1299) (= (hd V1299) V1298))
- (shen-remove-h (hd V1299) (tl V1299) V1300))
- ((cons? V1299) (shen-remove-h V1298 (tl V1299) (cons (hd V1299) V1300)))
+(defun shen-remove-h (V1302 V1303 V1304)
+ (cond ((= () V1303) (reverse V1304))
+ ((and (cons? V1303) (= (hd V1303) V1302))
+ (shen-remove-h (hd V1303) (tl V1303) V1304))
+ ((cons? V1303) (shen-remove-h V1302 (tl V1303) (cons (hd V1303) V1304)))
(true (shen-sys-error shen-remove-h))))
-(defun shen-cc_help (V1302 V1303)
+(defun shen-cc_help (V1306 V1307)
(cond
- ((and (= () V1302) (= () V1303))
+ ((and (= () V1306) (= () V1307))
(cons shen-pop (cons shen-the (cons shen-stack ()))))
- ((= () V1303)
+ ((= () V1307)
(cons shen-rename
(cons shen-the
(cons shen-variables
(cons in
- (cons V1302
+ (cons V1306
(cons and
(cons shen-then
(cons (cons shen-pop (cons shen-the (cons shen-stack ())))
())))))))))
- ((= () V1302)
- (cons call (cons shen-the (cons shen-continuation (cons V1303 ())))))
+ ((= () V1306)
+ (cons call (cons shen-the (cons shen-continuation (cons V1307 ())))))
(true
(cons shen-rename
(cons shen-the
(cons shen-variables
(cons in
- (cons V1302
+ (cons V1306
(cons and
(cons shen-then
(cons
(cons call
- (cons shen-the (cons shen-continuation (cons V1303 ()))))
+ (cons shen-the (cons shen-continuation (cons V1307 ()))))
())))))))))))
-(defun shen-make_mu_application (V1304 V1305)
+(defun shen-make_mu_application (V1308 V1309)
(cond
- ((and (cons? V1304)
- (and (= shen-mu (hd V1304))
- (and (cons? (tl V1304))
- (and (= () (hd (tl V1304)))
- (and (cons? (tl (tl V1304)))
- (and (= () (tl (tl (tl V1304)))) (= () V1305)))))))
- (hd (tl (tl V1304))))
- ((and (cons? V1304)
- (and (= shen-mu (hd V1304))
- (and (cons? (tl V1304))
- (and (cons? (hd (tl V1304)))
- (and (cons? (tl (tl V1304)))
- (and (= () (tl (tl (tl V1304)))) (cons? V1305)))))))
+ ((and (cons? V1308)
+ (and (= shen-mu (hd V1308))
+ (and (cons? (tl V1308))
+ (and (= () (hd (tl V1308)))
+ (and (cons? (tl (tl V1308)))
+ (and (= () (tl (tl (tl V1308)))) (= () V1309)))))))
+ (hd (tl (tl V1308))))
+ ((and (cons? V1308)
+ (and (= shen-mu (hd V1308))
+ (and (cons? (tl V1308))
+ (and (cons? (hd (tl V1308)))
+ (and (cons? (tl (tl V1308)))
+ (and (= () (tl (tl (tl V1308)))) (cons? V1309)))))))
(cons
(cons shen-mu
- (cons (hd (hd (tl V1304)))
+ (cons (hd (hd (tl V1308)))
(cons
(shen-make_mu_application
- (cons shen-mu (cons (tl (hd (tl V1304))) (tl (tl V1304)))) (tl V1305))
+ (cons shen-mu (cons (tl (hd (tl V1308))) (tl (tl V1308)))) (tl V1309))
())))
- (cons (hd V1305) ())))
+ (cons (hd V1309) ())))
(true (shen-sys-error shen-make_mu_application))))
-(defun shen-mu_reduction (V1312 V1313)
+(defun shen-mu_reduction (V1316 V1317)
(cond
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (hd (tl (hd V1312))))
- (and (= mode (hd (hd (tl (hd V1312)))))
- (and (cons? (tl (hd (tl (hd V1312)))))
- (and (cons? (tl (tl (hd (tl (hd V1312))))))
- (and (= () (tl (tl (tl (hd (tl (hd V1312)))))))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312)) (= () (tl (tl V1312)))))))))))))))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (hd (tl (hd V1316))))
+ (and (= mode (hd (hd (tl (hd V1316)))))
+ (and (cons? (tl (hd (tl (hd V1316)))))
+ (and (cons? (tl (tl (hd (tl (hd V1316))))))
+ (and (= () (tl (tl (tl (hd (tl (hd V1316)))))))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316)) (= () (tl (tl V1316)))))))))))))))
(shen-mu_reduction
(cons
- (cons shen-mu (cons (hd (tl (hd (tl (hd V1312))))) (tl (tl (hd V1312)))))
- (tl V1312))
- (hd (tl (tl (hd (tl (hd V1312))))))))
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312))
- (and (= () (tl (tl V1312))) (= _ (hd (tl (hd V1312))))))))))))
- (shen-mu_reduction (hd (tl (tl (hd V1312)))) V1313))
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312))
- (and (= () (tl (tl V1312)))
- (shen-ephemeral_variable? (hd (tl (hd V1312)))
- (hd (tl V1312)))))))))))
- (subst (hd (tl V1312)) (hd (tl (hd V1312)))
- (shen-mu_reduction (hd (tl (tl (hd V1312)))) V1313)))
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312))
- (and (= () (tl (tl V1312)))
- (variable? (hd (tl (hd V1312))))))))))))
+ (cons shen-mu (cons (hd (tl (hd (tl (hd V1316))))) (tl (tl (hd V1316)))))
+ (tl V1316))
+ (hd (tl (tl (hd (tl (hd V1316))))))))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316))
+ (and (= () (tl (tl V1316))) (= _ (hd (tl (hd V1316))))))))))))
+ (shen-mu_reduction (hd (tl (tl (hd V1316)))) V1317))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316))
+ (and (= () (tl (tl V1316)))
+ (shen-ephemeral_variable? (hd (tl (hd V1316)))
+ (hd (tl V1316)))))))))))
+ (subst (hd (tl V1316)) (hd (tl (hd V1316)))
+ (shen-mu_reduction (hd (tl (tl (hd V1316)))) V1317)))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316))
+ (and (= () (tl (tl V1316)))
+ (variable? (hd (tl (hd V1316))))))))))))
(cons let
- (cons (hd (tl (hd V1312)))
+ (cons (hd (tl (hd V1316)))
(cons shen-be
- (cons (hd (tl V1312))
+ (cons (hd (tl V1316))
(cons in
- (cons (shen-mu_reduction (hd (tl (tl (hd V1312)))) V1313) ())))))))
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312))
- (and (= () (tl (tl V1312)))
- (and (= - V1313)
- (shen-prolog_constant? (hd (tl (hd V1312)))))))))))))
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) V1317) ())))))))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316))
+ (and (= () (tl (tl V1316)))
+ (and (= - V1317)
+ (shen-prolog_constant? (hd (tl (hd V1316)))))))))))))
(let Z (gensym V)
(cons let
(cons Z
@@ -680,28 +680,28 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons
(cons shen-the
(cons shen-result
- (cons shen-of (cons shen-dereferencing (tl V1312)))))
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
(cons in
(cons
(cons if
(cons
(cons Z
(cons is
- (cons identical (cons shen-to (cons (hd (tl (hd V1312))) ())))))
+ (cons identical (cons shen-to (cons (hd (tl (hd V1316))) ())))))
(cons shen-then
- (cons (shen-mu_reduction (hd (tl (tl (hd V1312)))) -)
- (cons shen-else (cons fail! ()))))))
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) -)
+ (cons shen-else (cons (fail) ()))))))
()))))))))
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312))
- (and (= () (tl (tl V1312)))
- (and (= + V1313)
- (shen-prolog_constant? (hd (tl (hd V1312)))))))))))))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316))
+ (and (= () (tl (tl V1316)))
+ (and (= + V1317)
+ (shen-prolog_constant? (hd (tl (hd V1316)))))))))))))
(let Z (gensym V)
(cons let
(cons Z
@@ -709,16 +709,16 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons
(cons shen-the
(cons shen-result
- (cons shen-of (cons shen-dereferencing (tl V1312)))))
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
(cons in
(cons
(cons if
(cons
(cons Z
(cons is
- (cons identical (cons shen-to (cons (hd (tl (hd V1312))) ())))))
+ (cons identical (cons shen-to (cons (hd (tl (hd V1316))) ())))))
(cons shen-then
- (cons (shen-mu_reduction (hd (tl (tl (hd V1312)))) +)
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) +)
(cons shen-else
(cons
(cons if
@@ -729,22 +729,22 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons bind
(cons Z
(cons shen-to
- (cons (hd (tl (hd V1312)))
+ (cons (hd (tl (hd V1316)))
(cons in
- (cons (shen-mu_reduction (hd (tl (tl (hd V1312)))) +)
+ (cons (shen-mu_reduction (hd (tl (tl (hd V1316)))) +)
()))))))
- (cons shen-else (cons fail! ()))))))
+ (cons shen-else (cons (fail) ()))))))
()))))))
()))))))))
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (hd (tl (hd V1312))))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312))
- (and (= () (tl (tl V1312))) (= - V1313))))))))))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (hd (tl (hd V1316))))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316))
+ (and (= () (tl (tl V1316))) (= - V1317))))))))))
(let Z (gensym V)
(cons let
(cons Z
@@ -752,7 +752,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons
(cons shen-the
(cons shen-result
- (cons shen-of (cons shen-dereferencing (tl V1312)))))
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
(cons in
(cons
(cons if
@@ -764,11 +764,11 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(shen-mu_reduction
(cons
(cons shen-mu
- (cons (hd (hd (tl (hd V1312))))
+ (cons (hd (hd (tl (hd V1316))))
(cons
(cons
(cons shen-mu
- (cons (tl (hd (tl (hd V1312)))) (tl (tl (hd V1312)))))
+ (cons (tl (hd (tl (hd V1316)))) (tl (tl (hd V1316)))))
(cons
(cons shen-the (cons tail (cons shen-of (cons Z ()))))
()))
@@ -776,17 +776,17 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons (cons shen-the (cons head (cons shen-of (cons Z ()))))
()))
-)
- (cons shen-else (cons fail! ()))))))
+ (cons shen-else (cons (fail) ()))))))
()))))))))
- ((and (cons? V1312)
- (and (cons? (hd V1312))
- (and (= shen-mu (hd (hd V1312)))
- (and (cons? (tl (hd V1312)))
- (and (cons? (hd (tl (hd V1312))))
- (and (cons? (tl (tl (hd V1312))))
- (and (= () (tl (tl (tl (hd V1312)))))
- (and (cons? (tl V1312))
- (and (= () (tl (tl V1312))) (= + V1313))))))))))
+ ((and (cons? V1316)
+ (and (cons? (hd V1316))
+ (and (= shen-mu (hd (hd V1316)))
+ (and (cons? (tl (hd V1316)))
+ (and (cons? (hd (tl (hd V1316))))
+ (and (cons? (tl (tl (hd V1316))))
+ (and (= () (tl (tl (tl (hd V1316)))))
+ (and (cons? (tl V1316))
+ (and (= () (tl (tl V1316))) (= + V1317))))))))))
(let Z (gensym V)
(cons let
(cons Z
@@ -794,7 +794,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons
(cons shen-the
(cons shen-result
- (cons shen-of (cons shen-dereferencing (tl V1312)))))
+ (cons shen-of (cons shen-dereferencing (tl V1316)))))
(cons in
(cons
(cons if
@@ -806,11 +806,11 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(shen-mu_reduction
(cons
(cons shen-mu
- (cons (hd (hd (tl (hd V1312))))
+ (cons (hd (hd (tl (hd V1316))))
(cons
(cons
(cons shen-mu
- (cons (tl (hd (tl (hd V1312)))) (tl (tl (hd V1312)))))
+ (cons (tl (hd (tl (hd V1316)))) (tl (tl (hd V1316)))))
(cons
(cons shen-the (cons tail (cons shen-of (cons Z ()))))
()))
@@ -829,7 +829,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons shen-the
(cons shen-variables
(cons in
- (cons (shen-extract_vars (hd (tl (hd V1312))))
+ (cons (shen-extract_vars (hd (tl (hd V1316))))
(cons and
(cons shen-then
(cons
@@ -838,151 +838,151 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons shen-to
(cons
(shen-rcons_form
- (shen-remove_modes (hd (tl (hd V1312)))))
+ (shen-remove_modes (hd (tl (hd V1316)))))
(cons in
(cons
- (shen-mu_reduction (hd (tl (tl (hd V1312))))
+ (shen-mu_reduction (hd (tl (tl (hd V1316))))
+)
()))))))
()))))))))
- (cons shen-else (cons fail! ()))))))
+ (cons shen-else (cons (fail) ()))))))
()))))))
()))))))))
- (true V1312)))
+ (true V1316)))
-(defun shen-rcons_form (V1314)
+(defun shen-rcons_form (V1318)
(cond
- ((cons? V1314)
+ ((cons? V1318)
(cons cons
- (cons (shen-rcons_form (hd V1314))
- (cons (shen-rcons_form (tl V1314)) ()))))
- (true V1314)))
+ (cons (shen-rcons_form (hd V1318))
+ (cons (shen-rcons_form (tl V1318)) ()))))
+ (true V1318)))
-(defun shen-remove_modes (V1315)
+(defun shen-remove_modes (V1319)
(cond
- ((and (cons? V1315)
- (and (= mode (hd V1315))
- (and (cons? (tl V1315))
- (and (cons? (tl (tl V1315)))
- (and (= + (hd (tl (tl V1315)))) (= () (tl (tl (tl V1315)))))))))
- (shen-remove_modes (hd (tl V1315))))
- ((and (cons? V1315)
- (and (= mode (hd V1315))
- (and (cons? (tl V1315))
- (and (cons? (tl (tl V1315)))
- (and (= - (hd (tl (tl V1315)))) (= () (tl (tl (tl V1315)))))))))
- (shen-remove_modes (hd (tl V1315))))
- ((cons? V1315)
- (cons (shen-remove_modes (hd V1315)) (shen-remove_modes (tl V1315))))
- (true V1315)))
-
-(defun shen-ephemeral_variable? (V1316 V1317)
- (and (variable? V1316) (variable? V1317)))
-
-(defun shen-prolog_constant? (V1326) (cond ((cons? V1326) false) (true true)))
-
-(defun shen-aum_to_shen (V1327)
+ ((and (cons? V1319)
+ (and (= mode (hd V1319))
+ (and (cons? (tl V1319))
+ (and (cons? (tl (tl V1319)))
+ (and (= + (hd (tl (tl V1319)))) (= () (tl (tl (tl V1319)))))))))
+ (shen-remove_modes (hd (tl V1319))))
+ ((and (cons? V1319)
+ (and (= mode (hd V1319))
+ (and (cons? (tl V1319))
+ (and (cons? (tl (tl V1319)))
+ (and (= - (hd (tl (tl V1319)))) (= () (tl (tl (tl V1319)))))))))
+ (shen-remove_modes (hd (tl V1319))))
+ ((cons? V1319)
+ (cons (shen-remove_modes (hd V1319)) (shen-remove_modes (tl V1319))))
+ (true V1319)))
+
+(defun shen-ephemeral_variable? (V1320 V1321)
+ (and (variable? V1320) (variable? V1321)))
+
+(defun shen-prolog_constant? (V1330) (cond ((cons? V1330) false) (true true)))
+
+(defun shen-aum_to_shen (V1331)
(cond
- ((and (cons? V1327)
- (and (= let (hd V1327))
- (and (cons? (tl V1327))
- (and (cons? (tl (tl V1327)))
- (and (= shen-be (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (and (= in (hd (tl (tl (tl (tl V1327))))))
- (and (cons? (tl (tl (tl (tl (tl V1327))))))
- (= () (tl (tl (tl (tl (tl (tl V1327))))))))))))))))
+ ((and (cons? V1331)
+ (and (= let (hd V1331))
+ (and (cons? (tl V1331))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-be (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (and (= in (hd (tl (tl (tl (tl V1331))))))
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
+ (= () (tl (tl (tl (tl (tl (tl V1331))))))))))))))))
(cons let
- (cons (hd (tl V1327))
- (cons (shen-aum_to_shen (hd (tl (tl (tl V1327)))))
- (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1327))))))) ())))))
- ((and (cons? V1327)
- (and (= shen-the (hd V1327))
- (and (cons? (tl V1327))
- (and (= shen-result (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-of (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (= shen-dereferencing (hd (tl (tl (tl V1327)))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (= () (tl (tl (tl (tl (tl V1327)))))))))))))))
+ (cons (hd (tl V1331))
+ (cons (shen-aum_to_shen (hd (tl (tl (tl V1331)))))
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1331))))))) ())))))
+ ((and (cons? V1331)
+ (and (= shen-the (hd V1331))
+ (and (cons? (tl V1331))
+ (and (= shen-result (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-of (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (= shen-dereferencing (hd (tl (tl (tl V1331)))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (= () (tl (tl (tl (tl (tl V1331)))))))))))))))
(cons shen-lazyderef
- (cons (shen-aum_to_shen (hd (tl (tl (tl (tl V1327))))))
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl V1331))))))
(cons ProcessN ()))))
- ((and (cons? V1327)
- (and (= if (hd V1327))
- (and (cons? (tl V1327))
- (and (cons? (tl (tl V1327)))
- (and (= shen-then (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (and (= shen-else (hd (tl (tl (tl (tl V1327))))))
- (and (cons? (tl (tl (tl (tl (tl V1327))))))
- (= () (tl (tl (tl (tl (tl (tl V1327))))))))))))))))
+ ((and (cons? V1331)
+ (and (= if (hd V1331))
+ (and (cons? (tl V1331))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-then (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (and (= shen-else (hd (tl (tl (tl (tl V1331))))))
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
+ (= () (tl (tl (tl (tl (tl (tl V1331))))))))))))))))
(cons if
- (cons (shen-aum_to_shen (hd (tl V1327)))
- (cons (shen-aum_to_shen (hd (tl (tl (tl V1327)))))
- (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1327))))))) ())))))
- ((and (cons? V1327)
- (and (cons? (tl V1327))
- (and (= is (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-a (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (= shen-variable (hd (tl (tl (tl V1327)))))
- (= () (tl (tl (tl (tl V1327))))))))))))
- (cons shen-pvar? (cons (hd V1327) ())))
- ((and (cons? V1327)
- (and (cons? (tl V1327))
- (and (= is (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-a (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (= shen-non-empty (hd (tl (tl (tl V1327)))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (and (= list (hd (tl (tl (tl (tl V1327))))))
- (= () (tl (tl (tl (tl (tl V1327)))))))))))))))
- (cons cons? (cons (hd V1327) ())))
- ((and (cons? V1327)
- (and (= shen-rename (hd V1327))
- (and (cons? (tl V1327))
- (and (= shen-the (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-variables (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (= in (hd (tl (tl (tl V1327)))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (and (= () (hd (tl (tl (tl (tl V1327))))))
- (and (cons? (tl (tl (tl (tl (tl V1327))))))
- (and (= and (hd (tl (tl (tl (tl (tl V1327)))))))
- (and (cons? (tl (tl (tl (tl (tl (tl V1327)))))))
- (and (= shen-then (hd (tl (tl (tl (tl (tl (tl V1327))))))))
- (and (cons? (tl (tl (tl (tl (tl (tl (tl V1327))))))))
+ (cons (shen-aum_to_shen (hd (tl V1331)))
+ (cons (shen-aum_to_shen (hd (tl (tl (tl V1331)))))
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1331))))))) ())))))
+ ((and (cons? V1331)
+ (and (cons? (tl V1331))
+ (and (= is (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-a (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (= shen-variable (hd (tl (tl (tl V1331)))))
+ (= () (tl (tl (tl (tl V1331))))))))))))
+ (cons shen-pvar? (cons (hd V1331) ())))
+ ((and (cons? V1331)
+ (and (cons? (tl V1331))
+ (and (= is (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-a (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (= shen-non-empty (hd (tl (tl (tl V1331)))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (and (= list (hd (tl (tl (tl (tl V1331))))))
+ (= () (tl (tl (tl (tl (tl V1331)))))))))))))))
+ (cons cons? (cons (hd V1331) ())))
+ ((and (cons? V1331)
+ (and (= shen-rename (hd V1331))
+ (and (cons? (tl V1331))
+ (and (= shen-the (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-variables (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (= in (hd (tl (tl (tl V1331)))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (and (= () (hd (tl (tl (tl (tl V1331))))))
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
+ (and (= and (hd (tl (tl (tl (tl (tl V1331)))))))
+ (and (cons? (tl (tl (tl (tl (tl (tl V1331)))))))
+ (and (= shen-then (hd (tl (tl (tl (tl (tl (tl V1331))))))))
+ (and (cons? (tl (tl (tl (tl (tl (tl (tl V1331))))))))
(= ()
(tl
- (tl (tl (tl (tl (tl (tl (tl V1327))))))))))))))))))))))))
- (shen-aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1327))))))))))
- ((and (cons? V1327)
- (and (= shen-rename (hd V1327))
- (and (cons? (tl V1327))
- (and (= shen-the (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-variables (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (= in (hd (tl (tl (tl V1327)))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (and (cons? (hd (tl (tl (tl (tl V1327))))))
- (and (cons? (tl (tl (tl (tl (tl V1327))))))
- (and (= and (hd (tl (tl (tl (tl (tl V1327)))))))
- (and (cons? (tl (tl (tl (tl (tl (tl V1327)))))))
- (and (= shen-then (hd (tl (tl (tl (tl (tl (tl V1327))))))))
- (and (cons? (tl (tl (tl (tl (tl (tl (tl V1327))))))))
+ (tl (tl (tl (tl (tl (tl (tl V1331))))))))))))))))))))))))
+ (shen-aum_to_shen (hd (tl (tl (tl (tl (tl (tl (tl V1331))))))))))
+ ((and (cons? V1331)
+ (and (= shen-rename (hd V1331))
+ (and (cons? (tl V1331))
+ (and (= shen-the (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-variables (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (= in (hd (tl (tl (tl V1331)))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (and (cons? (hd (tl (tl (tl (tl V1331))))))
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
+ (and (= and (hd (tl (tl (tl (tl (tl V1331)))))))
+ (and (cons? (tl (tl (tl (tl (tl (tl V1331)))))))
+ (and (= shen-then (hd (tl (tl (tl (tl (tl (tl V1331))))))))
+ (and (cons? (tl (tl (tl (tl (tl (tl (tl V1331))))))))
(= ()
(tl
- (tl (tl (tl (tl (tl (tl (tl V1327))))))))))))))))))))))))
+ (tl (tl (tl (tl (tl (tl (tl V1331))))))))))))))))))))))))
(cons let
- (cons (hd (hd (tl (tl (tl (tl V1327))))))
+ (cons (hd (hd (tl (tl (tl (tl V1331))))))
(cons (cons shen-newpv (cons ProcessN ()))
(cons
(shen-aum_to_shen
@@ -990,297 +990,297 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(cons shen-the
(cons shen-variables
(cons in
- (cons (tl (hd (tl (tl (tl (tl V1327))))))
- (tl (tl (tl (tl (tl V1327)))))))))))
+ (cons (tl (hd (tl (tl (tl (tl V1331))))))
+ (tl (tl (tl (tl (tl V1331)))))))))))
())))))
- ((and (cons? V1327)
- (and (= bind (hd V1327))
- (and (cons? (tl V1327))
- (and (cons? (tl (tl V1327)))
- (and (= shen-to (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (and (= in (hd (tl (tl (tl (tl V1327))))))
- (and (cons? (tl (tl (tl (tl (tl V1327))))))
- (= () (tl (tl (tl (tl (tl (tl V1327))))))))))))))))
+ ((and (cons? V1331)
+ (and (= bind (hd V1331))
+ (and (cons? (tl V1331))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-to (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (and (= in (hd (tl (tl (tl (tl V1331))))))
+ (and (cons? (tl (tl (tl (tl (tl V1331))))))
+ (= () (tl (tl (tl (tl (tl (tl V1331))))))))))))))))
(cons do
(cons
(cons shen-bindv
- (cons (hd (tl V1327))
- (cons (shen-chwild (hd (tl (tl (tl V1327))))) (cons ProcessN ()))))
+ (cons (hd (tl V1331))
+ (cons (shen-chwild (hd (tl (tl (tl V1331))))) (cons ProcessN ()))))
(cons
(cons let
(cons Result
- (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1327)))))))
+ (cons (shen-aum_to_shen (hd (tl (tl (tl (tl (tl V1331)))))))
(cons
(cons do
- (cons (cons shen-unbindv (cons (hd (tl V1327)) (cons ProcessN ())))
+ (cons (cons shen-unbindv (cons (hd (tl V1331)) (cons ProcessN ())))
(cons Result ())))
()))))
()))))
- ((and (cons? V1327)
- (and (cons? (tl V1327))
- (and (= is (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= identical (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (and (= shen-to (hd (tl (tl (tl V1327)))))
- (and (cons? (tl (tl (tl (tl V1327)))))
- (= () (tl (tl (tl (tl (tl V1327))))))))))))))
- (cons = (cons (hd (tl (tl (tl (tl V1327))))) (cons (hd V1327) ()))))
- ((= fail! V1327) false)
- ((and (cons? V1327)
- (and (= shen-the (hd V1327))
- (and (cons? (tl V1327))
- (and (= head (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-of (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (= () (tl (tl (tl (tl V1327))))))))))))
- (cons hd (tl (tl (tl V1327)))))
- ((and (cons? V1327)
- (and (= shen-the (hd V1327))
- (and (cons? (tl V1327))
- (and (= tail (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-of (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (= () (tl (tl (tl (tl V1327))))))))))))
- (cons tl (tl (tl (tl V1327)))))
- ((and (cons? V1327)
- (and (= shen-pop (hd V1327))
- (and (cons? (tl V1327))
- (and (= shen-the (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-stack (hd (tl (tl V1327))))
- (= () (tl (tl (tl V1327))))))))))
+ ((and (cons? V1331)
+ (and (cons? (tl V1331))
+ (and (= is (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= identical (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (and (= shen-to (hd (tl (tl (tl V1331)))))
+ (and (cons? (tl (tl (tl (tl V1331)))))
+ (= () (tl (tl (tl (tl (tl V1331))))))))))))))
+ (cons = (cons (hd (tl (tl (tl (tl V1331))))) (cons (hd V1331) ()))))
+ ((= V1331 (fail)) false)
+ ((and (cons? V1331)
+ (and (= shen-the (hd V1331))
+ (and (cons? (tl V1331))
+ (and (= head (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-of (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (= () (tl (tl (tl (tl V1331))))))))))))
+ (cons hd (tl (tl (tl V1331)))))
+ ((and (cons? V1331)
+ (and (= shen-the (hd V1331))
+ (and (cons? (tl V1331))
+ (and (= tail (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-of (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (= () (tl (tl (tl (tl V1331))))))))))))
+ (cons tl (tl (tl (tl V1331)))))
+ ((and (cons? V1331)
+ (and (= shen-pop (hd V1331))
+ (and (cons? (tl V1331))
+ (and (= shen-the (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-stack (hd (tl (tl V1331))))
+ (= () (tl (tl (tl V1331))))))))))
(cons do
(cons (cons shen-incinfs ())
(cons (cons thaw (cons Continuation ())) ()))))
- ((and (cons? V1327)
- (and (= call (hd V1327))
- (and (cons? (tl V1327))
- (and (= shen-the (hd (tl V1327)))
- (and (cons? (tl (tl V1327)))
- (and (= shen-continuation (hd (tl (tl V1327))))
- (and (cons? (tl (tl (tl V1327))))
- (= () (tl (tl (tl (tl V1327))))))))))))
+ ((and (cons? V1331)
+ (and (= call (hd V1331))
+ (and (cons? (tl V1331))
+ (and (= shen-the (hd (tl V1331)))
+ (and (cons? (tl (tl V1331)))
+ (and (= shen-continuation (hd (tl (tl V1331))))
+ (and (cons? (tl (tl (tl V1331))))
+ (= () (tl (tl (tl (tl V1331))))))))))))
(cons do
(cons (cons shen-incinfs ())
(cons
- (shen-call_the_continuation (shen-chwild (hd (tl (tl (tl V1327)))))
+ (shen-call_the_continuation (shen-chwild (hd (tl (tl (tl V1331)))))
ProcessN Continuation)
()))))
- (true V1327)))
+ (true V1331)))
-(defun shen-chwild (V1328)
- (cond ((= V1328 _) (cons shen-newpv (cons ProcessN ())))
- ((cons? V1328) (map (lambda V1329 (shen-chwild V1329)) V1328)) (true V1328)))
+(defun shen-chwild (V1332)
+ (cond ((= V1332 _) (cons shen-newpv (cons ProcessN ())))
+ ((cons? V1332) (map (lambda V1333 (shen-chwild V1333)) V1332)) (true V1332)))
-(defun shen-newpv (V1330)
- (let Count+1 (+ (<-address (value shen-*varcounter*) V1330) 1)
- (let IncVar (address-> (value shen-*varcounter*) V1330 Count+1)
- (let Vector (<-address (value shen-*prologvectors*) V1330)
+(defun shen-newpv (V1334)
+ (let Count+1 (+ (<-address (value shen-*varcounter*) V1334) 1)
+ (let IncVar (address-> (value shen-*varcounter*) V1334 Count+1)
+ (let Vector (<-address (value shen-*prologvectors*) V1334)
(let ResizeVectorIfNeeded
- (if (= Count+1 (limit Vector)) (shen-resizeprocessvector V1330 Count+1)
+ (if (= Count+1 (limit Vector)) (shen-resizeprocessvector V1334 Count+1)
shen-skip)
(shen-mk-pvar Count+1))))))
-(defun shen-resizeprocessvector (V1331 V1332)
- (let Vector (<-address (value shen-*prologvectors*) V1331)
- (let BigVector (shen-resize-vector Vector (+ V1332 V1332) shen--null-)
- (address-> (value shen-*prologvectors*) V1331 BigVector))))
+(defun shen-resizeprocessvector (V1335 V1336)
+ (let Vector (<-address (value shen-*prologvectors*) V1335)
+ (let BigVector (shen-resize-vector Vector (+ V1336 V1336) shen--null-)
+ (address-> (value shen-*prologvectors*) V1335 BigVector))))
-(defun shen-resize-vector (V1333 V1334 V1335)
- (let BigVector (address-> (absvector (+ 1 V1334)) 0 V1334)
- (shen-copy-vector V1333 BigVector (limit V1333) V1334 V1335)))
+(defun shen-resize-vector (V1337 V1338 V1339)
+ (let BigVector (address-> (absvector (+ 1 V1338)) 0 V1338)
+ (shen-copy-vector V1337 BigVector (limit V1337) V1338 V1339)))
-(defun shen-copy-vector (V1336 V1337 V1338 V1339 V1340)
- (shen-copy-vector-stage-2 (+ 1 V1338) (+ V1339 1) V1340
- (shen-copy-vector-stage-1 1 V1336 V1337 (+ 1 V1338))))
+(defun shen-copy-vector (V1340 V1341 V1342 V1343 V1344)
+ (shen-copy-vector-stage-2 (+ 1 V1342) (+ V1343 1) V1344
+ (shen-copy-vector-stage-1 1 V1340 V1341 (+ 1 V1342))))
-(defun shen-copy-vector-stage-1 (V1343 V1344 V1345 V1346)
- (cond ((= V1346 V1343) V1345)
+(defun shen-copy-vector-stage-1 (V1347 V1348 V1349 V1350)
+ (cond ((= V1350 V1347) V1349)
(true
- (shen-copy-vector-stage-1 (+ 1 V1343) V1344
- (address-> V1345 V1343 (<-address V1344 V1343)) V1346))))
+ (shen-copy-vector-stage-1 (+ 1 V1347) V1348
+ (address-> V1349 V1347 (<-address V1348 V1347)) V1350))))
-(defun shen-copy-vector-stage-2 (V1350 V1351 V1352 V1353)
- (cond ((= V1351 V1350) V1353)
+(defun shen-copy-vector-stage-2 (V1354 V1355 V1356 V1357)
+ (cond ((= V1355 V1354) V1357)
(true
- (shen-copy-vector-stage-2 (+ V1350 1) V1351 V1352
- (address-> V1353 V1350 V1352)))))
+ (shen-copy-vector-stage-2 (+ V1354 1) V1355 V1356
+ (address-> V1357 V1354 V1356)))))
-(defun shen-mk-pvar (V1355)
- (address-> (address-> (absvector 2) 0 shen-pvar) 1 V1355))
+(defun shen-mk-pvar (V1359)
+ (address-> (address-> (absvector 2) 0 shen-pvar) 1 V1359))
-(defun shen-pvar? (V1356)
- (and (absvector? V1356) (= (<-address V1356 0) shen-pvar)))
+(defun shen-pvar? (V1360)
+ (and (absvector? V1360) (= (<-address V1360 0) shen-pvar)))
-(defun shen-bindv (V1357 V1358 V1359)
- (let Vector (<-address (value shen-*prologvectors*) V1359)
- (address-> Vector (<-address V1357 1) V1358)))
+(defun shen-bindv (V1361 V1362 V1363)
+ (let Vector (<-address (value shen-*prologvectors*) V1363)
+ (address-> Vector (<-address V1361 1) V1362)))
-(defun shen-unbindv (V1360 V1361)
- (let Vector (<-address (value shen-*prologvectors*) V1361)
- (address-> Vector (<-address V1360 1) shen--null-)))
+(defun shen-unbindv (V1364 V1365)
+ (let Vector (<-address (value shen-*prologvectors*) V1365)
+ (address-> Vector (<-address V1364 1) shen--null-)))
(defun shen-incinfs () (set shen-*infs* (+ 1 (value shen-*infs*))))
-(defun shen-call_the_continuation (V1362 V1363 V1364)
+(defun shen-call_the_continuation (V1366 V1367 V1368)
(cond
- ((and (cons? V1362) (and (cons? (hd V1362)) (= () (tl V1362))))
- (cons (hd (hd V1362))
- (append (tl (hd V1362)) (cons V1363 (cons V1364 ())))))
- ((and (cons? V1362) (cons? (hd V1362)))
- (let NewContinuation (shen-newcontinuation (tl V1362) V1363 V1364)
- (cons (hd (hd V1362))
- (append (tl (hd V1362)) (cons V1363 (cons NewContinuation ()))))))
+ ((and (cons? V1366) (and (cons? (hd V1366)) (= () (tl V1366))))
+ (cons (hd (hd V1366))
+ (append (tl (hd V1366)) (cons V1367 (cons V1368 ())))))
+ ((and (cons? V1366) (cons? (hd V1366)))
+ (let NewContinuation (shen-newcontinuation (tl V1366) V1367 V1368)
+ (cons (hd (hd V1366))
+ (append (tl (hd V1366)) (cons V1367 (cons NewContinuation ()))))))
(true (shen-sys-error shen-call_the_continuation))))
-(defun shen-newcontinuation (V1365 V1366 V1367)
- (cond ((= () V1365) V1367)
- ((and (cons? V1365) (cons? (hd V1365)))
+(defun shen-newcontinuation (V1369 V1370 V1371)
+ (cond ((= () V1369) V1371)
+ ((and (cons? V1369) (cons? (hd V1369)))
(cons freeze
(cons
- (cons (hd (hd V1365))
- (append (tl (hd V1365))
- (cons V1366 (cons (shen-newcontinuation (tl V1365) V1366 V1367) ()))))
+ (cons (hd (hd V1369))
+ (append (tl (hd V1369))
+ (cons V1370 (cons (shen-newcontinuation (tl V1369) V1370 V1371) ()))))
())))
(true (shen-sys-error shen-newcontinuation))))
-(defun return (V1372 V1373 V1374) (shen-deref V1372 V1373))
+(defun return (V1376 V1377 V1378) (shen-deref V1376 V1377))
-(defun shen-measure&return (V1379 V1380 V1381)
+(defun shen-measure&return (V1383 V1384 V1385)
(do (intoutput "~A inferences~%" (@p (value shen-*infs*) ()))
- (shen-deref V1379 V1380)))
-
-(defun unify (V1382 V1383 V1384 V1385)
- (shen-lzy= (shen-lazyderef V1382 V1384) (shen-lazyderef V1383 V1384) V1384
- V1385))
-
-(defun shen-lzy= (V1402 V1403 V1404 V1405)
- (cond ((= V1403 V1402) (thaw V1405))
- ((shen-pvar? V1402) (bind V1402 V1403 V1404 V1405))
- ((shen-pvar? V1403) (bind V1403 V1402 V1404 V1405))
- ((and (cons? V1402) (cons? V1403))
- (shen-lzy= (shen-lazyderef (hd V1402) V1404)
- (shen-lazyderef (hd V1403) V1404) V1404
+ (shen-deref V1383 V1384)))
+
+(defun unify (V1386 V1387 V1388 V1389)
+ (shen-lzy= (shen-lazyderef V1386 V1388) (shen-lazyderef V1387 V1388) V1388
+ V1389))
+
+(defun shen-lzy= (V1406 V1407 V1408 V1409)
+ (cond ((= V1407 V1406) (thaw V1409))
+ ((shen-pvar? V1406) (bind V1406 V1407 V1408 V1409))
+ ((shen-pvar? V1407) (bind V1407 V1406 V1408 V1409))
+ ((and (cons? V1406) (cons? V1407))
+ (shen-lzy= (shen-lazyderef (hd V1406) V1408)
+ (shen-lazyderef (hd V1407) V1408) V1408
(freeze
- (shen-lzy= (shen-lazyderef (tl V1402) V1404)
- (shen-lazyderef (tl V1403) V1404) V1404 V1405))))
+ (shen-lzy= (shen-lazyderef (tl V1406) V1408)
+ (shen-lazyderef (tl V1407) V1408) V1408 V1409))))
(true false)))
-(defun shen-deref (V1407 V1408)
+(defun shen-deref (V1411 V1412)
(cond
- ((cons? V1407)
- (cons (shen-deref (hd V1407) V1408) (shen-deref (tl V1407) V1408)))
+ ((cons? V1411)
+ (cons (shen-deref (hd V1411) V1412) (shen-deref (tl V1411) V1412)))
(true
- (if (shen-pvar? V1407)
- (let Value (shen-valvector V1407 V1408)
- (if (= Value shen--null-) V1407 (shen-deref Value V1408)))
- V1407))))
-
-(defun shen-lazyderef (V1409 V1410)
- (if (shen-pvar? V1409)
- (let Value (shen-valvector V1409 V1410)
- (if (= Value shen--null-) V1409 (shen-lazyderef Value V1410)))
- V1409))
-
-(defun shen-valvector (V1411 V1412)
- (<-address (<-address (value shen-*prologvectors*) V1412)
- (<-address V1411 1)))
-
-(defun unify! (V1413 V1414 V1415 V1416)
- (shen-lzy=! (shen-lazyderef V1413 V1415) (shen-lazyderef V1414 V1415) V1415
- V1416))
-
-(defun shen-lzy=! (V1433 V1434 V1435 V1436)
- (cond ((= V1434 V1433) (thaw V1436))
- ((and (shen-pvar? V1433) (not (shen-occurs? V1433 (shen-deref V1434 V1435))))
- (bind V1433 V1434 V1435 V1436))
- ((and (shen-pvar? V1434) (not (shen-occurs? V1434 (shen-deref V1433 V1435))))
- (bind V1434 V1433 V1435 V1436))
- ((and (cons? V1433) (cons? V1434))
- (shen-lzy=! (shen-lazyderef (hd V1433) V1435)
- (shen-lazyderef (hd V1434) V1435) V1435
+ (if (shen-pvar? V1411)
+ (let Value (shen-valvector V1411 V1412)
+ (if (= Value shen--null-) V1411 (shen-deref Value V1412)))
+ V1411))))
+
+(defun shen-lazyderef (V1413 V1414)
+ (if (shen-pvar? V1413)
+ (let Value (shen-valvector V1413 V1414)
+ (if (= Value shen--null-) V1413 (shen-lazyderef Value V1414)))
+ V1413))
+
+(defun shen-valvector (V1415 V1416)
+ (<-address (<-address (value shen-*prologvectors*) V1416)
+ (<-address V1415 1)))
+
+(defun unify! (V1417 V1418 V1419 V1420)
+ (shen-lzy=! (shen-lazyderef V1417 V1419) (shen-lazyderef V1418 V1419) V1419
+ V1420))
+
+(defun shen-lzy=! (V1437 V1438 V1439 V1440)
+ (cond ((= V1438 V1437) (thaw V1440))
+ ((and (shen-pvar? V1437) (not (shen-occurs? V1437 (shen-deref V1438 V1439))))
+ (bind V1437 V1438 V1439 V1440))
+ ((and (shen-pvar? V1438) (not (shen-occurs? V1438 (shen-deref V1437 V1439))))
+ (bind V1438 V1437 V1439 V1440))
+ ((and (cons? V1437) (cons? V1438))
+ (shen-lzy=! (shen-lazyderef (hd V1437) V1439)
+ (shen-lazyderef (hd V1438) V1439) V1439
(freeze
- (shen-lzy=! (shen-lazyderef (tl V1433) V1435)
- (shen-lazyderef (tl V1434) V1435) V1435 V1436))))
+ (shen-lzy=! (shen-lazyderef (tl V1437) V1439)
+ (shen-lazyderef (tl V1438) V1439) V1439 V1440))))
(true false)))
-(defun shen-occurs? (V1446 V1447)
- (cond ((= V1447 V1446) true)
- ((cons? V1447)
- (or (shen-occurs? V1446 (hd V1447)) (shen-occurs? V1446 (tl V1447))))
+(defun shen-occurs? (V1450 V1451)
+ (cond ((= V1451 V1450) true)
+ ((cons? V1451)
+ (or (shen-occurs? V1450 (hd V1451)) (shen-occurs? V1450 (tl V1451))))
(true false)))
-(defun identical (V1449 V1450 V1451 V1452)
- (shen-lzy== (shen-lazyderef V1449 V1451) (shen-lazyderef V1450 V1451) V1451
- V1452))
+(defun identical (V1453 V1454 V1455 V1456)
+ (shen-lzy== (shen-lazyderef V1453 V1455) (shen-lazyderef V1454 V1455) V1455
+ V1456))
-(defun shen-lzy== (V1469 V1470 V1471 V1472)
- (cond ((= V1470 V1469) (thaw V1472))
- ((and (cons? V1469) (cons? V1470))
- (shen-lzy== (shen-lazyderef (hd V1469) V1471)
- (shen-lazyderef (hd V1470) V1471) V1471
- (freeze (shen-lzy== (tl V1469) (tl V1470) V1471 V1472))))
+(defun shen-lzy== (V1473 V1474 V1475 V1476)
+ (cond ((= V1474 V1473) (thaw V1476))
+ ((and (cons? V1473) (cons? V1474))
+ (shen-lzy== (shen-lazyderef (hd V1473) V1475)
+ (shen-lazyderef (hd V1474) V1475) V1475
+ (freeze (shen-lzy== (tl V1473) (tl V1474) V1475 V1476))))
(true false)))
-(defun shen-pvar (V1474) (intmake-string "Var~A" (@p (<-address V1474 1) ())))
+(defun shen-pvar (V1478) (intmake-string "Var~A" (@p (<-address V1478 1) ())))
-(defun bind (V1475 V1476 V1477 V1478)
- (do (shen-bindv V1475 V1476 V1477)
- (let Result (thaw V1478) (do (shen-unbindv V1475 V1477) Result))))
+(defun bind (V1479 V1480 V1481 V1482)
+ (do (shen-bindv V1479 V1480 V1481)
+ (let Result (thaw V1482) (do (shen-unbindv V1479 V1481) Result))))
-(defun fwhen (V1493 V1494 V1495)
- (cond ((= true V1493) (thaw V1495)) ((= false V1493) false)
- (true (interror "fwhen expects a boolean: not ~S%" (@p V1493 ())))))
+(defun fwhen (V1497 V1498 V1499)
+ (cond ((= true V1497) (thaw V1499)) ((= false V1497) false)
+ (true (interror "fwhen expects a boolean: not ~S%" (@p V1497 ())))))
-(defun call (V1508 V1509 V1510)
+(defun call (V1512 V1513 V1514)
(cond
- ((cons? V1508)
+ ((cons? V1512)
(shen-call-help
- (shen-m_prolog_to_s-prolog_predicate (shen-lazyderef (hd V1508) V1509))
- (tl V1508) V1509 V1510))
+ (shen-m_prolog_to_s-prolog_predicate (shen-lazyderef (hd V1512) V1513))
+ (tl V1512) V1513 V1514))
(true false)))
-(defun shen-call-help (V1511 V1512 V1513 V1514)
- (cond ((= () V1512) (V1511 V1513 V1514))
- ((cons? V1512) (shen-call-help (V1511 (hd V1512)) (tl V1512) V1513 V1514))
+(defun shen-call-help (V1515 V1516 V1517 V1518)
+ (cond ((= () V1516) (V1515 V1517 V1518))
+ ((cons? V1516) (shen-call-help (V1515 (hd V1516)) (tl V1516) V1517 V1518))
(true (shen-sys-error shen-call-help))))
-(defun shen-intprolog (V1515)
+(defun shen-intprolog (V1519)
(cond
- ((and (cons? V1515) (cons? (hd V1515)))
+ ((and (cons? V1519) (cons? (hd V1519)))
(let ProcessN (shen-start-new-prolog-process)
- (shen-intprolog-help (hd (hd V1515))
- (shen-insert-prolog-variables (cons (tl (hd V1515)) (cons (tl V1515) ()))
+ (shen-intprolog-help (hd (hd V1519))
+ (shen-insert-prolog-variables (cons (tl (hd V1519)) (cons (tl V1519) ()))
ProcessN)
ProcessN)))
(true (shen-sys-error shen-intprolog))))
-(defun shen-intprolog-help (V1516 V1517 V1518)
+(defun shen-intprolog-help (V1520 V1521 V1522)
(cond
- ((and (cons? V1517) (and (cons? (tl V1517)) (= () (tl (tl V1517)))))
- (shen-intprolog-help-help V1516 (hd V1517) (hd (tl V1517)) V1518))
+ ((and (cons? V1521) (and (cons? (tl V1521)) (= () (tl (tl V1521)))))
+ (shen-intprolog-help-help V1520 (hd V1521) (hd (tl V1521)) V1522))
(true (shen-sys-error shen-intprolog-help))))
-(defun shen-intprolog-help-help (V1519 V1520 V1521 V1522)
- (cond ((= () V1520) (V1519 V1522 (freeze (shen-call-rest V1521 V1522))))
- ((cons? V1520)
- (shen-intprolog-help-help (V1519 (hd V1520)) (tl V1520) V1521 V1522))
+(defun shen-intprolog-help-help (V1523 V1524 V1525 V1526)
+ (cond ((= () V1524) (V1523 V1526 (freeze (shen-call-rest V1525 V1526))))
+ ((cons? V1524)
+ (shen-intprolog-help-help (V1523 (hd V1524)) (tl V1524) V1525 V1526))
(true (shen-sys-error shen-intprolog-help-help))))
-(defun shen-call-rest (V1525 V1526)
- (cond ((= () V1525) true)
- ((and (cons? V1525) (and (cons? (hd V1525)) (cons? (tl (hd V1525)))))
+(defun shen-call-rest (V1529 V1530)
+ (cond ((= () V1529) true)
+ ((and (cons? V1529) (and (cons? (hd V1529)) (cons? (tl (hd V1529)))))
(shen-call-rest
- (cons (cons ((hd (hd V1525)) (hd (tl (hd V1525)))) (tl (tl (hd V1525))))
- (tl V1525))
- V1526))
- ((and (cons? V1525) (and (cons? (hd V1525)) (= () (tl (hd V1525)))))
- ((hd (hd V1525)) V1526 (freeze (shen-call-rest (tl V1525) V1526))))
+ (cons (cons ((hd (hd V1529)) (hd (tl (hd V1529)))) (tl (tl (hd V1529))))
+ (tl V1529))
+ V1530))
+ ((and (cons? V1529) (and (cons? (hd V1529)) (= () (tl (hd V1529)))))
+ ((hd (hd V1529)) V1530 (freeze (shen-call-rest (tl V1529) V1530))))
(true (shen-sys-error shen-call-rest))))
(defun shen-start-new-prolog-process ()
@@ -1288,22 +1288,22 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(set shen-*process-counter* (+ 1 (value shen-*process-counter*)))
(shen-initialise-prolog IncrementProcessCounter)))
-(defun shen-insert-prolog-variables (V1527 V1528)
- (shen-insert-prolog-variables-help V1527 (shen-flatten V1527) V1528))
-
-(defun shen-insert-prolog-variables-help (V1533 V1534 V1535)
- (cond ((= () V1534) V1533)
- ((and (cons? V1534) (variable? (hd V1534)))
- (let V (shen-newpv V1535)
- (let XV/Y (subst V (hd V1534) V1533)
- (let Z-Y (remove (hd V1534) (tl V1534))
- (shen-insert-prolog-variables-help XV/Y Z-Y V1535)))))
- ((cons? V1534) (shen-insert-prolog-variables-help V1533 (tl V1534) V1535))
+(defun shen-insert-prolog-variables (V1531 V1532)
+ (shen-insert-prolog-variables-help V1531 (shen-flatten V1531) V1532))
+
+(defun shen-insert-prolog-variables-help (V1537 V1538 V1539)
+ (cond ((= () V1538) V1537)
+ ((and (cons? V1538) (variable? (hd V1538)))
+ (let V (shen-newpv V1539)
+ (let XV/Y (subst V (hd V1538) V1537)
+ (let Z-Y (remove (hd V1538) (tl V1538))
+ (shen-insert-prolog-variables-help XV/Y Z-Y V1539)))))
+ ((cons? V1538) (shen-insert-prolog-variables-help V1537 (tl V1538) V1539))
(true (shen-sys-error shen-insert-prolog-variables-help))))
-(defun shen-initialise-prolog (V1536)
+(defun shen-initialise-prolog (V1540)
(let Vector
- (address-> (value shen-*prologvectors*) V1536
+ (address-> (value shen-*prologvectors*) V1540
(shen-fillvector (vector 10) 1 10 shen--null-))
- (let Counter (address-> (value shen-*varcounter*) V1536 1) V1536)))
+ (let Counter (address-> (value shen-*varcounter*) V1540 1) V1540)))
View
586 shen/klambda/reader.kl
@@ -181,34 +181,34 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(defun lineread () (shen-lineread-loop (read-byte (stinput 0)) ()))
-(defun shen-lineread-loop (V960 V961)
- (cond ((= V960 (shen-hat)) (interror "line read aborted" ()))
- ((element? V960 (cons (shen-newline) (cons (shen-carriage-return) ())))
- (let Line (compile (lambda V962 (shen-<st_input> V962)) V961 ())
+(defun shen-lineread-loop (V967 V968)
+ (cond ((= V967 (shen-hat)) (interror "line read aborted" ()))
+ ((element? V967 (cons (shen-newline) (cons (shen-carriage-return) ())))
+ (let Line (compile (lambda V969 (shen-<st_input> V969)) V968 ())
(if (or (= Line (fail)) (empty? Line))
- (shen-lineread-loop (read-byte (stinput 0)) (append V961 (cons V960 ())))
+ (shen-lineread-loop (read-byte (stinput 0)) (append V968 (cons V967 ())))
Line)))
(true
(shen-lineread-loop (read-byte (stinput 0))
- (append V961 (cons V960 ()))))))
+ (append V968 (cons V967 ()))))))
-(defun read-file (V963)
- (let Bytelist (read-file-as-bytelist V963)
- (compile (lambda V964 (shen-<st_input> V964)) Bytelist
- (lambda V965 (shen-read-error V965)))))
+(defun read-file (V970)
+ (let Bytelist (read-file-as-bytelist V970)
+ (compile (lambda V971 (shen-<st_input> V971)) Bytelist
+ (lambda V972 (shen-read-error V972)))))
-(defun shen-read-error (V966)
- (interror "read error here:~%~% ~A~%" (@p (shen-compress-50 50 V966) ())))
+(defun shen-read-error (V973)
+ (interror "read error here:~%~% ~A~%" (@p (shen-compress-50 50 V973) ())))
-(defun shen-compress-50 (V971 V972)
- (cond ((= () V972) "") ((= 0 V971) "")
- ((cons? V972)
- (cn (n->string (hd V972)) (shen-compress-50 (- V971 1) (tl V972))))
+(defun shen-compress-50 (V978 V979)
+ (cond ((= () V979) "") ((= 0 V978) "")
+ ((cons? V979)
+ (cn (n->string (hd V979)) (shen-compress-50 (- V978 1) (tl V979))))
(true (shen-sys-error shen-compress-50))))
-(defun shen-<st_input> (V973)
+(defun shen-<st_input> (V980)
(let Result
- (let Parse_<lsb> (shen-<lsb> V973)
+ (let Parse_<lsb> (shen-<lsb> V980)
(if (not (= (fail) Parse_<lsb>))
(let Parse_<st_input1> (shen-<st_input1> Parse_<lsb>)
(if (not (= (fail) Parse_<st_input1>))
@@ -225,7 +225,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<lrb> (shen-<lrb> V973)
+ (let Parse_<lrb> (shen-<lrb> V980)
(if (not (= (fail) Parse_<lrb>))
(let Parse_<st_input1> (shen-<st_input1> Parse_<lrb>)
(if (not (= (fail) Parse_<st_input1>))
@@ -242,7 +242,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<lcurly> (shen-<lcurly> V973)
+ (let Parse_<lcurly> (shen-<lcurly> V980)
(if (not (= (fail) Parse_<lcurly>))
(let Parse_<st_input> (shen-<st_input> Parse_<lcurly>)
(if (not (= (fail) Parse_<st_input>))
@@ -252,7 +252,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<rcurly> (shen-<rcurly> V973)
+ (let Parse_<rcurly> (shen-<rcurly> V980)
(if (not (= (fail) Parse_<rcurly>))
(let Parse_<st_input> (shen-<st_input> Parse_<rcurly>)
(if (not (= (fail) Parse_<st_input>))
@@ -262,7 +262,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<bar> (shen-<bar> V973)
+ (let Parse_<bar> (shen-<bar> V980)
(if (not (= (fail) Parse_<bar>))
(let Parse_<st_input> (shen-<st_input> Parse_<bar>)
(if (not (= (fail) Parse_<st_input>))
@@ -272,7 +272,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<semicolon> (shen-<semicolon> V973)
+ (let Parse_<semicolon> (shen-<semicolon> V980)
(if (not (= (fail) Parse_<semicolon>))
(let Parse_<st_input> (shen-<st_input> Parse_<semicolon>)
(if (not (= (fail) Parse_<st_input>))
@@ -282,7 +282,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<colon> (shen-<colon> V973)
+ (let Parse_<colon> (shen-<colon> V980)
(if (not (= (fail) Parse_<colon>))
(let Parse_<equal> (shen-<equal> Parse_<colon>)
(if (not (= (fail) Parse_<equal>))
@@ -295,7 +295,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<colon> (shen-<colon> V973)
+ (let Parse_<colon> (shen-<colon> V980)
(if (not (= (fail) Parse_<colon>))
(let Parse_<minus> (shen-<minus> Parse_<colon>)
(if (not (= (fail) Parse_<minus>))
@@ -308,7 +308,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<colon> (shen-<colon> V973)
+ (let Parse_<colon> (shen-<colon> V980)
(if (not (= (fail) Parse_<colon>))
(let Parse_<st_input> (shen-<st_input> Parse_<colon>)
(if (not (= (fail) Parse_<st_input>))
@@ -318,7 +318,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<comma> (shen-<comma> V973)
+ (let Parse_<comma> (shen-<comma> V980)
(if (not (= (fail) Parse_<comma>))
(let Parse_<st_input> (shen-<st_input> Parse_<comma>)
(if (not (= (fail) Parse_<st_input>))
@@ -328,7 +328,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<comment> (shen-<comment> V973)
+ (let Parse_<comment> (shen-<comment> V980)
(if (not (= (fail) Parse_<comment>))
(let Parse_<st_input> (shen-<st_input> Parse_<comment>)
(if (not (= (fail) Parse_<st_input>))
@@ -338,7 +338,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<atom> (shen-<atom> V973)
+ (let Parse_<atom> (shen-<atom> V980)
(if (not (= (fail) Parse_<atom>))
(let Parse_<st_input> (shen-<st_input> Parse_<atom>)
(if (not (= (fail) Parse_<st_input>))
@@ -349,7 +349,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<whitespaces> (shen-<whitespaces> V973)
+ (let Parse_<whitespaces> (shen-<whitespaces> V980)
(if (not (= (fail) Parse_<whitespaces>))
(let Parse_<st_input>
(shen-<st_input> Parse_<whitespaces>)
@@ -360,7 +360,7 @@ For an explication of this license see http://www.lambdassociates.org/News/june1
(fail)))
(if (= Result (fail))
(let Result
- (let Parse_<e> (<e> V973)
+ (let Parse_<e> (<e> V980)
(if (not (= (fail) Parse_<e>))
(shen-reassemble (fst Parse_<e>) ()) (fail)