From 44de84de104de27354f36ae3d5d6301817e8d90f Mon Sep 17 00:00:00 2001 From: Sergiu Ivanov Date: Tue, 25 Jan 2022 00:46:12 +0100 Subject: [PATCH] utils: Type unstringify-pairs. --- scribblings/utils.scrbl | 20 ++++++++++++++- utils.rkt | 56 ++++++++++++++++++++--------------------- 2 files changed, 46 insertions(+), 30 deletions(-) diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl index 9a20a59..a898dbd 100644 --- a/scribblings/utils.scrbl +++ b/scribblings/utils.scrbl @@ -2,7 +2,8 @@ @(require scribble/example racket/sandbox (for-label racket graph (submod "../utils.rkt" typed) (only-in typed/racket/base - Any AnyValues Listof Symbol String Number Sexp cast))) + Any AnyValues Listof Symbol String Number Sexp cast + Pair List))) @title[#:tag "utils"]{dds/utils: Various Utilities} @@ -188,6 +189,23 @@ Reads a @racket[sexp] from a string produced by Org-mode for a named table. (unorg "(#t \"#t\" \"#t \" '(1 2 \"#f\"))") ]} +@defform[(GeneralPair A B)]{ + +A @racket[(Pair A B)] or a @racket[(List A B)]. + +} + +@defproc[(unstringify-pairs [pairs (Listof (GeneralPair String Any))]) + (Listof (GeneralPair Symbol Any))]{ + +Given a list of pairs of strings and some other values (possibly strings), +converts the first element of each pair to a string, and reads the second +element with @racket[string->any] or keeps it as is if it is not a string. + +@examples[#:eval utils-evaluator +(unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))"))) +]} + @section{Additional graph utilities} @section{Pretty printing} diff --git a/utils.rkt b/utils.rkt index 908db2c..c373b6f 100644 --- a/utils.rkt +++ b/utils.rkt @@ -15,11 +15,11 @@ (for-syntax syntax/parse racket/list)) (provide - Variable VariableMapping + Variable VariableMapping GeneralPair eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/: extract-symbols any->string stringify-variable-mapping string->any - handle-org-booleans map-sexp read-org-sexp unorg) + handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs) (define-type Variable Symbol) (define-type (VariableMapping A) (Immutable-HashTable Variable A)) @@ -201,20 +201,41 @@ '((a (and a b)) (b (or b (not a))))) (check-equal? (unorg "(#t \"#t\" \"#t \" '(1 2 \"#f\"))") '(#t #t #t '(1 2 #f))))) + + (define-type (GeneralPair A B) (U (Pair A B) (List A B))) + + (: unstringify-pairs (-> (Listof (GeneralPair String Any)) + (Listof (GeneralPair Symbol Any)))) + (define (unstringify-pairs pairs) + (for/list ([p pairs]) + (match p + [(list key val) + (cons (string->symbol key) (if (string? val) + (string->any val) + val))] + [(cons key val) + (cons (string->symbol key) (if (string? val) + (string->any val) + val))]))) + + (module+ test + (test-case "unstringify-pairs" + (check-equal? (unstringify-pairs '(("a" . "1") ("b" . "(and a (not b))"))) + '((a . 1) (b . (and a (not b))))) + (check-equal? (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))"))) + '((a . 1) (b . (and a (not b))))))) ) (require 'typed) (provide eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/: extract-symbols any->string stringify-variable-mapping string->any - map-sexp read-org-sexp unorg) + map-sexp read-org-sexp unorg unstringify-pairs) ;;; Untyped section. (provide ;; Functions - (contract-out [unstringify-pairs (-> (listof (general-pair/c string? any/c)) - (listof (general-pair/c symbol? any/c)))] - [read-org-variable-mapping (-> string? variable-mapping?)] + (contract-out [read-org-variable-mapping (-> string? variable-mapping?)] [unorgv (-> string? variable-mapping?)] [dotit (-> graph? void?)] [read-symbol-list (-> string? (listof symbol?))] @@ -282,29 +303,6 @@ (or/c (list/c key-contract val-contract) (cons/c key-contract val-contract))) -;;; Given a list of pairs of strings and some other values (possibly -;;; strings), converts the first element of each pair to a string, and -;;; reads the second element with string->any or keeps it as is if it -;;; is not a string. -(define (unstringify-pairs pairs) - (for/list ([p pairs]) - (match p - [(list key val) - (cons (string->symbol key) (if (string? val) - (string->any val) - val))] - [(cons key val) ; also handle improper pairs - (cons (string->symbol key) (if (string? val) - (string->any val) - val))]))) - -(module+ test - (test-case "unstringify-pairs" - (check-equal? (unstringify-pairs '(("a" . "1") ("b" . "(and a (not b))"))) - '((a . 1) (b . (and a (not b))))) - (check-equal? (unstringify-pairs '(("a" . 1) ("b" . "(and a (not b))"))) - '((a . 1) (b . (and a (not b))))))) - ;;; Reads a variable mapping from a string, such as the one which ;;; Org-mode produces from tables. (define read-org-variable-mapping