diff options
Diffstat (limited to 'src/boot')
| -rw-r--r-- | src/boot/initial-env.lisp | 5 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 3 | ||||
| -rw-r--r-- | src/boot/strap/tokens.clisp | 1 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 4 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 24 | ||||
| -rw-r--r-- | src/boot/tokens.boot | 1 | ||||
| -rw-r--r-- | src/boot/translator.boot | 4 | ||||
| -rw-r--r-- | src/boot/utility.boot | 13 |
8 files changed, 41 insertions, 14 deletions
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp index 7e2deef9..3496cdd8 100644 --- a/src/boot/initial-env.lisp +++ b/src/boot/initial-env.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007-2010, Gabriel Dos Reis. +;; Copyright (C) 2007-2011, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -74,9 +74,6 @@ (defvar *lisp-source-filetype* "lisp") -(defun setdifference (x y) - (set-difference x y)) - (defun |shoeInputFile| (filespec ) (open filespec :direction :input :if-does-not-exist nil)) diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 36d45495..ad885aaa 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1542,7 +1542,8 @@ (SETQ |$dollarVars| NIL) (|shoeCompTran1| |body|) (SETQ |$locVars| - (SETDIFFERENCE (SETDIFFERENCE |$locVars| |$fluidVars|) + (|setDifference| + (|setDifference| |$locVars| |$fluidVars|) (|shoeATOMs| |args|))) (SETQ |body| (PROGN diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index d19d76d8..6843b904 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -237,7 +237,6 @@ (LIST '|rest| 'CDR) (LIST '|sameObject?| 'EQ) (LIST '|scalarEq?| 'EQL) (LIST '|scalarEqual?| 'EQL) (LIST '|second| 'CADR) - (LIST '|setDifference| 'SETDIFFERENCE) (LIST '|setIntersection| 'INTERSECTION) (LIST '|setPart| 'SETELT) (LIST '|setUnion| 'UNION) (LIST '|strconc| 'CONCAT) (LIST '|stringChar| 'SCHAR) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index 5aff56f2..cff321ef 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -13,6 +13,8 @@ (PROVIDE "translator") +(EXPORT '|evalBootFile|) + (DEFPARAMETER |$currentModuleName| NIL) (DEFPARAMETER |$foreignsDefsForCLisp| NIL) @@ -228,7 +230,7 @@ (T (|shoePCompileTrees| (|shoeTransformStream| |a|)) (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED"))))) -(DEFUN EVAL-BOOT-FILE (|fn|) +(DEFUN |evalBootFile| (|fn|) (PROG (|outfn| |infn| |b|) (RETURN (PROGN diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 4f9a741f..38951dd9 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -7,8 +7,8 @@ (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| |scalarMember?| |listMember?| |reverse| |reverse!| - |lastNode| |append!| |copyList| |substitute| - |substitute!|)) + |lastNode| |append!| |copyList| |substitute| |substitute!| + |setDifference|)) (DEFUN |objectMember?| (|x| |l|) (LOOP @@ -142,3 +142,23 @@ (T (CONS |h| |t|)))) (T |s|))))) +(DEFUN |setDifference| (|x| |y|) + (PROG (|a| |l| |p|) + (RETURN + (COND + ((NULL |x|) NIL) + ((NULL |y|) |x|) + (T (SETQ |l| (SETQ |p| (LIST NIL))) + (LET ((|bfVar#1| |x|)) + (LOOP + (COND + ((ATOM |bfVar#1|) (RETURN NIL)) + (T (AND (CONSP |bfVar#1|) + (PROGN (SETQ |a| (CAR |bfVar#1|)) T) + (NOT (|objectMember?| |a| |y|)) + (PROGN + (RPLACD |p| (LIST |a|)) + (SETQ |p| (CDR |p|)))))) + (SETQ |bfVar#1| (CDR |bfVar#1|)))) + (CDR |l|)))))) + diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 3843b785..0ac85387 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -298,7 +298,6 @@ for i in [ _ ["scalarEq?", "EQL" ] , _ ["scalarEqual?","EQL" ] , _ ["second", "CADR"] , _ - ["setDifference", "SETDIFFERENCE"] , _ ["setIntersection", "INTERSECTION"] , _ ["setPart", "SETELT"] , _ ["setUnion", "UNION"] , _ diff --git a/src/boot/translator.boot b/src/boot/translator.boot index ef5cff04..d7bb643d 100644 --- a/src/boot/translator.boot +++ b/src/boot/translator.boot @@ -39,7 +39,7 @@ import pile import parser import ast namespace BOOTTRAN -module translator +module translator (evalBootFile) ++ If non nil, holds the name of the current module being translated. $currentModuleName := nil @@ -163,7 +163,7 @@ shoeMc(a,fn)== shoePCompileTrees shoeTransformStream a shoeConsole strconc(fn,'" COMPILED AND LOADED") -EVAL_-BOOT_-FILE fn == +evalBootFile fn == b := _*PACKAGE_* IN_-PACKAGE '"BOOTTRAN" infn:=shoeAddbootIfNec fn diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 6527a07a..0b15569c 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -34,7 +34,7 @@ import initial_-env namespace BOOTTRAN module utility (objectMember?, symbolMember?, stringMember?, charMember?, scalarMember?, listMember?, reverse, reverse!, - lastNode, append!, copyList, substitute, substitute!) + lastNode, append!, copyList, substitute, substitute!, setDifference) --% membership operators @@ -46,7 +46,6 @@ objectMember?(x,l) == l := rest l return sameObject?(x,l) - symbolMember?(s,l) == repeat l = nil => return false @@ -154,3 +153,13 @@ substitute(y,x,s) == [h,:t] s +--% set operations + +setDifference(x,y) == + x = nil => nil + y = nil => x + l := p := [nil] + for [a,:.] in tails x | not objectMember?(a,y) repeat + p.rest := [a] + p := rest p + rest l |