From: Dmitry Bogatov Date: Tue, 28 Jan 2014 07:53:51 +0000 (+0400) Subject: Follow unix-way. Remove all about package-managing X-Git-Url: https://jfr.im/git/irc/thales.git/commitdiff_plain/bb00c182fa44870eaefd124eced606f8d9f6e162 Follow unix-way. Remove all about package-managing --- diff --git a/src/thales/core-modules.scm b/src/thales/core-modules.scm deleted file mode 100644 index 8234671..0000000 --- a/src/thales/core-modules.scm +++ /dev/null @@ -1,304 +0,0 @@ -(define-module (thales core-modules) - #:export (guile-provides?)) - -(define (guile-provides? modname) - (and (member modname *guile-core-modules*) - 'guile)) - -(define *guile-core-modules* '((value-history) ;; ?? - (guile) - (ice-9 peg cache) - (ice-9 peg using-parsers) - (ice-9 peg string-peg) - (ice-9 peg codegen) - (ice-9 peg simplify-tree) - (ice-9 time) - (ice-9 list) - (ice-9 iconv) - (ice-9 slib) - (ice-9 poe) - (ice-9 compile-psyntax) - (ice-9 quasisyntax) - (ice-9 arrays) - (ice-9 pretty-print) - (ice-9 posix) - (ice-9 ls) - (ice-9 history) - (ice-9 hcons) - (ice-9 null) - (ice-9 receive) - (ice-9 r5rs) - (ice-9 top-repl) - (ice-9 occam-channel) - (ice-9 stack-catch) - (ice-9 safe) - (ice-9 syncase) - (ice-9 boot-9) - (ice-9 mapping) - (ice-9 threads) - (ice-9 test) - (ice-9 rw) - (ice-9 i18n) - (ice-9 getopt-long) - (ice-9 optargs) - (ice-9 curried-definitions) - (ice-9 control) - (ice-9 local-eval) - (ice-9 poll) - (ice-9 vlist) - (ice-9 lineio) - (ice-9 scm-style-repl) - (ice-9 rdelim) - (ice-9 weak-vector) - (ice-9 string-fun) - (ice-9 command-line) - (ice-9 binary-ports) - (ice-9 futures) - (ice-9 deprecated) - (ice-9 regex) - (ice-9 match) - (ice-9 psyntax) - (ice-9 format) - (ice-9 match.upstream) - (ice-9 debug) - (ice-9 and-let-star) - (ice-9 documentation) - (ice-9 popen) - (ice-9 psyntax-pp) - (ice-9 peg) - (ice-9 eval) - (ice-9 channel) - (ice-9 session) - (ice-9 calling) - (ice-9 runq) - (ice-9 networking) - (ice-9 r6rs-libraries) - (ice-9 eval-string) - (ice-9 safe-r5rs) - (ice-9 serialize) - (ice-9 streams) - (ice-9 buffered-input) - (ice-9 gap-buffer) - (ice-9 expect) - (ice-9 save-stack) - (ice-9 ftw) - (ice-9 common-list) - (ice-9 q) - (language value spec) - (language glil spec) - (language glil compile-assembly) - (language ecmascript array) - (language ecmascript tokenize) - (language ecmascript compile-tree-il) - (language ecmascript spec) - (language ecmascript function) - (language ecmascript impl) - (language ecmascript parse) - (language ecmascript base) - (language bytecode spec) - (language elisp runtime function-slot) - (language elisp runtime value-slot) - (language elisp falias) - (language elisp compile-tree-il) - (language elisp parser) - (language elisp spec) - (language elisp bindings) - (language elisp lexer) - (language elisp runtime) - (language cps compile-rtl) - (language cps contification) - (language cps spec) - (language cps reify-primitives) - (language cps primitives) - (language cps closure-conversion) - (language cps dfg) - (language cps slot-allocation) - (language cps arities) - (language cps verify) - (language scheme compile-tree-il) - (language scheme spec) - (language scheme decompile-tree-il) - (language tree-il inline) - (language tree-il peval) - (language tree-il fix-letrec) - (language tree-il canonicalize) - (language tree-il compile-cps) - (language tree-il cse) - (language tree-il spec) - (language tree-il primitives) - (language tree-il analyze) - (language tree-il debug) - (language tree-il optimize) - (language tree-il effects) - (language tree-il compile-glil) - (language objcode elf) - (language objcode spec) - (language rtl spec) - (language assembly spec) - (language assembly compile-bytecode) - (language assembly decompile-bytecode) - (language assembly disassemble) - (language brainfuck compile-tree-il) - (language brainfuck spec) - (language brainfuck compile-scheme) - (language brainfuck parse) - (language objcode) - (language rtl) - (language glil) - (language assembly) - (language tree-il) - (language cps) - (oop goops active-slot) - (oop goops compile) - (oop goops simple) - (oop goops stklos) - (oop goops describe) - (oop goops accessors) - (oop goops save) - (oop goops composite-slot) - (oop goops dispatch) - (oop goops util) - (oop goops internal) - (oop goops) - (texinfo plain-text) - (texinfo docbook) - (texinfo indexing) - (texinfo string-utils) - (texinfo html) - (texinfo reflection) - (texinfo serialize) - (web server http) - (web client) - (web server) - (web uri) - (web http) - (web request) - (web response) - (scripts help) - (scripts snarf-check-and-output-texi) - (scripts list) - (scripts lint) - (scripts read-text-outline) - (scripts compile) - (scripts read-scheme-source) - (scripts display-commentary) - (scripts generate-autoload) - (scripts use2dot) - (scripts frisk) - (scripts doc-snarf) - (scripts read-rfc822) - (scripts summarize-guile-TODO) - (scripts api-diff) - (scripts punify) - (scripts snarf-guile-m4-docs) - (scripts autofrisk) - (scripts scan-api) - (scripts disassemble) - (system base compile) - (system base ck) - (system base syntax) - (system base message) - (system base language) - (system base lalr.upstream) - (system base target) - (system base pmatch) - (system base lalr) - (system vm disassembler) - (system vm vm) - (system vm program) - (system vm coverage) - (system vm trap-state) - (system vm objcode) - (system vm frame) - (system vm elf) - (system vm linker) - (system vm traps) - (system vm inspect) - (system vm assembler) - (system vm debug) - (system vm instruction) - (system vm trace) - (system repl server) - (system repl common) - (system repl repl) - (system repl describe) - (system repl command) - (system repl debug) - (system repl error-handling) - (system xref) - (system foreign) - (sxml ssax input-parse) - (sxml upstream assert) - (sxml upstream SXPath-old) - (sxml upstream input-parse) - (sxml upstream SXML-tree-trans) - (sxml upstream SSAX) - (sxml simple) - (sxml xpath) - (sxml fold) - (sxml match) - (sxml ssax) - (sxml transform) - (sxml apply-templates) - (srfi srfi-67 compare) - (srfi srfi-42 ec) - (srfi srfi-9 gnu) - (srfi srfi-4 gnu) - (srfi srfi-16) - (srfi srfi-27) - (srfi srfi-4) - (srfi srfi-45) - (srfi srfi-38) - (srfi srfi-42) - (srfi srfi-26) - (srfi srfi-34) - (srfi srfi-69) - (srfi srfi-19) - (srfi srfi-18) - (srfi srfi-88) - (srfi srfi-13) - (srfi srfi-31) - (srfi srfi-60) - (srfi srfi-11) - (srfi srfi-2) - (srfi srfi-37) - (srfi srfi-39) - (srfi srfi-98) - (srfi srfi-9) - (srfi srfi-6) - (srfi srfi-67) - (srfi srfi-1) - (srfi srfi-14) - (srfi srfi-41) - (srfi srfi-17) - (srfi srfi-10) - (srfi srfi-35) - (srfi srfi-8) - (rnrs records syntactic) - (rnrs records inspection) - (rnrs records procedural) - (rnrs arithmetic flonums) - (rnrs arithmetic bitwise) - (rnrs arithmetic fixnums) - (rnrs io ports) - (rnrs io simple) - (rnrs syntax-case) - (rnrs bytevectors) - (rnrs r5rs) - (rnrs control) - (rnrs conditions) - (rnrs sorting) - (rnrs hashtables) - (rnrs mutable-pairs) - (rnrs exceptions) - (rnrs programs) - (rnrs files) - (rnrs unicode) - (rnrs lists) - (rnrs eval) - (rnrs base) - (rnrs mutable-strings) - (rnrs enums) - (statprof) - (texinfo) - (rnrs))) diff --git a/src/thales/prepare.scm b/src/thales/prepare.scm index 25d4f76..701d7b8 100644 --- a/src/thales/prepare.scm +++ b/src/thales/prepare.scm @@ -6,7 +6,6 @@ list-modules check-resolution perform-configure) - #:use-module (thales core-modules) #:use-module (thales syntax) #:use-module (ice-9 match) #:use-module (ice-9 ftw) diff --git a/src/thales/solver.scm b/src/thales/solver.scm deleted file mode 100644 index b8ae0e7..0000000 --- a/src/thales/solver.scm +++ /dev/null @@ -1,307 +0,0 @@ -;;; solver.scm --- Thales solver --- implementation of core idea - -;; Copyright (C) 2013 Dmitry Bogatov - -;; Author: Dmitry Bogatov - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License -;; as published by the Free Software Foundation; either version 3 -;; of the License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;;; Core idea of Thales is packages manager, that eliminates dependencies -;;; hell. In generic case --- when every package version can depend -;;; on arbitary set of packages and their version, solution of dependencies -;;; is exponencial problem. So idea is strictly order package versions -;;; according following rules: -;;; * Any incompatible change allowed only with major version bump. -;;; * Adding dependencly requires major version bump. -;;; * Increase in minor version of dependency is do not require -;;; major version bump. -;;; * Relaxing dependencies do not require major version bump. -;;; * Each package may alternatively depend on several major version -;;; of package -;;; -;;; Most of these requirements are managed automatically by seals (see -;;; seals.scm) and analysis of modules interfaces. Of course, if programmer -;;; wants to screw things, he will be able to. - -;;; Currently, I have no idea how control compability of macroses. -;; Code: -(define-module (thales solver) - :export ( - perform-solve - generate-r1-contrain-solver - resolve-major-versions - make-version - version-compatible? - make-version*)) -(use-modules (ice-9 match)) -(use-modules (srfi srfi-1)) -(use-modules (thales seal)) -(use-modules (srfi srfi-26)) -(use-modules (thales syntax)) -(use-modules (srfi srfi-9)) - - -(define-record-type - (make-version major minor micro) - version? - (major major) - (minor minor) - (micro micro)) -(define* (make-version* #:optional (major 0) (minor 0) (micro 0)) - (make-version major minor micro)) - -(eval-when (load compile eval) - (read-hash-extend #\v - (lambda (ch stream) - (cons 'make-version* (read stream))))) - - -(sealed version-compatible? - (#v(1 1 3) #v(1 2 2) *** #t) - (#v(1 2 3) #v(3 2 1) *** #f)) - -(define-match (version-compatible? [$ major1 minor1 micro1] - [$ major2 minor2 micro2]) - (and (= major1 major2) - (<= minor1 minor2))) - -(sealed version-interchangeble? - (#v(1 2 3) #v(1 2 4) *** #t) - (#v(1 2 3) #v(1 3 0) *** #f)) - -(define-match (version-interchangeble? [$ major1 minor1] - [$ major2 minor2]) - (and (= major1 major2) - (= minor1 minor2))) - -(define-record-type - (make-constrain type name versions) - constrain? - (type constrain-type) - (name constrain-name) - (versions constrain-versions)) -(define* (make-constrain* type name #:rest versions) - (make-constrain type name versions)) - -(define-record-type - (make-package name version dependencies) - package? - (name package-name) - (version package-version) - (dependencies package-dependencies)) - -(define* (make-package* name version #:rest dependencies) - (make-package name version dependencies)) - -(sealed satisfy - [(make-constrain* #:match 'foo #v(1)) - (make-package* 'foo #v(1 2 0)) *** #t] - [(& (make-constrain* #:match 'foo #v(2 0)) - (make-package* 'foo #v(1 2 3))) - => #f] - [(& (make-constrain* #:match 'foo #v(1 0)) - (make-package* 'foo #v(1 2 3))) - => #t] - [(& (make-constrain* #:match 'foo - #v(1 0) - #v(2 0)) - (make-package* 'foo #v(1 2 3))) - => #t] - [(& (make-constrain* #:rigid 'foo #v(1 2 3)) - (make-package* 'foo #v(1 2 3))) - => #t] - [(& (make-constrain* #:rigid 'foo - #v(1 2 4) - #v(1 2 7)) - (make-package* 'foo #(1 2 5))) - => #f]) - -(define-match (satisfy [$ constr-type constr-name constr-versions] - [$ pkg-name pkg-version _]) - (define version-comparator (case constr-type - [(#:rigid) equal?] - [(#:match) version-compatible?])) - (if (eq? constr-name pkg-name) - (any #[version-comparator <> pkg-version] constr-versions) - #f)) - - -(define* (generate-r1-contrain-solver installed availible - #:key (conservative #f)) - "Return function, that will packages, that satisfy constrain. - -Function, given constrain, return list of packages, that satistfy it, -taking only one version from each major version. Order of packages influenced -by list of INSTALLED packages, if CONSERVATIVE is #f. -" - (let* ((cache (make-hash-table)) - (cache-get #[hash-ref cache]) - (cache-put #[hash-set! cache])) - (lambda* (constr #:optional major-only) - (or (cache-get constr) - (let ((result (filter #[satisfy constr] availible))) - (cache-put constr result) - result))))) - -(sealed enumerate-list-combinations - ([& '((1 2))] => '((1) (2))) - ([& '((1 2) (3 4))] => '((1 3) (1 4) (2 3) (2 4)))) - -(define-match (enumerate-list-combinations (head rest ...)) - "Enumerate list combinations. - -FIXME: EXTREMELY INEFFICENT -" - (if (null? rest) - (map list head) - (let ((recursive-processed (enumerate-list-combinations rest))) - (concatenate (map (lambda (arg) - (map #[cons arg] recursive-processed)) - head))))) - -(sealed package-duplicate? - ([& (make-package* 'foo (make-version* 1 2)) - (make-package* 'foo (make-version* 1 4))] - => #t)) - -(define-match (package-duplicate? [$ name1 [$ major1]] - [$ name2 [$ major2]]) - (if (eq? name1 name2) - (or (= major1 major2) (throw 'conflict)) - #f)) - - -(eval-when (compile) - (define foo-102 (make-package* 'foo (make-version* 1 0 2))) - (define bar-201 (make-package* 'bar (make-version* 2 0 1))) - (define quaz-123 (make-package* 'quaz (make-version* 1 2 3)))) - -;; (sealed optimize-pkglist -;; ([& (list foo-102 bar-201) -;; '()] -;; => '()) -;; ([& (list foo-102 bar-201) -;; (list foo-102 quaz-123)] -;; => (list quaz-123))) - -;; (sealed optimize-pkglist -;; ([& '((foo (1 0 2)) -;; (bar (2 0 1))) -;; '((quaz (1 2 3)) -;; (foo (1 0 3)))] -;; => '((quaz (1 2 3)))) - -;; ([& '() '((foo (1 0 0)))] -;; => '((foo (1 0 0)))) - -;; ([& '((foo (1 0 2))) -;; '((foo (2 1 2)))] -;; => #f)) - -;; Return list of packages in NEW, but not in STABLE. If packages in stable -;; STABLE and NEW in union conflict, return #f. -(define (optimize-pkglist stable new) - (catch 'conflict - (let iterate-new-packages ((result '()) - (used stable) - (new new)) - (if (null? new) result - (let ((current (car new)) - (rest (cdr new))) - (if (any #[package-duplicate? current] used) - (iterate-new-packages result used rest) - (iterate-new-packages (cons current result) - (cons current used) - rest))))) - (const #f))) - -;; (define-match (iterate-new-packages result used -;; (new:head new:rest ...)) -;; (if (any #[package-duplicate? new:head] used) -;; (if (null? new:rest) result -;; (iterate-new-packages result used new:rest)) - -;; ) -;; ) - -;; (let iterate-new-packages ((result '()) -;; (new new) -;; (used stable)) -;; (match new - -;; ) -;; (if (null? new) result -;; (if (any package-duplicate?)) - -;; ) - -;; ) - -;; (define-match (duplicate? [$ new-name -;; [$ new-major]]) -;; ;; Return #t if exists packages of same name and major version in STABLE, -;; ;; throw 'conflict, if major versions do not match and #f otherwise. -;; (define-match (pair-pkg-duplicate? [$ pkg-name -;; [$ pkg-major]]) -;; (if (eq? pkg-name new-name) -;; (or (= pkg-major new-major) (throw 'conflict)) -;; #f)) -;; (if (null? stable) #f -;; (any pair-pkg-duplicate? stable))) -;; (catch 'conflict #[filter (negate duplicate?) new] (const #f)) - -;; (define (resolve-major-versions major-resolver constrains proposed) -;; (define enum/list enumerate-list-combinations) -;; (define possible-pkg-solutions ;; ((pkg)) -;; (filter-map (compose #[optimize-pkglist proposed] major-resolver) -;; constrains)) -;; (define (pkg->depend-lists pkg) -;; (cddr pkg)) ;; ((constr)) -;; (newline) -;; (display possible-pkg-solutions) -;; (newline) -;; (newline) -;; (display (car possible-pkg-solutions)) -;; (newline) -;; (display (enum/list (map pkg->depend-lists (car possible-pkg-solutions)))) -;; (newline) -;; (for (solution in possible-pkg-solutions) -;; (for (next-constrains in (enum/list (map pkg->depend-lists solution))) -;; (if (null? next-constrains) -;; (throw 'found-result (cons solution proposed))))) -;; #f) - - -;; (define* (perform-solve installed availible constrains -;; #:key (conservative #f)) -;; "Resolve CONSTRAINS with AVAILIBLE packages. - -;; If CONSERVATIVE if #t, prefer use of INSTALLED packages, otherwise prefer -;; new versions. - -;; CONSTRAINS is list of constrains, that have following kinds: - -;; * Ridid request for specified package. To be used, if bug happens -;; and dependency have to be resolved manually. -;; ( = ( ) ...) -;; * Request for package version, no less that specified. -;; ( ? ( ) ... ) - -;; Both INSTALLED and AVAILIBLE are lists of package in form -;; ( ( ) ... ) -;; where are never rigid." -;; #f -;; ) diff --git a/test/test.scm b/test/test.scm deleted file mode 100644 index 728e34e..0000000 --- a/test/test.scm +++ /dev/null @@ -1,16 +0,0 @@ -(define-module (test) - #:export (frap)) -(use-modules (seal)) - -(sealed frap - (frap 1 => 9)) -(define (frap x) - (+ (bar x) 8)) - - - -(sealed bar - (& 5 => 1) - (& 3 => 9)) -(define (bar y) - (* y y)) diff --git a/tests/test-solver.scm b/tests/test-solver.scm deleted file mode 100644 index 91131e2..0000000 --- a/tests/test-solver.scm +++ /dev/null @@ -1,17 +0,0 @@ -(use-modules (thales solver)) -(define installed '()) -(define available '((foo (1 0 0) ()) - (foo (2 0 0) ()) - (bar (1 0 0) ((foo ? (1 0 0)))) - (bar (2 0 0) ((foo ? (2 0 0)))) - (quad (1 0 0) ((foo ? (1 0 0)) - (bar ? (1 0 0)))) - (quad (2 0 0) ((foo ? (1 0 0)) - (bar ? (2 0 0)))))) - -(define constrains '((quad ? (1 0) (2 0)))) -(define r1-solver (generate-r1-contrain-solver installed available)) -(define optimize-pkglist (@@ (thales solver) optimize-pkglist)) -;; (display (resolve-major-versions r1-solver -;; (list '(quad ? (1 0))) -;; '()))