diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/boot/ast.boot | 13 | ||||
-rw-r--r-- | src/boot/strap/ast.clisp | 27 | ||||
-rw-r--r-- | src/boot/strap/utility.clisp | 15 | ||||
-rw-r--r-- | src/boot/utility.boot | 3 | ||||
-rw-r--r-- | src/interp/ptrees.boot | 12 |
6 files changed, 66 insertions, 9 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9fd9d5a5..f0942507 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2011-04-30 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot (bfAppend): Write in full. + * interp/ptrees.boot (pfAppend): Likewise. + +2011-04-30 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/vmlisp.lisp (NREMOVE): Remove. (EFFACE): Likewise. * interp/sys-utility.boot (remove!): New. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index ab945fd0..bb1b9819 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -160,9 +160,16 @@ bfPile: %List %Form -> %List %Form bfPile(part) == part -bfAppend: %List %Form -> %Form -bfAppend x== - apply(function append,x) +bfAppend: %List %List %List %Form -> %List %Form +bfAppend ls == + ls isnt [l,:ls] => nil + r := copyList l + p := r + repeat + ls isnt [l,:ls] => return r + l = nil => nil + lastNode(p).rest := copyList l + p := rest p bfColonAppend: (%List %Form,%Form) -> %Form bfColonAppend(x,y) == diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 67d31787..081dab12 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -194,9 +194,32 @@ (DEFUN |bfPile| (|part|) |part|) -(DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|)) |%Form|) |bfAppend|)) +(DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| (|%List| |%Form|)))) + (|%List| |%Form|)) + |bfAppend|)) -(DEFUN |bfAppend| (|x|) (APPLY #'APPEND |x|)) +(DEFUN |bfAppend| (|ls|) + (PROG (|p| |r| |l|) + (RETURN + (COND + ((NOT (AND (CONSP |ls|) + (PROGN + (SETQ |l| (CAR |ls|)) + (SETQ |ls| (CDR |ls|)) + T))) + NIL) + (T (SETQ |r| (|copyList| |l|)) (SETQ |p| |r|) + (LOOP + (COND + ((NOT (AND (CONSP |ls|) + (PROGN + (SETQ |l| (CAR |ls|)) + (SETQ |ls| (CDR |ls|)) + T))) + (RETURN |r|)) + ((NULL |l|) NIL) + (T (RPLACD (|lastNode| |p|) (|copyList| |l|)) + (SETQ |p| (CDR |p|)))))))))) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Form|) |%Form|) |%Form|) |bfColonAppend|)) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 48ac0037..2d531fd2 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -11,8 +11,19 @@ |setDifference| |applySubst| |applySubst!| |remove| |removeSymbol|)) -(DECLAIM (FTYPE (FUNCTION ((|%List| |%Symbol|) |%Symbol|) - (|%List| |%Symbol|)) +(DECLAIM (FTYPE (FUNCTION ((|%List| (|%List| |%Thing|))) + (|%List| |%Thing|)) + |append!|)) + +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) (|%List| |%Thing|)) + |copyList|)) + +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|)) + (|%Maybe| (|%Node| |%Thing|))) + |lastNode|)) + +(DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) |%Symbol|) + (|%List| |%Thing|)) |removeSymbol|)) (DECLAIM (FTYPE (FUNCTION ((|%List| |%Thing|) |%Thing|) diff --git a/src/boot/utility.boot b/src/boot/utility.boot index c24ed738..101b10e3 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -36,6 +36,9 @@ module utility (objectMember?, symbolMember?, stringMember?, charMember?, scalarMember?, listMember?, reverse, reverse!, lastNode, append!, copyList, substitute, substitute!, setDifference, applySubst, applySubst!,remove,removeSymbol) where + append!: %List %List %Thing -> %List %Thing + copyList: %List %Thing -> %List %Thing + lastNode: %List %Thing -> %Maybe %Node %Thing removeSymbol: (%List %Thing, %Symbol) -> %List %Thing remove: (%List %Thing, %Thing) ->% List %Thing diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot index cbd4ac4f..4ec6f7e5 100644 --- a/src/interp/ptrees.boot +++ b/src/interp/ptrees.boot @@ -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 @@ -60,7 +60,15 @@ structure %Ast == --% SPECIAL NODES pfListOf x == pfTree('listOf,x) pfListOf? x == pfAbSynOp?(x,'listOf) -pfAppend list == apply(function append,list) +pfAppend ls == + ls isnt [l,:ls] => nil + r := copyList l + p := r + repeat + ls isnt [l,:ls] => return r + l = nil => nil + lastNode(p).rest := copyList l + p := rest p pfNothing () == pfTree('nothing, []) pfNothing? form == pfAbSynOp?(form, 'nothing) |