"********************************************************************************** * The License * * * * The user is free to produce commercial applications with the software, to * * distribute these applications in source or binary form, and to charge monies * * for them as he sees fit and in concordance with the laws of the land subject * * to the following license. * * * * 1. The license applies to all the software and all derived software and * * must appear on such. * * * * 2. It is illegal to distribute the software without this license attached * * to it and use of the software implies agreement with the license as such. * * It is illegal for anyone who is not the copyright holder to tamper with * * or change the license. * * * * 3. Neither the names of Lambda Associates or the copyright holder may be used * * to endorse or promote products built using the software without specific * * prior written permission from the copyright holder. * * * * 4. That possession of this license does not confer on the copyright holder * * any special contractual obligation towards the user. That in no event * * shall the copyright holder be liable for any direct, indirect, incidental, * * special, exemplary or consequential damages (including but not limited * * to procurement of substitute goods or services, loss of use, data, * * interruption), however caused and on any theory of liability, whether in * * contract, strict liability or tort (including negligence) arising in any * * way out of the use of the software, even if advised of the possibility of * * such damage. * * * * 5. It is permitted for the user to change the software, for the purpose of * * improving performance, correcting an error, or porting to a new platform, * * and distribute the derived version of Shen provided the resulting program * * conforms in all respects to the Shen standard and is issued under that * * title. The user must make it clear with his distribution that he/she is * * the author of the changes and what these changes are and why. * * * * 6. Derived versions of this software in whatever form are subject to the same * * restrictions. In particular it is not permitted to make derived copies of * * this software which do not conform to the Shen standard or appear under a * * different title. * * * * It is permitted to distribute versions of Shen which incorporate libraries, * * graphics or other facilities which are not part of the Shen standard. * * * * For an explication of this license see www.shenlanguage.org/license.htm which * * explains this license in full. * * * ***************************************************************************************** "(defun shen.yacc (V2180) (cond ((and (cons? V2180) (and (= defcc (hd V2180)) (and (cons? (tl V2180)) (and (cons? (tl (tl V2180))) (and (= { (hd (tl (tl V2180)))) (and (cons? (tl (tl (tl V2180)))) (and (cons? (tl (tl (tl (tl V2180))))) (and (= ==> (hd (tl (tl (tl (tl V2180)))))) (and (cons? (tl (tl (tl (tl (tl V2180)))))) (and (cons? (tl (tl (tl (tl (tl (tl V2180))))))) (= } (hd (tl (tl (tl (tl (tl (tl V2180)))))))))))))))))) (shen.yacc (cons defcc (cons (hd (tl V2180)) (tl (tl (tl (tl (tl (tl (tl V2180))))))))))) ((and (cons? V2180) (and (= defcc (hd V2180)) (cons? (tl V2180)))) (shen.yacc->shen (hd (tl V2180)) (tl (tl V2180)))) (true (shen.sys-error shen.yacc)))) (defun shen.yacc->shen (V2181 V2182) (let CCRules (shen.split_cc_rules true V2182 ()) (let CCBody (map (lambda X2178 (shen.cc_body X2178)) CCRules) (let YaccCases (shen.yacc_cases CCBody) (cons define (cons V2181 (cons Stream (cons -> (cons (shen.kill-code YaccCases) ()))))))))) (defun shen.kill-code (V2183) (cond ((> (occurrences kill V2183) 0) (cons trap-error (cons V2183 (cons (cons lambda (cons E (cons (cons shen.analyse-kill (cons E ())) ()))) ())))) (true V2183))) (defun kill () (simple-error "yacc kill")) (defun shen.analyse-kill (V2184) (let String (error-to-string V2184) (if (= String "yacc kill") (fail) V2184))) (defun shen.split_cc_rules (V2187 V2188 V2189) (cond ((and (= () V2188) (= () V2189)) ()) ((= () V2188) (cons (shen.split_cc_rule V2187 (reverse V2189) ()) ())) ((and (cons? V2188) (= ; (hd V2188))) (cons (shen.split_cc_rule V2187 (reverse V2189) ()) (shen.split_cc_rules V2187 (tl V2188) ()))) ((cons? V2188) (shen.split_cc_rules V2187 (tl V2188) (cons (hd V2188) V2189))) (true (shen.sys-error shen.split_cc_rules)))) (defun shen.split_cc_rule (V2194 V2195 V2196) (cond ((and (cons? V2195) (and (= := (hd V2195)) (and (cons? (tl V2195)) (= () (tl (tl V2195)))))) (cons (reverse V2196) (tl V2195))) ((and (cons? V2195) (and (= := (hd V2195)) (and (cons? (tl V2195)) (and (cons? (tl (tl V2195))) (and (= where (hd (tl (tl V2195)))) (and (cons? (tl (tl (tl V2195)))) (= () (tl (tl (tl (tl V2195))))))))))) (cons (reverse V2196) (cons (cons where (cons (hd (tl (tl (tl V2195)))) (cons (hd (tl V2195)) ()))) ()))) ((= () V2195) (do (shen.semantic-completion-warning V2194 V2196) (shen.split_cc_rule V2194 (cons := (cons (shen.default_semantics (reverse V2196)) ())) V2196))) ((cons? V2195) (shen.split_cc_rule V2194 (tl V2195) (cons (hd V2195) V2196))) (true (shen.sys-error shen.split_cc_rule)))) (defun shen.semantic-completion-warning (V2205 V2206) (cond ((= true V2205) (do (shen.prhush "warning: " (stoutput)) (do (map (lambda X (shen.prhush (shen.app X " " shen.a) (stoutput))) (reverse V2206)) (shen.prhush "has no semantics. " (stoutput))))) (true shen.skip))) (defun shen.default_semantics (V2207) (cond ((= () V2207) ()) ((and (cons? V2207) (and (= () (tl V2207)) (shen.grammar_symbol? (hd V2207)))) (hd V2207)) ((and (cons? V2207) (shen.grammar_symbol? (hd V2207))) (cons append (cons (hd V2207) (cons (shen.default_semantics (tl V2207)) ())))) ((cons? V2207) (cons cons (cons (hd V2207) (cons (shen.default_semantics (tl V2207)) ())))) (true (shen.sys-error shen.default_semantics)))) (defun shen.grammar_symbol? (V2208) (and (symbol? V2208) (let Cs (shen.strip-pathname (explode V2208)) (and (= (hd Cs) "<") (= (hd (reverse Cs)) ">"))))) (defun shen.yacc_cases (V2209) (cond ((and (cons? V2209) (= () (tl V2209))) (hd V2209)) ((cons? V2209) (let P YaccParse (cons let (cons P (cons (hd V2209) (cons (cons if (cons (cons = (cons P (cons (cons fail ()) ()))) (cons (shen.yacc_cases (tl V2209)) (cons P ())))) ())))))) (true (shen.sys-error shen.yacc_cases)))) (defun shen.cc_body (V2210) (cond ((and (cons? V2210) (and (cons? (tl V2210)) (= () (tl (tl V2210))))) (shen.syntax (hd V2210) Stream (hd (tl V2210)))) (true (shen.sys-error shen.cc_body)))) (defun shen.syntax (V2211 V2212 V2213) (cond ((and (= () V2211) (and (cons? V2213) (and (= where (hd V2213)) (and (cons? (tl V2213)) (and (cons? (tl (tl V2213))) (= () (tl (tl (tl V2213))))))))) (cons if (cons (shen.semantics (hd (tl V2213))) (cons (cons shen.pair (cons (cons hd (cons V2212 ())) (cons (shen.semantics (hd (tl (tl V2213)))) ()))) (cons (cons fail ()) ()))))) ((= () V2211) (cons shen.pair (cons (cons hd (cons V2212 ())) (cons (shen.semantics V2213) ())))) ((cons? V2211) (if (shen.grammar_symbol? (hd V2211)) (shen.recursive_descent V2211 V2212 V2213) (if (variable? (hd V2211)) (shen.variable-match V2211 V2212 V2213) (if (shen.jump_stream? (hd V2211)) (shen.jump_stream V2211 V2212 V2213) (if (shen.terminal? (hd V2211)) (shen.check_stream V2211 V2212 V2213) (if (cons? (hd V2211)) (shen.list-stream (shen.decons (hd V2211)) (tl V2211) V2212 V2213) (simple-error (shen.app (hd V2211) " is not legal syntax " shen.a)))))))) (true (shen.sys-error shen.syntax)))) (defun shen.list-stream (V2214 V2215 V2216 V2217) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2216 ())) ())) (cons (cons cons? (cons (cons hd (cons (cons hd (cons V2216 ())) ())) ())) ()))) (let Placeholder (gensym shen.place) (let RunOn (shen.syntax V2215 (cons shen.pair (cons (cons tl (cons (cons hd (cons V2216 ())) ())) (cons (cons hd (cons (cons tl (cons V2216 ())) ())) ()))) V2217) (let Action (shen.insert-runon RunOn Placeholder (shen.syntax V2214 (cons shen.pair (cons (cons hd (cons (cons hd (cons V2216 ())) ())) (cons (cons hd (cons (cons tl (cons V2216 ())) ())) ()))) Placeholder)) (cons if (cons Test (cons Action (cons (cons fail ()) ()))))))))) (defun shen.decons (V2218) (cond ((and (cons? V2218) (and (= cons (hd V2218)) (and (cons? (tl V2218)) (and (cons? (tl (tl V2218))) (and (= () (hd (tl (tl V2218)))) (= () (tl (tl (tl V2218))))))))) (cons (hd (tl V2218)) ())) ((and (cons? V2218) (and (= cons (hd V2218)) (and (cons? (tl V2218)) (and (cons? (tl (tl V2218))) (= () (tl (tl (tl V2218)))))))) (cons (hd (tl V2218)) (shen.decons (hd (tl (tl V2218)))))) (true V2218))) (defun shen.insert-runon (V2229 V2230 V2231) (cond ((and (cons? V2231) (and (= shen.pair (hd V2231)) (and (cons? (tl V2231)) (and (cons? (tl (tl V2231))) (and (= () (tl (tl (tl V2231)))) (= (hd (tl (tl V2231))) V2230)))))) V2229) ((cons? V2231) (map (lambda Z (shen.insert-runon V2229 V2230 Z)) V2231)) (true V2231))) (defun shen.strip-pathname (V2237) (cond ((not (element? "." V2237)) V2237) ((cons? V2237) (shen.strip-pathname (tl V2237))) (true (shen.sys-error shen.strip-pathname)))) (defun shen.recursive_descent (V2238 V2239 V2240) (cond ((cons? V2238) (let Test (cons (hd V2238) (cons V2239 ())) (let Action (shen.syntax (tl V2238) (concat Parse_ (hd V2238)) V2240) (let Else (cons fail ()) (cons let (cons (concat Parse_ (hd V2238)) (cons Test (cons (cons if (cons (cons not (cons (cons = (cons (cons fail ()) (cons (concat Parse_ (hd V2238)) ()))) ())) (cons Action (cons Else ())))) ())))))))) (true (shen.sys-error shen.recursive_descent)))) (defun shen.variable-match (V2241 V2242 V2243) (cond ((cons? V2241) (let Test (cons cons? (cons (cons hd (cons V2242 ())) ())) (let Action (cons let (cons (concat Parse_ (hd V2241)) (cons (cons hd (cons (cons hd (cons V2242 ())) ())) (cons (shen.syntax (tl V2241) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2242 ())) ())) (cons (cons shen.hdtl (cons V2242 ())) ()))) V2243) ())))) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.variable-match)))) (defun shen.terminal? (V2252) (cond ((cons? V2252) false) ((variable? V2252) false) (true true))) (defun shen.jump_stream? (V2257) (cond ((= V2257 _) true) (true false))) (defun shen.check_stream (V2258 V2259 V2260) (cond ((cons? V2258) (let Test (cons and (cons (cons cons? (cons (cons hd (cons V2259 ())) ())) (cons (cons = (cons (hd V2258) (cons (cons hd (cons (cons hd (cons V2259 ())) ())) ()))) ()))) (let Action (shen.syntax (tl V2258) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2259 ())) ())) (cons (cons shen.hdtl (cons V2259 ())) ()))) V2260) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.check_stream)))) (defun shen.jump_stream (V2261 V2262 V2263) (cond ((cons? V2261) (let Test (cons cons? (cons (cons hd (cons V2262 ())) ())) (let Action (shen.syntax (tl V2261) (cons shen.pair (cons (cons tl (cons (cons hd (cons V2262 ())) ())) (cons (cons shen.hdtl (cons V2262 ())) ()))) V2263) (let Else (cons fail ()) (cons if (cons Test (cons Action (cons Else ())))))))) (true (shen.sys-error shen.jump_stream)))) (defun shen.semantics (V2264) (cond ((= () V2264) ()) ((shen.grammar_symbol? V2264) (cons shen.hdtl (cons (concat Parse_ V2264) ()))) ((variable? V2264) (concat Parse_ V2264)) ((cons? V2264) (map (lambda X2179 (shen.semantics X2179)) V2264)) (true V2264))) (defun shen.snd-or-fail (V2271) (cond ((and (cons? V2271) (and (cons? (tl V2271)) (= () (tl (tl V2271))))) (hd (tl V2271))) (true (fail)))) (defun fail () shen.fail!) (defun shen.pair (V2272 V2273) (cons V2272 (cons V2273 ()))) (defun shen.hdtl (V2274) (hd (tl V2274))) (defun (V2281) (cond ((and (cons? V2281) (and (cons? (tl V2281)) (= () (tl (tl V2281))))) (cons () (cons (hd V2281) ()))) (true (fail)))) (defun (V2286) (cond ((and (cons? V2286) (and (cons? (tl V2286)) (= () (tl (tl V2286))))) (cons (hd V2286) (cons () ()))) (true (shen.sys-error ))))