From de0e57d3ced985040cf31919a23d79fd7276f1f9 Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Sat, 25 Jul 2020 15:35:43 -0700 Subject: 6674 --- stats.txt | 7 ++++--- tools/treeshake_all | 10 +++++----- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/stats.txt b/stats.txt index 26ddf9ea..cb0d4b78 100644 --- a/stats.txt +++ b/stats.txt @@ -12,7 +12,7 @@ apps/tests.subx 284 137 apps/sigils.subx 4641 896 apps/calls.subx 1785 448 apps/braces.subx 360 121 -apps/mu.subx (incomplete) 18722 6044 +apps/mu.subx (incomplete) 22067 7153 ## Total source lines needed including libraries Initial -whitespace/comments/tests/dead code @@ -28,7 +28,7 @@ apps/tests.subx 8519 2214 apps/sigils.subx 10578 3043 apps/calls.subx 9242 2388 apps/braces.subx 8545 2111 -apps/mu.subx (incomplete) 22481 8537 +apps/mu.subx (incomplete) 25565 9867 ## executable size in KB Initial -tests/dead code @@ -44,7 +44,7 @@ apps/tests 41 5.8 apps/sigils 54 9.1 apps/calls 47 7.1 apps/braces 42 5.9 -apps/mu (incomplete) 316 49.0 +apps/mu (incomplete) 354 61.0 ## history of apps/mu.subx date commit mu.subx -tests/cmts binary (KB excl. dead code) @@ -66,5 +66,6 @@ user-defined types, and getting fields in them Mar 11 6135 11592 cleanup: switch to handles everywhere May 22 6382 15014 5064 39 first round of prototyping and static checks Jun 21 6572 18722 6044 49 +more checks Jul 25 6674 22067 7153 61 vim:nowrap:tw& diff --git a/tools/treeshake_all b/tools/treeshake_all index bdf14c90..b05de395 100755 --- a/tools/treeshake_all +++ b/tools/treeshake_all @@ -13,7 +13,7 @@ export OS=${OS:-linux} process() { app=$1 - tools/treeshake_translate init.$OS 0*.subx apps/subx-params.subx apps/$app.subx + tools/treeshake_translate init.$OS [012]*.subx apps/subx-params.subx apps/$app.subx echo "LoC $(cat apps/$app.subx |wc -l) => $(grep -vh '^\s*$\|^\s*#' apps/$app.subx |tools/treeshake |wc -l)" echo "LoC including common libraries: $(cat a.in |wc -l) => $(cat a.treeshake |wc -l)" echo "binary size: $(ls -lh apps/$app |column 5) => $(ls -lh a.elf |column 5)" @@ -26,7 +26,7 @@ then fi echo "== deleting dead code" -for app in factorial crenshaw2-1 crenshaw2-1b handle hex survey pack dquotes assort tests sigils calls braces +for app in factorial crenshaw2-1 crenshaw2-1b hex survey pack dquotes assort tests sigils calls braces do echo "- $app" process $app @@ -39,21 +39,21 @@ echo "== testing treeshaken binaries" for app in factorial crenshaw2-1 crenshaw2-1b do echo $app - tools/test_treeshake_translate init.$OS 0[0-8]*.subx apps/$app.subx + tools/test_treeshake_translate init.$OS [01]*.subx apps/$app.subx diff apps/$app a.elf done for app in hex survey pack assort dquotes tests do echo $app - tools/test_treeshake_translate init.$OS 0[0-8]*.subx apps/subx-params.subx apps/$app.subx + tools/test_treeshake_translate init.$OS [01]*.subx apps/subx-params.subx apps/$app.subx diff apps/$app a.elf done for app in sigils calls braces do echo $app - tools/test_treeshake_translate init.$OS 0*.subx apps/subx-params.subx apps/$app.subx + tools/test_treeshake_translate init.$OS [012]*.subx apps/subx-params.subx apps/$app.subx diff apps/$app a.elf done -- cgit 1.4.1-2-gfad0 id='n9' href='#n9'>9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 
;;; Logic problem inference system

;; Establish categories

to category :category.name :members
print (list "category :category.name :members)
if not namep "categories [make "categories []]
make "categories lput :category.name :categories
make :category.name :members
foreach :members [pprop ? "category :category.name]
end

;; Verify and falsify matches

to verify :a :b
settruth :a :b "true
end

to falsify :a :b
settruth :a :b "false
end

to settruth :a :b :truth.value
if equalp (gprop :a "category) (gprop :b "category) [stop]
localmake "oldvalue get :a :b
if equalp :oldvalue :truth.value [stop]
if equalp :oldvalue (not :truth.value) ~
   [(throw "error (sentence [inconsistency in settruth]
                            :a :b :truth.value))]
print (list :a :b "-> :truth.value)
store :a :b :truth.value
settruth1 :a :b :truth.value
settruth1 :b :a :truth.value
if not emptyp :oldvalue ~
   [foreach (filter [equalp first ? :truth.value] :oldvalue)
            [apply "settruth butfirst ?]]
end

to settruth1 :a :b :truth.value
apply (word "find not :truth.value) (list :a :b)
foreach (gprop :a "true) [settruth ? :b :truth.value]
if :truth.value [foreach (gprop :a "false) [falsify ? :b]
                 pprop :a (gprop :b "category) :b]
pprop :a :truth.value (fput :b gprop :a :truth.value)
end

to findfalse :a :b
foreach (filter [not equalp get ? :b "true] peers :a) ~
        [falsify ? :b]
end

to findtrue :a :b
if equalp (count peers :a) (1+falses :a :b) ~
   [verify (find [not equalp get ? :b "false] peers :a)
           :b]
end

to falses :a :b
output count filter [equalp "false get ? :b] peers :a
end

to peers :a
output thing gprop :a "category
end

;; Common types of clues

to differ :list
print (list "differ :list)
foreach :list [differ1 ? ?rest]
end

to differ1 :a :them
foreach :them [falsify :a ?]
end

to justbefore :this :that :lineup
falsify :this :that
falsify :this last :lineup
falsify :that first :lineup
justbefore1 :this :that :lineup
end

to justbefore1 :this :that :slotlist
if emptyp butfirst :slotlist [stop]
equiv :this (first :slotlist) :that (first butfirst :slotlist)
justbefore1 :this :that (butfirst :slotlist)
end

;; Remember conditional linkages

to implies :who1 :what1 :truth1 :who2 :what2 :truth2
implies1 :who1 :what1 :truth1 :who2 :what2 :truth2
implies1 :who2 :what2 (not :truth2) :who1 :what1 (not :truth1)
end

to implies1 :who1 :what1 :truth1 :who2 :what2 :truth2
localmake "old1 get :who1 :what1
if equalp :old1 :truth1 [settruth :who2 :what2 :truth2  stop]
if equalp :old1 (not :truth1) [stop]
if memberp (list :truth1 :who2 :what2 (not :truth2)) :old1 ~
   [settruth :who1 :what1 (not :truth1)  stop]
if memberp (list :truth1 :what2 :who2 (not :truth2)) :old1 ~
   [settruth :who1 :what1 (not :truth1)  stop]
store :who1 :what1 ~
      fput (list :truth1 :who2 :what2 :truth2) :old1
end

to equiv :who1 :what1 :who2 :what2
implies :who1 :what1 "true :who2 :what2 "true
implies :who2 :what2 "true :who1 :what1 "true
end

to xor :who1 :what1 :who2 :what2
implies :who1 :what1 "true :who2 :what2 "false
implies :who1 :what1 "false :who2 :what2 "true
end

;; Interface to property list mechanism

to get :a :b
output gprop :a :b
end

to store :a :b :val
pprop :a :b :val
pprop :b :a :val
end

;; Print the solution

to solution
foreach thing first :categories [solve1 ? butfirst :categories]
end

to solve1 :who :order
type :who
foreach :order [type "| |   type gprop :who ?]
print []
end

;; Get rid of old problem data

to cleanup
if not namep "categories [stop]
ern :categories
ern "categories
erpls
end

;; Anita Harnadek's problem

to cub.reporter
cleanup
category "first [Jane Larry Opal Perry]
category "last [Irving King Mendle Nathan]
category "age [32 38 45 55]
category "job [drafter pilot sergeant driver]
differ [Jane King Larry Nathan]
says "Jane "Irving 45
says "King "Perry "driver
says "Larry "sergeant 45
says "Nathan "drafter 38
differ [Mendle Jane Opal Nathan]
says "Mendle "pilot "Larry
says "Jane "pilot 45
says "Opal 55 "driver
says "Nathan 38 "driver
print []
solution
end

to says :who :what1 :what2
print (list "says :who :what1 :what2)
xor :who :what1 :who :what2
end

;; Diane Baldwin's problem

to foote.family
cleanup
category "when [1st 2nd 3rd 4th 5th]
category "name [Felix Fred Frank Francine Flo]
category "street [Field Flag Fig Fork Frond]
category "item [food film flashlight fan fiddle]
category "position [1 2 3 4 5]
print [Clue 1]
justbefore "Flag "2nd :position
justbefore "2nd "Fred :position
print [Clue 2]
male [film Fig 5th]
print [Clue 3]
justbefore "flashlight "Fork :position
justbefore "Fork "1st :position
female [1st]
print [Clue 4]
falsify "5th "Frond
falsify "5th "fan
print [Clue 5]
justbefore "Francine "Frank :position
justbefore "Francine "Frank :when
print [Clue 6]
female [3rd Flag]
print [Clue 7]
justbefore "fiddle "Frond :when
justbefore "Flo "fiddle :when
print []
solution
end

to male :stuff
differ sentence :stuff [Francine Flo]
end

to female :stuff
differ sentence :stuff [Felix Fred Frank]
end

;;; Combinatorics toolkit

to combs :list :howmany
if equalp :howmany 0 [output [[]]]
if equalp :howmany count :list [output (list :list)]
output sentence (map [fput first :list ?]
                     combs (butfirst :list) (:howmany-1)) ~
      (combs (butfirst :list) :howmany)
end

to fact :n
output cascade :n [# * ?] 1
end

to perms :n :r
if equalp :r 0 [output 1]
output :n * perms :n-1 :r-1
end

to choose :n :r
output (perms :n :r)/(fact :r)
end

;; The socks problem

to socks :list
localmake "total combs (expand :list) 2
localmake "matching filter [equalp first ? last ?] :total
print (sentence [there are] count :total [possible pairs of socks.])
print (sentence [of these,] count :matching [are matching pairs.])
print sentence [probability of match =] ~
      word (100 * (count :matching)/(count :total)) "%
end

to expand :list
if emptyp :list [output []]
if numberp first :list ~
   [output cascade (first :list)
                   [fput first butfirst :list ?]
                   (expand butfirst butfirst :list)]
output fput first :list expand butfirst :list
end

to socktest
localmake "first pick [brown brown brown brown brown brown 
                       blue blue blue blue]
localmake "second ~
          pick (ifelse equalp :first "brown ~
                       [[brown brown brown brown brown
                         blue blue blue blue]] ~
                       [[brown brown brown brown brown brown
                         blue blue blue]])
output equalp :first :second
end

;; The Simplex lock problem

to lock :buttons
output cascade :buttons [? + lock1 :buttons #] 1
end

to lock1 :total :buttons
localmake "perms perms :total :buttons
output cascade (twoto (:buttons-1)) [? + lock2 :perms #-1 1] 0
end

to lock2 :perms :links :factor
if equalp :links 0 [output :perms/(fact :factor)]
if equalp (remainder :links 2) 0 ~
   [output lock2 :perms/(fact :factor) :links/2 1]
output lock2 :perms (:links-1)/2 :factor+1
end

to twoto :power
output cascade :power [2 * ?] 1
end

to simplex :buttons
output 2 * f :buttons
end

to f :n
if equalp :n 0 [output 1]
output cascade :n [? + ((choose :n (#-1)) * f (#-1))] 0
end

to simp :n
output round (fact :n)/(power (ln 2) (:n+1))
end

;; The multinomial expansion problem

to t :n :k
if equalp :k 0 [output 1]
if equalp :n 0 [output 0]
output (t :n :k-1)+(t :n-1 :k)
end