shen-ruby 0.3.1 → 0.4.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (55) hide show
  1. data/.gitignore +2 -0
  2. data/.travis.yml +5 -0
  3. data/Gemfile +2 -2
  4. data/HISTORY.md +12 -0
  5. data/README.md +10 -7
  6. data/Rakefile +92 -0
  7. data/bin/srrepl +2 -2
  8. data/k_lambda_spec/primitives/arithmetic_spec.rb +175 -0
  9. data/k_lambda_spec/primitives/assignments_spec.rb +44 -0
  10. data/k_lambda_spec/primitives/generic_functions_spec.rb +115 -2
  11. data/k_lambda_spec/primitives/lists_spec.rb +40 -0
  12. data/k_lambda_spec/primitives/strings_spec.rb +77 -0
  13. data/k_lambda_spec/primitives/symbols_spec.rb +24 -0
  14. data/k_lambda_spec/primitives/vectors_spec.rb +92 -0
  15. data/k_lambda_spec/support/shared_examples.rb +93 -2
  16. data/k_lambda_spec/tail_recursion_spec.rb +30 -0
  17. data/lib/kl/compiler.rb +19 -33
  18. data/lib/kl/environment.rb +1 -0
  19. data/lib/kl/primitives/assignments.rb +1 -0
  20. data/lib/kl/primitives/generic_functions.rb +7 -0
  21. data/lib/kl/primitives/lists.rb +2 -0
  22. data/lib/kl/primitives/strings.rb +13 -5
  23. data/lib/kl/primitives/symbols.rb +1 -0
  24. data/lib/kl/primitives/vectors.rb +5 -0
  25. data/lib/shen_ruby/version.rb +1 -1
  26. data/shen-ruby.gemspec +1 -1
  27. data/shen/lib/shen_ruby/shen.rb +5 -6
  28. data/shen/release/benchmarks/benchmarks.shen +0 -4
  29. data/shen/release/benchmarks/interpreter.shen +2 -2
  30. data/shen/release/benchmarks/plato.jpg +0 -0
  31. data/shen/release/k_lambda/core.kl +171 -1000
  32. data/shen/release/k_lambda/declarations.kl +90 -992
  33. data/shen/release/k_lambda/load.kl +69 -81
  34. data/shen/release/k_lambda/macros.kl +113 -478
  35. data/shen/release/k_lambda/prolog.kl +250 -1307
  36. data/shen/release/k_lambda/reader.kl +115 -996
  37. data/shen/release/k_lambda/sequent.kl +154 -554
  38. data/shen/release/k_lambda/sys.kl +246 -562
  39. data/shen/release/k_lambda/t-star.kl +114 -3643
  40. data/shen/release/k_lambda/toplevel.kl +136 -221
  41. data/shen/release/k_lambda/track.kl +101 -206
  42. data/shen/release/k_lambda/types.kl +143 -298
  43. data/shen/release/k_lambda/writer.kl +93 -106
  44. data/shen/release/k_lambda/yacc.kl +77 -252
  45. data/shen/release/test_programs/README.shen +1 -1
  46. data/shen/release/test_programs/classes-typed.shen +1 -1
  47. data/shen/release/test_programs/interpreter.shen +2 -2
  48. data/shen/release/test_programs/metaprog.shen +2 -2
  49. data/shen/release/test_programs/prolog.shen +79 -0
  50. data/shen/release/test_programs/structures-typed.shen +2 -2
  51. data/shen/release/test_programs/tests.shen +19 -80
  52. data/shen/release/test_programs/yacc.shen +11 -15
  53. metadata +14 -6
  54. data/Gemfile.lock +0 -20
  55. data/shen/release/benchmarks/br.shen +0 -13
@@ -1,223 +1,138 @@
1
+ "**********************************************************************************
2
+ * The License *
3
+ * *
4
+ * The user is free to produce commercial applications with the software, to *
5
+ * distribute these applications in source or binary form, and to charge monies *
6
+ * for them as he sees fit and in concordance with the laws of the land subject *
7
+ * to the following license. *
8
+ * *
9
+ * 1. The license applies to all the software and all derived software and *
10
+ * must appear on such. *
11
+ * *
12
+ * 2. It is illegal to distribute the software without this license attached *
13
+ * to it and use of the software implies agreement with the license as such. *
14
+ * It is illegal for anyone who is not the copyright holder to tamper with *
15
+ * or change the license. *
16
+ * *
17
+ * 3. Neither the names of Lambda Associates or the copyright holder may be used *
18
+ * to endorse or promote products built using the software without specific *
19
+ * prior written permission from the copyright holder. *
20
+ * *
21
+ * 4. That possession of this license does not confer on the copyright holder *
22
+ * any special contractual obligation towards the user. That in no event *
23
+ * shall the copyright holder be liable for any direct, indirect, incidental, *
24
+ * special, exemplary or consequential damages (including but not limited *
25
+ * to procurement of substitute goods or services, loss of use, data, *
26
+ * interruption), however caused and on any theory of liability, whether in *
27
+ * contract, strict liability or tort (including negligence) arising in any *
28
+ * way out of the use of the software, even if advised of the possibility of *
29
+ * such damage. *
30
+ * *
31
+ * 5. It is permitted for the user to change the software, for the purpose of *
32
+ * improving performance, correcting an error, or porting to a new platform, *
33
+ * and distribute the derived version of Shen provided the resulting program *
34
+ * conforms in all respects to the Shen standard and is issued under that *
35
+ * title. The user must make it clear with his distribution that he/she is *
36
+ * the author of the changes and what these changes are and why. *
37
+ * *
38
+ * 6. Derived versions of this software in whatever form are subject to the same *
39
+ * restrictions. In particular it is not permitted to make derived copies of *
40
+ * this software which do not conform to the Shen standard or appear under a *
41
+ * different title. *
42
+ * *
43
+ * It is permitted to distribute versions of Shen which incorporate libraries, *
44
+ * graphics or other facilities which are not part of the Shen standard. *
45
+ * *
46
+ * For an explication of this license see www.shenlanguage.org/license.htm which *
47
+ * explains this license in full. *
48
+ * *
49
+ *****************************************************************************************
50
+ "(defun shen.shen () (do (shen.credits) (shen.loop)))
51
+
52
+ (defun shen.loop () (do (shen.initialise_environment) (do (shen.prompt) (do (trap-error (shen.read-evaluate-print) (lambda E (pr (error-to-string E) (stoutput)))) (shen.loop)))))
53
+
54
+ (defun version (V2238) (set *version* V2238))
55
+
56
+ (version "version 9")
57
+
58
+ (defun shen.credits () (do (pr "
59
+ Shen 2010, copyright (C) 2010 Mark Tarver
60
+ " (stoutput)) (do (pr (cn "www.shenlanguage.org, " (shen.app (value *version*) "
61
+ " shen.a)) (stoutput)) (do (pr (cn "running under " (shen.app (value *language*) (cn ", implementation: " (shen.app (value *implementation*) "" shen.a)) shen.a)) (stoutput)) (pr (cn "
62
+ port " (shen.app (value *port*) (cn " ported by " (shen.app (value *porters*) "
63
+ " shen.a)) shen.a)) (stoutput))))))
64
+
65
+ (defun shen.initialise_environment () (shen.multiple-set (cons shen.*call* (cons 0 (cons shen.*infs* (cons 0 (cons shen.*process-counter* (cons 0 (cons shen.*catch* (cons 0 ()))))))))))
66
+
67
+ (defun shen.multiple-set (V2239) (cond ((= () V2239) ()) ((and (cons? V2239) (cons? (tl V2239))) (do (set (hd V2239) (hd (tl V2239))) (shen.multiple-set (tl (tl V2239))))) (true (shen.sys-error shen.multiple-set))))
68
+
69
+ (defun destroy (V2240) (declare V2240 ()))
70
+
71
+ (set shen.*history* ())
72
+
73
+ (defun shen.read-evaluate-print () (let Lineread (shen.toplineread) (let History (value shen.*history*) (let NewLineread (shen.retrieve-from-history-if-needed Lineread History) (let NewHistory (shen.update_history NewLineread History) (let Parsed (fst NewLineread) (shen.toplevel Parsed)))))))
74
+
75
+ (defun shen.retrieve-from-history-if-needed (V2250 V2251) (cond ((and (tuple? V2250) (and (cons? (snd V2250)) (and (cons? (tl (snd V2250))) (and (= () (tl (tl (snd V2250)))) (and (cons? V2251) (and (= (hd (snd V2250)) (shen.exclamation)) (= (hd (tl (snd V2250))) (shen.exclamation)))))))) (let PastPrint (shen.prbytes (snd (hd V2251))) (hd V2251))) ((and (tuple? V2250) (and (cons? (snd V2250)) (= (hd (snd V2250)) (shen.exclamation)))) (let Key? (shen.make-key (tl (snd V2250)) V2251) (let Find (head (shen.find-past-inputs Key? V2251)) (let PastPrint (shen.prbytes (snd Find)) Find)))) ((and (tuple? V2250) (and (cons? (snd V2250)) (and (= () (tl (snd V2250))) (= (hd (snd V2250)) (shen.percent))))) (do (shen.print-past-inputs (lambda X true) (reverse V2251) 0) (abort))) ((and (tuple? V2250) (and (cons? (snd V2250)) (= (hd (snd V2250)) (shen.percent)))) (let Key? (shen.make-key (tl (snd V2250)) V2251) (let Pastprint (shen.print-past-inputs Key? (reverse V2251) 0) (abort)))) (true V2250)))
76
+
77
+ (defun shen.percent () 37)
78
+
79
+ (defun shen.exclamation () 33)
80
+
81
+ (defun shen.prbytes (V2252) (do (map (lambda Byte (pr (n->string Byte) (stoutput))) V2252) (nl 1)))
82
+
83
+ (defun shen.update_history (V2253 V2254) (set shen.*history* (cons V2253 V2254)))
84
+
85
+ (defun shen.toplineread () (shen.toplineread_loop (read-byte (stinput)) ()))
86
+
87
+ (defun shen.toplineread_loop (V2256 V2257) (cond ((= V2256 (shen.hat)) (simple-error "line read aborted")) ((element? V2256 (cons (shen.newline) (cons (shen.carriage-return) ()))) (let Line (compile shen.<st_input> V2257 (lambda E shen.nextline)) (if (or (= Line shen.nextline) (empty? Line)) (shen.toplineread_loop (read-byte (stinput)) (append V2257 (cons V2256 ()))) (@p Line V2257)))) (true (shen.toplineread_loop (read-byte (stinput)) (append V2257 (cons V2256 ()))))))
88
+
89
+ (defun shen.hat () 94)
90
+
91
+ (defun shen.newline () 10)
92
+
93
+ (defun shen.carriage-return () 13)
94
+
95
+ (defun tc (V2262) (cond ((= + V2262) (set shen.*tc* true)) ((= - V2262) (set shen.*tc* false)) (true (simple-error "tc expects a + or -"))))
96
+
97
+ (defun shen.prompt () (if (value shen.*tc*) (pr (cn "
98
+
99
+ (" (shen.app (length (value shen.*history*)) "+) " shen.a)) (stoutput)) (pr (cn "
100
+
101
+ (" (shen.app (length (value shen.*history*)) "-) " shen.a)) (stoutput))))
102
+
103
+ (defun shen.toplevel (V2263) (shen.toplevel_evaluate V2263 (value shen.*tc*)))
104
+
105
+ (defun shen.find-past-inputs (V2264 V2265) (let F (shen.find V2264 V2265) (if (empty? F) (simple-error "input not found
106
+ ") F)))
107
+
108
+ (defun shen.make-key (V2266 V2267) (let Atom (hd (compile shen.<st_input> V2266 (lambda E (if (cons? E) (simple-error (cn "parse error here: " (shen.app E "
109
+ " shen.s))) (simple-error "parse error
110
+ "))))) (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V2267)))) (lambda X (shen.prefix? V2266 (shen.trim-gubbins (snd X)))))))
111
+
112
+ (defun shen.trim-gubbins (V2268) (cond ((and (cons? V2268) (= (hd V2268) (shen.space))) (shen.trim-gubbins (tl V2268))) ((and (cons? V2268) (= (hd V2268) (shen.newline))) (shen.trim-gubbins (tl V2268))) ((and (cons? V2268) (= (hd V2268) (shen.carriage-return))) (shen.trim-gubbins (tl V2268))) ((and (cons? V2268) (= (hd V2268) (shen.tab))) (shen.trim-gubbins (tl V2268))) ((and (cons? V2268) (= (hd V2268) (shen.left-round))) (shen.trim-gubbins (tl V2268))) (true V2268)))
113
+
114
+ (defun shen.space () 32)
115
+
116
+ (defun shen.tab () 9)
117
+
118
+ (defun shen.left-round () 40)
119
+
120
+ (defun shen.find (V2275 V2276) (cond ((= () V2276) ()) ((and (cons? V2276) (V2275 (hd V2276))) (cons (hd V2276) (shen.find V2275 (tl V2276)))) ((cons? V2276) (shen.find V2275 (tl V2276))) (true (shen.sys-error shen.find))))
121
+
122
+ (defun shen.prefix? (V2287 V2288) (cond ((= () V2287) true) ((and (cons? V2287) (and (cons? V2288) (= (hd V2288) (hd V2287)))) (shen.prefix? (tl V2287) (tl V2288))) (true false)))
123
+
124
+ (defun shen.print-past-inputs (V2298 V2299 V2300) (cond ((= () V2299) _) ((and (cons? V2299) (not (V2298 (hd V2299)))) (shen.print-past-inputs V2298 (tl V2299) (+ V2300 1))) ((and (cons? V2299) (tuple? (hd V2299))) (do (pr (shen.app V2300 ". " shen.a) (stoutput)) (do (shen.prbytes (snd (hd V2299))) (shen.print-past-inputs V2298 (tl V2299) (+ V2300 1))))) (true (shen.sys-error shen.print-past-inputs))))
125
+
126
+ (defun shen.toplevel_evaluate (V2301 V2302) (cond ((and (cons? V2301) (and (cons? (tl V2301)) (and (= : (hd (tl V2301))) (and (cons? (tl (tl V2301))) (and (= () (tl (tl (tl V2301)))) (= true V2302)))))) (shen.typecheck-and-evaluate (hd V2301) (hd (tl (tl V2301))))) ((and (cons? V2301) (cons? (tl V2301))) (do (shen.toplevel_evaluate (cons (hd V2301) ()) V2302) (do (nl 1) (shen.toplevel_evaluate (tl V2301) V2302)))) ((and (cons? V2301) (and (= () (tl V2301)) (= true V2302))) (shen.typecheck-and-evaluate (hd V2301) (gensym A))) ((and (cons? V2301) (and (= () (tl V2301)) (= false V2302))) (let Eval (shen.eval-without-macros (hd V2301)) (print Eval))) (true (shen.sys-error shen.toplevel_evaluate))))
127
+
128
+ (defun shen.typecheck-and-evaluate (V2303 V2304) (let Typecheck (shen.typecheck V2303 V2304) (if (= Typecheck false) (simple-error "type error
129
+ ") (let Eval (shen.eval-without-macros V2303) (let Type (shen.pretty-type Typecheck) (pr (shen.app Eval (cn " : " (shen.app Type "" shen.r)) shen.s) (stoutput)))))))
130
+
131
+ (defun shen.pretty-type (V2305) (shen.mult_subst (value shen.*alphabet*) (shen.extract-pvars V2305) V2305))
132
+
133
+ (defun shen.extract-pvars (V2310) (cond ((shen.pvar? V2310) (cons V2310 ())) ((cons? V2310) (union (shen.extract-pvars (hd V2310)) (shen.extract-pvars (tl V2310)))) (true ())))
134
+
135
+ (defun shen.mult_subst (V2315 V2316 V2317) (cond ((= () V2315) V2317) ((= () V2316) V2317) ((and (cons? V2315) (cons? V2316)) (shen.mult_subst (tl V2315) (tl V2316) (subst (hd V2315) (hd V2316) V2317))) (true (shen.sys-error shen.mult_subst))))
136
+
1
137
 
2
- " The License
3
-
4
- 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.
5
-
6
- 1. The license applies to all the software and all derived software and must appear on such.
7
- 2. It is illegal to distribute the software without this license attached to it and use of the software implies agreement
8
- with the license as such. It is illegal for anyone who is not the copyright holder to tamper with or change the license.
9
- 3. Neither the names of Lambda Associates or the copyright holder may be used to endorse or promote products built using
10
- the software without specific prior written permission from the copyright holder.
11
- 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, or profits; or business 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.
12
- 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 modified version of Shen (hereafter the modified version) 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.
13
- 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.
14
- 7. It is permitted to distribute versions of Shen which incorporate libraries, graphics or other facilities which are not part of the Shen standard.
15
-
16
- For an explication of this license see http://www.lambdassociates.org/News/june11/license.htm which explains this license in full."
17
-
18
- (defun shen-shen () (do (shen-credits) (shen-loop)))
19
-
20
- (defun shen-loop ()
21
- (do (shen-initialise_environment)
22
- (do (shen-prompt)
23
- (do
24
- (trap-error (shen-read-evaluate-print)
25
- (lambda E (pr (error-to-string E) (value *stoutput*))))
26
- (shen-loop)))))
27
-
28
- (defun version (V568) (set *version* V568))
29
-
30
- (version "version 8")
31
-
32
- (defun shen-credits ()
33
- (do (intoutput "~%Shen 2010, copyright (C) 2010 Mark Tarver~%" ())
34
- (do (intoutput "www.shenlanguage.org, ~A~%" (@p (value *version*) ()))
35
- (do
36
- (intoutput "running under ~A, implementation: ~A"
37
- (@p (value *language*) (@p (value *implementation*) ())))
38
- (intoutput "~%port ~A ported by ~A~%"
39
- (@p (value *port*) (@p (value *porters*) ())))))))
40
-
41
- (defun shen-initialise_environment ()
42
- (shen-multiple-set
43
- (cons shen-*call*
44
- (cons 0
45
- (cons shen-*infs*
46
- (cons 0
47
- (cons shen-*process-counter*
48
- (cons 0 (cons shen-*catch* (cons 0 ()))))))))))
49
-
50
- (defun shen-multiple-set (V569)
51
- (cond ((= () V569) ())
52
- ((and (cons? V569) (cons? (tl V569)))
53
- (do (set (hd V569) (hd (tl V569))) (shen-multiple-set (tl (tl V569)))))
54
- (true (shen-sys-error shen-multiple-set))))
55
-
56
- (defun destroy (V570) (declare V570 ()))
57
-
58
- (set shen-*history* ())
59
-
60
- (defun shen-read-evaluate-print ()
61
- (let Lineread (shen-toplineread)
62
- (let History (value shen-*history*)
63
- (let NewLineread (shen-retrieve-from-history-if-needed Lineread History)
64
- (let NewHistory (shen-update_history NewLineread History)
65
- (let Parsed (fst NewLineread) (shen-toplevel Parsed)))))))
66
-
67
- (defun shen-retrieve-from-history-if-needed (V580 V581)
68
- (cond
69
- ((and (tuple? V580)
70
- (and (cons? (snd V580))
71
- (and (cons? (tl (snd V580)))
72
- (and (= () (tl (tl (snd V580))))
73
- (and (cons? V581)
74
- (and (= (hd (snd V580)) (shen-exclamation))
75
- (= (hd (tl (snd V580))) (shen-exclamation))))))))
76
- (let PastPrint (shen-prbytes (snd (hd V581))) (hd V581)))
77
- ((and (tuple? V580)
78
- (and (cons? (snd V580)) (= (hd (snd V580)) (shen-exclamation))))
79
- (let Key? (shen-make-key (tl (snd V580)) V581)
80
- (let Find (head (shen-find-past-inputs Key? V581))
81
- (let PastPrint (shen-prbytes (snd Find)) Find))))
82
- ((and (tuple? V580)
83
- (and (cons? (snd V580))
84
- (and (= () (tl (snd V580))) (= (hd (snd V580)) (shen-percent)))))
85
- (do (shen-print-past-inputs (lambda X true) (reverse V581) 0) (abort)))
86
- ((and (tuple? V580)
87
- (and (cons? (snd V580)) (= (hd (snd V580)) (shen-percent))))
88
- (let Key? (shen-make-key (tl (snd V580)) V581)
89
- (let Pastprint (shen-print-past-inputs Key? (reverse V581) 0) (abort))))
90
- (true V580)))
91
-
92
- (defun shen-percent () 37)
93
-
94
- (defun shen-exclamation () 33)
95
-
96
- (defun shen-prbytes (V582)
97
- (do (map (lambda Byte (pr (n->string Byte) (stinput 0))) V582) (nl 1)))
98
-
99
- (defun shen-update_history (V583 V584) (set shen-*history* (cons V583 V584)))
100
-
101
- (defun shen-toplineread ()
102
- (shen-toplineread_loop (read-byte (stinput 0)) ()))
103
-
104
- (defun shen-toplineread_loop (V586 V587)
105
- (cond ((= V586 (shen-hat)) (interror "line read aborted" ()))
106
- ((element? V586 (cons (shen-newline) (cons (shen-carriage-return) ())))
107
- (let Line (compile (lambda V588 (shen-<st_input> V588)) V587 ())
108
- (if (or (= Line (fail)) (empty? Line))
109
- (shen-toplineread_loop (read-byte (stinput 0))
110
- (append V587 (cons V586 ())))
111
- (@p Line V587))))
112
- (true
113
- (shen-toplineread_loop (read-byte (stinput 0))
114
- (append V587 (cons V586 ()))))))
115
-
116
- (defun shen-hat () 94)
117
-
118
- (defun shen-newline () 10)
119
-
120
- (defun shen-carriage-return () 13)
121
-
122
- (defun tc (V593)
123
- (cond ((= + V593) (set shen-*tc* true))
124
- ((= - V593) (set shen-*tc* false))
125
- (true (interror "tc expects a + or -" ()))))
126
-
127
- (defun shen-prompt ()
128
- (if (value shen-*tc*)
129
- (intoutput "~%~%(~A+) " (@p (length (value shen-*history*)) ()))
130
- (intoutput "~%~%(~A-) " (@p (length (value shen-*history*)) ()))))
131
-
132
- (defun shen-toplevel (V594) (shen-toplevel_evaluate V594 (value shen-*tc*)))
133
-
134
- (defun shen-find-past-inputs (V595 V596)
135
- (let F (shen-find V595 V596)
136
- (if (empty? F) (interror "input not found~%" ()) F)))
137
-
138
- (defun shen-make-key (V597 V598)
139
- (let Atom (hd (compile (lambda V599 (shen-<st_input> V599)) V597 ()))
140
- (if (integer? Atom) (lambda X (= X (nth (+ Atom 1) (reverse V598))))
141
- (lambda X (shen-prefix? V597 (shen-trim-gubbins (snd X)))))))
142
-
143
- (defun shen-trim-gubbins (V600)
144
- (cond
145
- ((and (cons? V600) (= (hd V600) (shen-space)))
146
- (shen-trim-gubbins (tl V600)))
147
- ((and (cons? V600) (= (hd V600) (shen-newline)))
148
- (shen-trim-gubbins (tl V600)))
149
- ((and (cons? V600) (= (hd V600) (shen-carriage-return)))
150
- (shen-trim-gubbins (tl V600)))
151
- ((and (cons? V600) (= (hd V600) (shen-tab)))
152
- (shen-trim-gubbins (tl V600)))
153
- ((and (cons? V600) (= (hd V600) (shen-left-round)))
154
- (shen-trim-gubbins (tl V600)))
155
- (true V600)))
156
-
157
- (defun shen-space () 32)
158
-
159
- (defun shen-tab () 9)
160
-
161
- (defun shen-left-round () 40)
162
-
163
- (defun shen-find (V607 V608)
164
- (cond ((= () V608) ())
165
- ((and (cons? V608) (V607 (hd V608)))
166
- (cons (hd V608) (shen-find V607 (tl V608))))
167
- ((cons? V608) (shen-find V607 (tl V608))) (true (shen-sys-error shen-find))))
168
-
169
- (defun shen-prefix? (V619 V620)
170
- (cond ((= () V619) true)
171
- ((and (cons? V619) (and (cons? V620) (= (hd V620) (hd V619))))
172
- (shen-prefix? (tl V619) (tl V620)))
173
- (true false)))
174
-
175
- (defun shen-print-past-inputs (V630 V631 V632)
176
- (cond ((= () V631) _)
177
- ((and (cons? V631) (not (V630 (hd V631))))
178
- (shen-print-past-inputs V630 (tl V631) (+ V632 1)))
179
- ((and (cons? V631) (tuple? (hd V631)))
180
- (do (intoutput "~A. " (@p V632 ()))
181
- (do (shen-prbytes (snd (hd V631)))
182
- (shen-print-past-inputs V630 (tl V631) (+ V632 1)))))
183
- (true (shen-sys-error shen-print-past-inputs))))
184
-
185
- (defun shen-toplevel_evaluate (V633 V634)
186
- (cond
187
- ((and (cons? V633)
188
- (and (cons? (tl V633))
189
- (and (= : (hd (tl V633)))
190
- (and (cons? (tl (tl V633)))
191
- (and (= () (tl (tl (tl V633)))) (= true V634))))))
192
- (shen-typecheck-and-evaluate (hd V633) (hd (tl (tl V633)))))
193
- ((and (cons? V633) (cons? (tl V633)))
194
- (do (shen-toplevel_evaluate (cons (hd V633) ()) V634)
195
- (do (nl 1) (shen-toplevel_evaluate (tl V633) V634))))
196
- ((and (cons? V633) (and (= () (tl V633)) (= true V634)))
197
- (shen-typecheck-and-evaluate (hd V633) (gensym A)))
198
- ((and (cons? V633) (and (= () (tl V633)) (= false V634)))
199
- (let Eval (shen-eval-without-macros (hd V633)) (print Eval)))
200
- (true (shen-sys-error shen-toplevel_evaluate))))
201
-
202
- (defun shen-typecheck-and-evaluate (V635 V636)
203
- (let Typecheck (shen-typecheck V635 V636)
204
- (if (= Typecheck false) (interror "type error~%" ())
205
- (let Eval (shen-eval-without-macros V635)
206
- (let Type (shen-pretty-type Typecheck)
207
- (intoutput "~S : ~R" (@p Eval (@p Type ()))))))))
208
-
209
- (defun shen-pretty-type (V637)
210
- (shen-mult_subst (value shen-*alphabet*) (shen-extract-pvars V637) V637))
211
-
212
- (defun shen-extract-pvars (V642)
213
- (cond ((shen-pvar? V642) (cons V642 ()))
214
- ((cons? V642)
215
- (union (shen-extract-pvars (hd V642)) (shen-extract-pvars (tl V642))))
216
- (true ())))
217
-
218
- (defun shen-mult_subst (V647 V648 V649)
219
- (cond ((= () V647) V649) ((= () V648) V649)
220
- ((and (cons? V647) (cons? V648))
221
- (shen-mult_subst (tl V647) (tl V648) (subst (hd V647) (hd V648) V649)))
222
- (true (shen-sys-error shen-mult_subst))))
223
138
 
@@ -1,208 +1,103 @@
1
+ "**********************************************************************************
2
+ * The License *
3
+ * *
4
+ * The user is free to produce commercial applications with the software, to *
5
+ * distribute these applications in source or binary form, and to charge monies *
6
+ * for them as he sees fit and in concordance with the laws of the land subject *
7
+ * to the following license. *
8
+ * *
9
+ * 1. The license applies to all the software and all derived software and *
10
+ * must appear on such. *
11
+ * *
12
+ * 2. It is illegal to distribute the software without this license attached *
13
+ * to it and use of the software implies agreement with the license as such. *
14
+ * It is illegal for anyone who is not the copyright holder to tamper with *
15
+ * or change the license. *
16
+ * *
17
+ * 3. Neither the names of Lambda Associates or the copyright holder may be used *
18
+ * to endorse or promote products built using the software without specific *
19
+ * prior written permission from the copyright holder. *
20
+ * *
21
+ * 4. That possession of this license does not confer on the copyright holder *
22
+ * any special contractual obligation towards the user. That in no event *
23
+ * shall the copyright holder be liable for any direct, indirect, incidental, *
24
+ * special, exemplary or consequential damages (including but not limited *
25
+ * to procurement of substitute goods or services, loss of use, data, *
26
+ * interruption), however caused and on any theory of liability, whether in *
27
+ * contract, strict liability or tort (including negligence) arising in any *
28
+ * way out of the use of the software, even if advised of the possibility of *
29
+ * such damage. *
30
+ * *
31
+ * 5. It is permitted for the user to change the software, for the purpose of *
32
+ * improving performance, correcting an error, or porting to a new platform, *
33
+ * and distribute the derived version of Shen provided the resulting program *
34
+ * conforms in all respects to the Shen standard and is issued under that *
35
+ * title. The user must make it clear with his distribution that he/she is *
36
+ * the author of the changes and what these changes are and why. *
37
+ * *
38
+ * 6. Derived versions of this software in whatever form are subject to the same *
39
+ * restrictions. In particular it is not permitted to make derived copies of *
40
+ * this software which do not conform to the Shen standard or appear under a *
41
+ * different title. *
42
+ * *
43
+ * It is permitted to distribute versions of Shen which incorporate libraries, *
44
+ * graphics or other facilities which are not part of the Shen standard. *
45
+ * *
46
+ * For an explication of this license see www.shenlanguage.org/license.htm which *
47
+ * explains this license in full. *
48
+ * *
49
+ *****************************************************************************************
50
+ "(defun shen.f_error (V2026) (do (pr (cn "partial function " (shen.app V2026 ";
51
+ " shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V2026)) (y-or-n? (cn "track " (shen.app V2026 "? " shen.a)))) (shen.track-function (ps V2026)) shen.ok) (simple-error "aborted"))))
52
+
53
+ (defun shen.tracked? (V2027) (element? V2027 (value shen.*tracking*)))
54
+
55
+ (defun track (V2028) (let Source (ps V2028) (shen.track-function Source)))
56
+
57
+ (defun shen.track-function (V2029) (cond ((and (cons? V2029) (and (= defun (hd V2029)) (and (cons? (tl V2029)) (and (cons? (tl (tl V2029))) (and (cons? (tl (tl (tl V2029)))) (= () (tl (tl (tl (tl V2029)))))))))) (let KL (cons defun (cons (hd (tl V2029)) (cons (hd (tl (tl V2029))) (cons (shen.insert-tracking-code (hd (tl V2029)) (hd (tl (tl V2029))) (hd (tl (tl (tl V2029))))) ())))) (let Ob (eval KL) (let Tr (set shen.*tracking* (cons Ob (value shen.*tracking*))) Ob)))) (true (shen.sys-error shen.track-function))))
58
+
59
+ (defun shen.insert-tracking-code (V2030 V2031 V2032) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V2030 (cons (shen.cons_form V2031) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V2032 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V2030 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ()))))
60
+
61
+ (set shen.*step* false)
62
+
63
+ (defun step (V2037) (cond ((= + V2037) (set shen.*step* true)) ((= - V2037) (set shen.*step* false)) (true (simple-error "step expects a + or a -.
64
+ "))))
65
+
66
+ (defun spy (V2042) (cond ((= + V2042) (set shen.*spy* true)) ((= - V2042) (set shen.*spy* false)) (true (simple-error "spy expects a + or a -.
67
+ "))))
68
+
69
+ (defun shen.terpri-or-read-char () (if (value shen.*step*) (shen.check-byte (read-byte (value *stinput*))) (nl 1)))
70
+
71
+ (defun shen.check-byte (V2047) (cond ((= V2047 (shen.hat)) (simple-error "aborted")) (true true)))
72
+
73
+ (defun shen.input-track (V2048 V2049 V2050) (do (pr (cn "
74
+ " (shen.app (shen.spaces V2048) (cn "<" (shen.app V2048 (cn "> Inputs to " (shen.app V2049 (cn "
75
+ " (shen.app (shen.spaces V2048) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V2050)))
76
+
77
+ (defun shen.recursively-print (V2051) (cond ((= () V2051) (pr " ==>" (stoutput))) ((cons? V2051) (do (print (hd V2051)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V2051))))) (true (shen.sys-error shen.recursively-print))))
78
+
79
+ (defun shen.spaces (V2052) (cond ((= 0 V2052) "") (true (cn " " (shen.spaces (- V2052 1))))))
80
+
81
+ (defun shen.output-track (V2053 V2054 V2055) (pr (cn "
82
+ " (shen.app (shen.spaces V2053) (cn "<" (shen.app V2053 (cn "> Output from " (shen.app V2054 (cn "
83
+ " (shen.app (shen.spaces V2053) (cn "==> " (shen.app V2055 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)))
84
+
85
+ (defun untrack (V2056) (eval (ps V2056)))
86
+
87
+ (defun profile (V2057) (shen.profile-help (ps V2057)))
88
+
89
+ (defun shen.profile-help (V2062) (cond ((and (cons? V2062) (and (= defun (hd V2062)) (and (cons? (tl V2062)) (and (cons? (tl (tl V2062))) (and (cons? (tl (tl (tl V2062)))) (= () (tl (tl (tl (tl V2062)))))))))) (let G (gensym shen.f) (let Profile (cons defun (cons (hd (tl V2062)) (cons (hd (tl (tl V2062))) (cons (shen.profile-func (hd (tl V2062)) (hd (tl (tl V2062))) (cons G (hd (tl (tl V2062))))) ())))) (let Def (cons defun (cons G (cons (hd (tl (tl V2062))) (cons (subst G (hd (tl V2062)) (hd (tl (tl (tl V2062))))) ())))) (let CompileProfile (shen.eval-without-macros Profile) (let CompileG (shen.eval-without-macros Def) (hd (tl V2062)))))))) (true (simple-error "Cannot profile.
90
+ "))))
91
+
92
+ (defun unprofile (V2063) (untrack V2063))
93
+
94
+ (defun shen.profile-func (V2064 V2065 V2066) (cons let (cons Start (cons (cons get-time (cons run ())) (cons (cons let (cons Result (cons V2066 (cons (cons let (cons Finish (cons (cons - (cons (cons get-time (cons run ())) (cons Start ()))) (cons (cons let (cons Record (cons (cons shen.put-profile (cons V2064 (cons (cons + (cons (cons shen.get-profile (cons V2064 ())) (cons Finish ()))) ()))) (cons Result ())))) ())))) ())))) ())))))
95
+
96
+ (defun profile-results (V2067) (let Results (shen.get-profile V2067) (let Initialise (shen.put-profile V2067 0) (@p V2067 Results))))
97
+
98
+ (defun shen.get-profile (V2068) (trap-error (get V2068 profile (value *property-vector*)) (lambda E 0)))
99
+
100
+ (defun shen.put-profile (V2069 V2070) (put V2069 profile V2070 (value *property-vector*)))
101
+
1
102
 
2
- " The License
3
-
4
- 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.
5
-
6
- 1. The license applies to all the software and all derived software and must appear on such.
7
- 2. It is illegal to distribute the software without this license attached to it and use of the software implies agreement
8
- with the license as such. It is illegal for anyone who is not the copyright holder to tamper with or change the license.
9
- 3. Neither the names of Lambda Associates or the copyright holder may be used to endorse or promote products built using
10
- the software without specific prior written permission from the copyright holder.
11
- 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, or profits; or business 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.
12
- 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 modified version of Shen (hereafter the modified version) 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.
13
- 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.
14
- 7. It is permitted to distribute versions of Shen which incorporate libraries, graphics or other facilities which are not part of the Shen standard.
15
-
16
- For an explication of this license see http://www.lambdassociates.org/News/june11/license.htm which explains this license in full."
17
-
18
- (defun shen-f_error (V1123)
19
- (do (intoutput "partial function ~A;~%" (@p V1123 ()))
20
- (do
21
- (if
22
- (and (not (shen-tracked? V1123))
23
- (y-or-n? (intmake-string "track ~A? " (@p V1123 ()))))
24
- (shen-track-function (ps V1123)) shen-ok)
25
- (simple-error "aborted"))))
26
-
27
- (defun shen-tracked? (V1124) (element? V1124 (value shen-*tracking*)))
28
-
29
- (defun track (V1125) (let Source (ps V1125) (shen-track-function Source)))
30
-
31
- (defun shen-track-function (V1126)
32
- (cond
33
- ((and (cons? V1126)
34
- (and (= defun (hd V1126))
35
- (and (cons? (tl V1126))
36
- (and (cons? (tl (tl V1126)))
37
- (and (cons? (tl (tl (tl V1126))))
38
- (= () (tl (tl (tl (tl V1126))))))))))
39
- (let KL
40
- (cons defun
41
- (cons (hd (tl V1126))
42
- (cons (hd (tl (tl V1126)))
43
- (cons
44
- (shen-insert-tracking-code (hd (tl V1126)) (hd (tl (tl V1126)))
45
- (hd (tl (tl (tl V1126)))))
46
- ()))))
47
- (let Ob (eval KL)
48
- (let Tr (set shen-*tracking* (cons Ob (value shen-*tracking*))) Ob))))
49
- (true (shen-sys-error shen-track-function))))
50
-
51
- (defun shen-insert-tracking-code (V1127 V1128 V1129)
52
- (cons do
53
- (cons
54
- (cons set
55
- (cons shen-*call*
56
- (cons (cons + (cons (cons value (cons shen-*call* ())) (cons 1 ())))
57
- ())))
58
- (cons
59
- (cons do
60
- (cons
61
- (cons shen-input-track
62
- (cons (cons value (cons shen-*call* ()))
63
- (cons V1127 (cons (shen-cons_form V1128) ()))))
64
- (cons
65
- (cons do
66
- (cons (cons shen-terpri-or-read-char ())
67
- (cons
68
- (cons let
69
- (cons Result
70
- (cons V1129
71
- (cons
72
- (cons do
73
- (cons
74
- (cons shen-output-track
75
- (cons (cons value (cons shen-*call* ()))
76
- (cons V1127 (cons Result ()))))
77
- (cons
78
- (cons do
79
- (cons
80
- (cons set
81
- (cons shen-*call*
82
- (cons
83
- (cons -
84
- (cons (cons value (cons shen-*call* ())) (cons 1 ())))
85
- ())))
86
- (cons
87
- (cons do
88
- (cons (cons shen-terpri-or-read-char ())
89
- (cons Result ())))
90
- ())))
91
- ())))
92
- ()))))
93
- ())))
94
- ())))
95
- ()))))
96
-
97
- (set shen-*step* false)
98
-
99
- (defun step (V1134)
100
- (cond ((= + V1134) (set shen-*step* true))
101
- ((= - V1134) (set shen-*step* false))
102
- (true (interror "step expects a + or a -.~%" ()))))
103
-
104
- (defun spy (V1139)
105
- (cond ((= + V1139) (set shen-*spy* true))
106
- ((= - V1139) (set shen-*spy* false))
107
- (true (interror "spy expects a + or a -.~%" ()))))
108
-
109
- (defun shen-terpri-or-read-char ()
110
- (if (value shen-*step*) (shen-check-byte (read-byte (value *stinput*)))
111
- (nl 1)))
112
-
113
- (defun shen-check-byte (V1144)
114
- (cond ((= V1144 (shen-hat)) (interror "aborted" ())) (true true)))
115
-
116
- (defun shen-input-track (V1145 V1146 V1147)
117
- (do
118
- (intoutput "~%~A<~A> Inputs to ~A ~%~A"
119
- (@p (shen-spaces V1145)
120
- (@p V1145 (@p V1146 (@p (shen-spaces V1145) (@p V1147 ()))))))
121
- (shen-recursively-print V1147)))
122
-
123
- (defun shen-recursively-print (V1148)
124
- (cond ((= () V1148) (intoutput " ==>" ()))
125
- ((cons? V1148)
126
- (do (print (hd V1148))
127
- (do (intoutput ", " ()) (shen-recursively-print (tl V1148)))))
128
- (true (shen-sys-error shen-recursively-print))))
129
-
130
- (defun shen-spaces (V1149)
131
- (cond ((= 0 V1149) "") (true (cn " " (shen-spaces (- V1149 1))))))
132
-
133
- (defun shen-output-track (V1150 V1151 V1152)
134
- (intoutput "~%~A<~A> Output from ~A ~%~A==> ~S"
135
- (@p (shen-spaces V1150)
136
- (@p V1150 (@p V1151 (@p (shen-spaces V1150) (@p V1152 ())))))))
137
-
138
- (defun untrack (V1153) (eval (ps V1153)))
139
-
140
- (defun profile (V1154) (shen-profile-help (ps V1154)))
141
-
142
- (defun shen-profile-help (V1159)
143
- (cond
144
- ((and (cons? V1159)
145
- (and (= defun (hd V1159))
146
- (and (cons? (tl V1159))
147
- (and (cons? (tl (tl V1159)))
148
- (and (cons? (tl (tl (tl V1159))))
149
- (= () (tl (tl (tl (tl V1159))))))))))
150
- (let G (gensym shen-f)
151
- (let Profile
152
- (cons defun
153
- (cons (hd (tl V1159))
154
- (cons (hd (tl (tl V1159)))
155
- (cons
156
- (shen-profile-func (hd (tl V1159)) (hd (tl (tl V1159)))
157
- (cons G (hd (tl (tl V1159)))))
158
- ()))))
159
- (let Def
160
- (cons defun
161
- (cons G
162
- (cons (hd (tl (tl V1159)))
163
- (cons (subst G (hd (tl V1159)) (hd (tl (tl (tl V1159))))) ()))))
164
- (let CompileProfile (shen-eval-without-macros Profile)
165
- (let CompileG (shen-eval-without-macros Def) (hd (tl V1159))))))))
166
- (true (interror "Cannot profile.~%" ()))))
167
-
168
- (defun unprofile (V1160) (untrack V1160))
169
-
170
- (defun shen-profile-func (V1161 V1162 V1163)
171
- (cons let
172
- (cons Start
173
- (cons (cons get-time (cons run ()))
174
- (cons
175
- (cons let
176
- (cons Result
177
- (cons V1163
178
- (cons
179
- (cons let
180
- (cons Finish
181
- (cons
182
- (cons - (cons (cons get-time (cons run ())) (cons Start ())))
183
- (cons
184
- (cons let
185
- (cons Record
186
- (cons
187
- (cons shen-put-profile
188
- (cons V1161
189
- (cons
190
- (cons +
191
- (cons (cons shen-get-profile (cons V1161 ()))
192
- (cons Finish ())))
193
- ())))
194
- (cons Result ()))))
195
- ()))))
196
- ()))))
197
- ())))))
198
-
199
- (defun profile-results (V1164)
200
- (let Results (shen-get-profile V1164)
201
- (let Initialise (shen-put-profile V1164 0) (@p V1164 Results))))
202
-
203
- (defun shen-get-profile (V1165)
204
- (trap-error (get V1165 profile (value shen-*property-vector*)) (lambda E 0)))
205
-
206
- (defun shen-put-profile (V1166 V1167)
207
- (put V1166 profile V1167 (value shen-*property-vector*)))
208
103