Ran cloverage. There is one test failure, which makes me unwilling
to release this.
This commit is contained in:
parent
ffc6377f91
commit
e97ace97c5
File diff suppressed because it is too large
Load diff
|
@ -659,7 +659,7 @@
|
|||
218 :args (list cell value)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
219 :type :beowulf}))));; PLUS
|
||||
219 :type :beowulf}))))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
220
|
||||
|
@ -1352,424 +1352,478 @@
|
|||
449
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
450 (defn PUT
|
||||
450 (defn ATTRIB
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
451 "Put this `value` as the value of the property indicated by this `indicator`
|
||||
451 "Destructive append. From page 59 of the manual:
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
452 of this `symbol`. Return `value` on success.
|
||||
452
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
453
|
||||
453 The function `attrib` concatenates its two arguments by changing the last
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
454 NOTE THAT there is no `PUT` defined in the manual, but it would have been
|
||||
454 element of its first argument to point to the second argument. Thus it
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
455 easy to have defined it so I don't think this fully counts as an extension."
|
||||
455 is commonly used to tack something onto the end of a property list.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
456 [symbol indicator value]
|
||||
456 The value of `attrib` is the second argument.
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
457
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
458 For example
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
459 ```
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
460 attrib[FF; (EXPR (LAMBDA (X) (COND ((ATOM X) X) (T (FF (CAR x))))))]
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
461 ```
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
462 would put EXPR followed by the LAMBDA expression for FF onto the end of
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
463 the property list for FF."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
464 [x e]
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
465 (loop [l x]
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
466 (cond
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
457 (let [binding (ASSOC symbol @oblist)]
|
||||
</span><br/>
|
||||
<span class="covered" title="5 out of 5 forms covered">
|
||||
458 (if (instance? ConsCell binding)
|
||||
467 (instance? ConsCell (CDR l)) (recur (CDR l))
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
459 (let [prop (hit-or-miss-assoc indicator (CDDR binding))]
|
||||
468 :else (when (RPLACD l e) e))))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
469
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
470 (defn PUT
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
471 "Put this `value` as the value of the property indicated by this `indicator`
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
472 of this `symbol`. Return `value` on success.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
473
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
474 NOTE THAT there is no `PUT` defined in the manual, but it would have been
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
475 easy to have defined it so I don't think this fully counts as an extension."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
476 [symbol indicator value]
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
477 (let [binding (ASSOC symbol @oblist)]
|
||||
</span><br/>
|
||||
<span class="covered" title="5 out of 5 forms covered">
|
||||
460 (if (instance? ConsCell prop)
|
||||
478 (if (instance? ConsCell binding)
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
479 (let [prop (hit-or-miss-assoc indicator (CDDR binding))]
|
||||
</span><br/>
|
||||
<span class="covered" title="5 out of 5 forms covered">
|
||||
480 (if (instance? ConsCell prop)
|
||||
</span><br/>
|
||||
<span class="covered" title="6 out of 6 forms covered">
|
||||
461 (RPLACA (CDR prop) value)
|
||||
481 (RPLACA (CDR prop) value)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
482 ;; The implication is ATTRIB was used here, but I have not made that
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
483 ;; work and this does work, so if it ain't broke don't fix it.
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
462 (RPLACD binding
|
||||
484 (RPLACD binding
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
463 (make-cons-cell
|
||||
485 (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
464 magic-marker
|
||||
486 magic-marker
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
465 (make-cons-cell
|
||||
487 (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
466 indicator
|
||||
488 indicator
|
||||
</span><br/>
|
||||
<span class="covered" title="6 out of 6 forms covered">
|
||||
467 (make-cons-cell value (CDDR binding)))))))
|
||||
489 (make-cons-cell value (CDDR binding)))))))
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
468 (swap!
|
||||
490 (swap!
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
469 oblist
|
||||
491 oblist
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
470 (fn [ob s p v]
|
||||
492 (fn [ob s p v]
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
471 (make-cons-cell
|
||||
493 (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="8 out of 8 forms covered">
|
||||
472 (make-beowulf-list (list s magic-marker p v))
|
||||
494 (make-beowulf-list (list s magic-marker p v))
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
473 ob))
|
||||
495 ob))
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
474 symbol indicator value)))
|
||||
496 symbol indicator value)))
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
475 value)
|
||||
497 value)
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
476
|
||||
498
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
477 (defn GET
|
||||
499 (defn GET
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
478 "From the manual:
|
||||
500 "From the manual:
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
479
|
||||
501
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
480 '`get` is somewhat like `prop`; however its value is car of the rest of
|
||||
502 '`get` is somewhat like `prop`; however its value is car of the rest of
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
481 the list if the `indicator` is found, and NIL otherwise.'
|
||||
503 the list if the `indicator` is found, and NIL otherwise.'
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
482
|
||||
504
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
483 It's clear that `GET` is expected to be defined in terms of `PROP`, but
|
||||
505 It's clear that `GET` is expected to be defined in terms of `PROP`, but
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
484 we can't implement `PROP` here because we lack `EVAL`; and we can't have
|
||||
506 we can't implement `PROP` here because we lack `EVAL`; and we can't have
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
485 `EVAL` here because both it and `APPLY` depends on `GET`.
|
||||
507 `EVAL` here because both it and `APPLY` depends on `GET`.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
486
|
||||
508
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
487 OK, It's worse than that: the statement of the definition of `GET` (and
|
||||
509 OK, It's worse than that: the statement of the definition of `GET` (and
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
488 of) `PROP` on page 59 says that the first argument to each must be a list;
|
||||
510 of) `PROP` on page 59 says that the first argument to each must be a list;
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
489 But the in the definition of `ASSOC` on page 70, when `GET` is called its
|
||||
511 But the in the definition of `ASSOC` on page 70, when `GET` is called its
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
490 first argument is always an atom. Since it's `ASSOC` and `EVAL` which I
|
||||
512 first argument is always an atom. Since it's `ASSOC` and `EVAL` which I
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
491 need to make work, I'm going to assume that page 59 is wrong."
|
||||
513 need to make work, I'm going to assume that page 59 is wrong."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
492 [symbol indicator]
|
||||
514 [symbol indicator]
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
493 (let [binding (ASSOC symbol @oblist)
|
||||
515 (let [binding (ASSOC symbol @oblist)
|
||||
</span><br/>
|
||||
<span class="partial" title="2 out of 3 forms covered">
|
||||
494 val (cond
|
||||
516 val (cond
|
||||
</span><br/>
|
||||
<span class="covered" title="4 out of 4 forms covered">
|
||||
495 (= binding NIL) NIL
|
||||
517 (= binding NIL) NIL
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
496 (= magic-marker
|
||||
518 (= magic-marker
|
||||
</span><br/>
|
||||
<span class="covered" title="5 out of 5 forms covered">
|
||||
497 (CADR binding)) (loop [b binding]
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
498 ;; (println "GET loop, seeking " indicator ":")
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
499 ;; (pretty-print b)
|
||||
</span><br/>
|
||||
<span class="covered" title="5 out of 5 forms covered">
|
||||
500 (if (instance? ConsCell b)
|
||||
<span class="covered" title="8 out of 8 forms covered">
|
||||
519 (CADR binding)) (let [p (hit-or-miss-assoc indicator binding)]
|
||||
</span><br/>
|
||||
<span class="covered" title="6 out of 6 forms covered">
|
||||
501 (if (= (CAR b) indicator)
|
||||
520 (if-not (= NIL p)
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
502 (CADR b) ;; <- this is what we should actually be returning
|
||||
521 (CADR p)
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
503 (recur (CDR b)))
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
504 NIL))
|
||||
522 NIL))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
505 :else (throw
|
||||
523 :else (throw
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
506 (ex-info "Misformatted property list (missing magic marker)"
|
||||
524 (ex-info "Misformatted property list (missing magic marker)"
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 8 forms covered">
|
||||
507 {:phase :host
|
||||
525 {:phase :host
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
508 :function :get
|
||||
526 :function :get
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
509 :args (list symbol indicator)
|
||||
527 :args (list symbol indicator)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
510 :type :beowulf})))]
|
||||
528 :type :beowulf})))]
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
511 ;; (println "<< GET returning: " val)
|
||||
529 ;; (println "<< GET returning: " val)
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
512 val))
|
||||
530 val))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
513
|
||||
531
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
514 (defn DEFLIST
|
||||
532 (defn DEFLIST
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
515 "For each pair in this association list `a-list`, set the property with this
|
||||
533 "For each pair in this association list `a-list`, set the property with this
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
516 `indicator` of the symbol which is the first element of the pair to the
|
||||
534 `indicator` of the symbol which is the first element of the pair to the
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
517 value which is the second element of the pair. See page 58 of the manual."
|
||||
535 value which is the second element of the pair. See page 58 of the manual."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
518 [a-list indicator]
|
||||
536 [a-list indicator]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 2 forms covered">
|
||||
519 (doall
|
||||
537 (doall
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
520 (map
|
||||
538 (map
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 14 forms covered">
|
||||
521 #(when (PUT (CAR %) indicator (CDR %)) (CAR %))
|
||||
539 #(when (PUT (CAR %) indicator (CDR %)) (CAR %))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
522 a-list)))
|
||||
540 a-list)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
523
|
||||
541
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
524 (defn DEFINE
|
||||
542 (defn DEFINE
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
525 "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten
|
||||
543 "Bootstrap-only version of `DEFINE` which, post boostrap, can be overwritten
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
526 in LISP.
|
||||
544 in LISP.
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
527
|
||||
545
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
528 The single argument to `DEFINE` should be an association list of symbols to
|
||||
546 The single argument to `DEFINE` should be an association list of symbols to
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
529 lambda functions. See page 58 of the manual."
|
||||
547 lambda functions. See page 58 of the manual."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
530 [a-list]
|
||||
548 [a-list]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
531 (DEFLIST a-list 'EXPR))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
532
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
533 (defn SET
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
534 "Implementation of SET in Clojure. Add to the `oblist` a binding of the
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
535 value of `var` to the value of `val`. NOTE WELL: this is not SETQ!"
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
536 [symbol val]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 5 forms covered">
|
||||
537 (PUT symbol 'APVAL val))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
538
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
539 ;;;; TRACE and friends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
540
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
541 (def traced-symbols
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
542 "Symbols currently being traced."
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
543 (atom #{}))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
544
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
545 (defn traced?
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
546 "Return `true` iff `s` is a symbol currently being traced, else `nil`."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
547 [s]
|
||||
</span><br/>
|
||||
<span class="partial" title="7 out of 8 forms covered">
|
||||
548 (try (contains? @traced-symbols s)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
549 (catch Throwable _ nil)))
|
||||
549 (DEFLIST a-list 'EXPR))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
550
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
551 (defn TRACE
|
||||
551 (defn SET
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
552 "Add this `s` to the set of symbols currently being traced. If `s`
|
||||
552 "Implementation of SET in Clojure. Add to the `oblist` a binding of the
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
553 is not a symbol or sequence of symbols, does nothing."
|
||||
553 value of `var` to the value of `val`. NOTE WELL: this is not SETQ!"
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
554 [s]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
555 (swap! traced-symbols
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
556 #(cond
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 7 forms covered">
|
||||
557 (symbol? s) (conj % s)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 17 forms covered">
|
||||
558 (and (seq? s) (every? symbol? s)) (union % (set s))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
559 :else %)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
560
|
||||
</span><br/>
|
||||
<span class="partial" title="1 out of 3 forms covered">
|
||||
561 (defn UNTRACE
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
562 "Remove this `s` from the set of symbols currently being traced. If `s`
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
563 is not a symbol or sequence of symbols, does nothing."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
564 [s]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
565 (cond
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 16 forms covered">
|
||||
566 (symbol? s) (swap! traced-symbols #(set (remove (fn [x] (= s x)) %)))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 15 forms covered">
|
||||
567 (and (seq? s) (every? symbol? s)) (map UNTRACE s))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
568 @traced-symbols)
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
569
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
570 ;;;; Extensions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
571
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
572 (defn DOC
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
573 "Open the page for this `symbol` in the Lisp 1.5 manual, if known, in the
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
574 default web browser.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
575
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
576 **NOTE THAT** this is an extension function, not available in strct mode."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
577 [symbol]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 5 forms covered">
|
||||
578 (when (lax? 'DOC)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
579 (open-doc symbol)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
580
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
581 (defn CONSP
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
582 "Return `T` if object `o` is a cons cell, else `F`.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
583
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
584 **NOTE THAT** this is an extension function, not available in strct mode.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
585 I believe that Lisp 1.5 did not have any mechanism for testing whether an
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
586 argument was, or was not, a cons cell."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
587 [o]
|
||||
554 [symbol val]
|
||||
</span><br/>
|
||||
<span class="covered" title="5 out of 5 forms covered">
|
||||
588 (when (lax? 'CONSP)
|
||||
555 (PUT symbol 'APVAL val))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
556
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
557 ;;;; TRACE and friends ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
558
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
559 (def traced-symbols
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
560 "Symbols currently being traced."
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
561 (atom #{}))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
562
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
563 (defn traced?
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
564 "Return `true` iff `s` is a symbol currently being traced, else `nil`."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
565 [s]
|
||||
</span><br/>
|
||||
<span class="partial" title="7 out of 8 forms covered">
|
||||
566 (try (contains? @traced-symbols s)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
567 (catch Throwable _ nil)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
568
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
569 (defn TRACE
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
570 "Add this `s` to the set of symbols currently being traced. If `s`
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
571 is not a symbol or sequence of symbols, does nothing."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
572 [s]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
573 (swap! traced-symbols
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
574 #(cond
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 7 forms covered">
|
||||
575 (symbol? s) (conj % s)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 17 forms covered">
|
||||
576 (and (seq? s) (every? symbol? s)) (union % (set s))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
577 :else %)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
578
|
||||
</span><br/>
|
||||
<span class="partial" title="1 out of 3 forms covered">
|
||||
579 (defn UNTRACE
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
580 "Remove this `s` from the set of symbols currently being traced. If `s`
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
581 is not a symbol or sequence of symbols, does nothing."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
582 [s]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
583 (cond
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 16 forms covered">
|
||||
584 (symbol? s) (swap! traced-symbols #(set (remove (fn [x] (= s x)) %)))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 15 forms covered">
|
||||
585 (and (seq? s) (every? symbol? s)) (map UNTRACE s))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
586 @traced-symbols)
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
587
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
588 ;;;; Extensions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
589
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
590 (defn DOC
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
591 "Open the page for this `symbol` in the Lisp 1.5 manual, if known, in the
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
592 default web browser.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
593
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
594 **NOTE THAT** this is an extension function, not available in strct mode."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
595 [symbol]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 5 forms covered">
|
||||
596 (when (lax? 'DOC)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
597 (open-doc symbol)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
598
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
599 (defn CONSP
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
600 "Return `T` if object `o` is a cons cell, else `F`.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
601
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
602 **NOTE THAT** this is an extension function, not available in strct mode.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
603 I believe that Lisp 1.5 did not have any mechanism for testing whether an
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
604 argument was, or was not, a cons cell."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
605 [o]
|
||||
</span><br/>
|
||||
<span class="covered" title="5 out of 5 forms covered">
|
||||
606 (when (lax? 'CONSP)
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
589 (if (instance? ConsCell o) 'T 'F)))
|
||||
607 (if (instance? ConsCell o) 'T 'F)))
|
||||
</span><br/>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
@ -283,239 +283,248 @@
|
|||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
093 ([filepath]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 7 forms covered">
|
||||
094 (spit (full-path (str filepath))
|
||||
<span class="not-covered" title="0 out of 6 forms covered">
|
||||
094 (let [destination (full-path (str filepath))]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
095 (spit destination
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 15 forms covered">
|
||||
095 (with-out-str
|
||||
096 (with-out-str
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 9 forms covered">
|
||||
096 (println (apply str (repeat 79 ";")))
|
||||
097 (println (apply str (repeat 79 ";")))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 5 forms covered">
|
||||
097 (println (format ";; Beowulf %s Sysout file generated at %s"
|
||||
098 (println (format ";; Beowulf %s Sysout file generated at %s"
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 7 forms covered">
|
||||
098 (or (System/getProperty "beowulf.version") "")
|
||||
099 (or (System/getProperty "beowulf.version") "")
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 2 forms covered">
|
||||
099 (local-date-time)))
|
||||
100 (local-date-time)))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
100 (when (System/getenv "USER")
|
||||
101 (when (System/getenv "USER")
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 7 forms covered">
|
||||
101 (println (format ";; generated by %s" (System/getenv "USER"))))
|
||||
102 (println (format ";; generated by %s" (System/getenv "USER"))))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 9 forms covered">
|
||||
102 (println (apply str (repeat 79 ";")))
|
||||
103 (println (apply str (repeat 79 ";")))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 2 forms covered">
|
||||
103 (println)
|
||||
104 (println)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 6 forms covered">
|
||||
104 (let [output (safely-wrap-subrs @oblist)]
|
||||
105 (let [output (safely-wrap-subrs @oblist)]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
105 (pretty-print output)
|
||||
106 (pretty-print output)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
106 )))))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
107
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
108 (defn resolve-subr
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
109 "If this oblist `entry` references a subroutine, attempt to fix up that
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
110 reference."
|
||||
</span><br/>
|
||||
<span class="partial" title="1 out of 3 forms covered">
|
||||
111 ([entry]
|
||||
</span><br/>
|
||||
<span class="partial" title="9 out of 12 forms covered">
|
||||
112 (or (resolve-subr entry 'SUBR)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
113 (resolve-subr entry 'FSUBR)))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
114 ([entry prop]
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
115 (cond (= entry NIL) NIL
|
||||
</span><br/>
|
||||
<span class="covered" title="6 out of 6 forms covered">
|
||||
116 (= (CAR entry) prop) (try
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
117 (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
118 (CAR entry)
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
119 (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
120 (interpret-qualified-name
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
121 (CADR entry))
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
122 (CDDR entry)))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
123 (catch Exception _
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
124 (print "Warnung: ne can āfinde "
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
125 (CADR entry))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
126 (CDDR entry)))
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
127 :else (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="8 out of 8 forms covered">
|
||||
128 (CAR entry) (resolve-subr (CDR entry))))))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
129
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
130
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
131 (defn- resolve-subroutines
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
132 "Attempt to fix up the references to subroutines (Clojure functions) among
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
133 these `objects`, being new content for the object list."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
134 [objects]
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
135 (make-beowulf-list
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
136 (map
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
137 resolve-subr
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
138 objects)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
139
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
140 (defn SYSIN
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
141 "Read the contents of the file at this `filename` into the object list.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
142
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
143 If the file is not a valid Beowulf sysout file, this will probably
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
144 corrupt the system, you have been warned. File paths will be considered
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
145 relative to the filepath set when starting Lisp.
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
146
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
147 It is intended that sysout files can be read both from resources within
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
148 the jar file, and from the file system. If a named file exists in both the
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
149 file system and the resources, the file system will be preferred.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
150
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
151 **NOTE THAT** if the provided `filename` does not end with `.lsp` (which,
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
152 if you're writing it from the Lisp REPL, it won't), the extension `.lsp`
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
153 will be appended.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
154
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
155 **NOTE THAT** this is an extension function, not available in strct mode."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
156 ([]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 13 forms covered">
|
||||
157 (SYSIN (or (:read *options*) (str "resources/" default-sysout))))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
158 ([filename]
|
||||
</span><br/>
|
||||
<span class="covered" title="8 out of 8 forms covered">
|
||||
159 (let [fp (file (full-path (str filename)))
|
||||
</span><br/>
|
||||
<span class="covered" title="9 out of 9 forms covered">
|
||||
160 file (when (and (.exists fp) (.canRead fp)) fp)
|
||||
</span><br/>
|
||||
<span class="partial" title="4 out of 5 forms covered">
|
||||
161 res (try (resource filename)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
162 (catch Throwable _ nil))
|
||||
</span><br/>
|
||||
<span class="covered" title="11 out of 11 forms covered">
|
||||
163 content (try (READ (slurp (or file res)))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
164 (catch Throwable _
|
||||
107 )))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
165 (throw (ex-info "Ne can ārǣde"
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 5 forms covered">
|
||||
166 {:context "SYSIN"
|
||||
108 (println "Saved sysout to " destination)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
167 :filename filename
|
||||
109 NIL)))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
168 :filepath fp}))))]
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
110
|
||||
</span><br/>
|
||||
<span class="covered" title="4 out of 4 forms covered">
|
||||
169 (swap! oblist
|
||||
<span class="partial" title="2 out of 4 forms covered">
|
||||
111 (defn resolve-subr
|
||||
</span><br/>
|
||||
<span class="partial" title="7 out of 10 forms covered">
|
||||
170 #(when (or % (seq content))
|
||||
<span class="partial" title="1 out of 3 forms covered">
|
||||
112 "If this oblist `entry` references a subroutine, attempt to fix up that
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
113 reference."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
114 ([entry]
|
||||
</span><br/>
|
||||
<span class="partial" title="8 out of 9 forms covered">
|
||||
115 (or (resolve-subr entry 'SUBR)
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
116 (resolve-subr entry 'FSUBR)))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
117 ([entry prop]
|
||||
</span><br/>
|
||||
<span class="covered" title="7 out of 7 forms covered">
|
||||
118 (cond (= entry NIL) NIL
|
||||
</span><br/>
|
||||
<span class="covered" title="6 out of 6 forms covered">
|
||||
119 (= (CAR entry) prop) (try
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
120 (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
171 (resolve-subroutines content))))))
|
||||
121 (CAR entry)
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
122 (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
123 (interpret-qualified-name
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
124 (CADR entry))
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
125 (CDDR entry)))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
126 (catch Exception _
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
127 (print "Warnung: ne can āfinde "
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
128 (CADR entry))
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 3 forms covered">
|
||||
129 (CDDR entry)))
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
130 :else (make-cons-cell
|
||||
</span><br/>
|
||||
<span class="covered" title="8 out of 8 forms covered">
|
||||
131 (CAR entry) (resolve-subr (CDR entry))))))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
132
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
133
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
134 (defn- resolve-subroutines
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
135 "Attempt to fix up the references to subroutines (Clojure functions) among
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
136 these `objects`, being new content for the object list."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
137 [objects]
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
138 (make-beowulf-list
|
||||
</span><br/>
|
||||
<span class="covered" title="2 out of 2 forms covered">
|
||||
139 (map
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
140 resolve-subr
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
141 objects)))
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
142
|
||||
</span><br/>
|
||||
<span class="covered" title="1 out of 1 forms covered">
|
||||
143 (defn SYSIN
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
144 "Read the contents of the file at this `filename` into the object list.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
145
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
146 If the file is not a valid Beowulf sysout file, this will probably
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
147 corrupt the system, you have been warned. File paths will be considered
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
148 relative to the filepath set when starting Lisp.
|
||||
</span><br/>
|
||||
<span class="blank" title="0 out of 0 forms covered">
|
||||
149
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
150 It is intended that sysout files can be read both from resources within
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
151 the jar file, and from the file system. If a named file exists in both the
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
152 file system and the resources, the file system will be preferred.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
153
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
154 **NOTE THAT** if the provided `filename` does not end with `.lsp` (which,
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
155 if you're writing it from the Lisp REPL, it won't), the extension `.lsp`
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
156 will be appended.
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
157
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
158 **NOTE THAT** this is an extension function, not available in strct mode."
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
159 ([]
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 13 forms covered">
|
||||
160 (SYSIN (or (:read *options*) (str "resources/" default-sysout))))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
161 ([filename]
|
||||
</span><br/>
|
||||
<span class="covered" title="8 out of 8 forms covered">
|
||||
162 (let [fp (file (full-path (str filename)))
|
||||
</span><br/>
|
||||
<span class="covered" title="9 out of 9 forms covered">
|
||||
163 file (when (and (.exists fp) (.canRead fp)) fp)
|
||||
</span><br/>
|
||||
<span class="partial" title="4 out of 5 forms covered">
|
||||
164 res (try (resource filename)
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
165 (catch Throwable _ nil))
|
||||
</span><br/>
|
||||
<span class="covered" title="11 out of 11 forms covered">
|
||||
166 content (try (READ (slurp (or file res)))
|
||||
</span><br/>
|
||||
<span class="not-tracked" title="0 out of 0 forms covered">
|
||||
167 (catch Throwable _
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 4 forms covered">
|
||||
168 (throw (ex-info "Ne can ārǣde"
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 5 forms covered">
|
||||
169 {:context "SYSIN"
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
170 :filename filename
|
||||
</span><br/>
|
||||
<span class="not-covered" title="0 out of 1 forms covered">
|
||||
171 :filepath fp}))))]
|
||||
</span><br/>
|
||||
<span class="covered" title="4 out of 4 forms covered">
|
||||
172 (swap! oblist
|
||||
</span><br/>
|
||||
<span class="partial" title="7 out of 10 forms covered">
|
||||
173 #(when (or % (seq content))
|
||||
</span><br/>
|
||||
<span class="covered" title="3 out of 3 forms covered">
|
||||
174 (resolve-subroutines content))))))
|
||||
</span><br/>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
@ -16,20 +16,20 @@
|
|||
</tr></thead>
|
||||
<tr>
|
||||
<td><a href="beowulf/bootstrap.clj.html">beowulf.bootstrap</a></td><td class="with-bar"><div class="covered"
|
||||
style="width:64.03688524590164%;
|
||||
float:left;"> 625 </div><div class="not-covered"
|
||||
style="width:35.96311475409836%;
|
||||
float:left;"> 351 </div></td>
|
||||
<td class="with-number">64.04 %</td>
|
||||
style="width:68.25251601097895%;
|
||||
float:left;"> 746 </div><div class="not-covered"
|
||||
style="width:31.747483989021042%;
|
||||
float:left;"> 347 </div></td>
|
||||
<td class="with-number">68.25 %</td>
|
||||
<td class="with-bar"><div class="covered"
|
||||
style="width:59.48275862068966%;
|
||||
float:left;"> 138 </div><div class="partial"
|
||||
style="width:8.189655172413794%;
|
||||
float:left;"> 19 </div><div class="not-covered"
|
||||
style="width:32.327586206896555%;
|
||||
float:left;"> 75 </div></td>
|
||||
<td class="with-number">67.67 %</td>
|
||||
<td class="with-number">422</td><td class="with-number">33</td><td class="with-number">232</td>
|
||||
style="width:64.31372549019608%;
|
||||
float:left;"> 164 </div><div class="partial"
|
||||
style="width:8.235294117647058%;
|
||||
float:left;"> 21 </div><div class="not-covered"
|
||||
style="width:27.45098039215686%;
|
||||
float:left;"> 70 </div></td>
|
||||
<td class="with-number">72.55 %</td>
|
||||
<td class="with-number">498</td><td class="with-number">43</td><td class="with-number">255</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><a href="beowulf/cons_cell.clj.html">beowulf.cons-cell</a></td><td class="with-bar"><div class="covered"
|
||||
|
@ -67,20 +67,20 @@
|
|||
</tr>
|
||||
<tr>
|
||||
<td><a href="beowulf/host.clj.html">beowulf.host</a></td><td class="with-bar"><div class="covered"
|
||||
style="width:56.44047135310849%;
|
||||
float:left;"> 1389 </div><div class="not-covered"
|
||||
style="width:43.55952864689151%;
|
||||
float:left;"> 1072 </div></td>
|
||||
<td class="with-number">56.44 %</td>
|
||||
style="width:56.92369802180057%;
|
||||
float:left;"> 1410 </div><div class="not-covered"
|
||||
style="width:43.07630197819943%;
|
||||
float:left;"> 1067 </div></td>
|
||||
<td class="with-number">56.92 %</td>
|
||||
<td class="with-bar"><div class="covered"
|
||||
style="width:75.37878787878788%;
|
||||
float:left;"> 199 </div><div class="partial"
|
||||
style="width:12.121212121212121%;
|
||||
style="width:76.02996254681648%;
|
||||
float:left;"> 203 </div><div class="partial"
|
||||
style="width:11.985018726591761%;
|
||||
float:left;"> 32 </div><div class="not-covered"
|
||||
style="width:12.5%;
|
||||
float:left;"> 33 </div></td>
|
||||
<td class="with-number">87.50 %</td>
|
||||
<td class="with-number">589</td><td class="with-number">67</td><td class="with-number">264</td>
|
||||
style="width:11.985018726591761%;
|
||||
float:left;"> 32 </div></td>
|
||||
<td class="with-number">88.01 %</td>
|
||||
<td class="with-number">607</td><td class="with-number">69</td><td class="with-number">267</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><a href="beowulf/interop.clj.html">beowulf.interop</a></td><td class="with-bar"><div class="covered"
|
||||
|
@ -101,20 +101,20 @@
|
|||
</tr>
|
||||
<tr>
|
||||
<td><a href="beowulf/io.clj.html">beowulf.io</a></td><td class="with-bar"><div class="covered"
|
||||
style="width:43.962848297213625%;
|
||||
style="width:43.03030303030303%;
|
||||
float:left;"> 142 </div><div class="not-covered"
|
||||
style="width:56.037151702786375%;
|
||||
float:left;"> 181 </div></td>
|
||||
<td class="with-number">43.96 %</td>
|
||||
style="width:56.96969696969697%;
|
||||
float:left;"> 188 </div></td>
|
||||
<td class="with-number">43.03 %</td>
|
||||
<td class="with-bar"><div class="covered"
|
||||
style="width:45.833333333333336%;
|
||||
float:left;"> 33 </div><div class="partial"
|
||||
style="width:8.333333333333334%;
|
||||
float:left;"> 6 </div><div class="not-covered"
|
||||
style="width:45.833333333333336%;
|
||||
float:left;"> 33 </div></td>
|
||||
<td class="with-number">54.17 %</td>
|
||||
<td class="with-number">171</td><td class="with-number">12</td><td class="with-number">72</td>
|
||||
style="width:42.666666666666664%;
|
||||
float:left;"> 32 </div><div class="partial"
|
||||
style="width:9.333333333333334%;
|
||||
float:left;"> 7 </div><div class="not-covered"
|
||||
style="width:48.0%;
|
||||
float:left;"> 36 </div></td>
|
||||
<td class="with-number">52.00 %</td>
|
||||
<td class="with-number">174</td><td class="with-number">12</td><td class="with-number">75</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><a href="beowulf/manual.clj.html">beowulf.manual</a></td><td class="with-bar"><div class="covered"
|
||||
|
@ -236,9 +236,9 @@
|
|||
</tr>
|
||||
<tr><td>Totals:</td>
|
||||
<td class="with-bar"></td>
|
||||
<td class="with-number">68.60 %</td>
|
||||
<td class="with-number">69.16 %</td>
|
||||
<td class="with-bar"></td>
|
||||
<td class="with-number">77.76 %</td>
|
||||
<td class="with-number">78.39 %</td>
|
||||
</tr>
|
||||
</table>
|
||||
</body>
|
||||
|
|
Loading…
Reference in a new issue